+2010-06-18 Arnaud Charlet <charlet@adacore.com>
+
+ * par-ch9.adb, sem_aggr.adb, sem_ch3.adb, layout.adb, sem_ch4.adb,
+ sem_ch5.adb, sem_mech.adb, exp_util.adb, par-ch10.adb, sem_ch6.adb,
+ par-ch11.adb, sem_ch7.adb, par-prag.adb, exp_disp.adb, par-ch12.adb,
+ sem_ch8.adb, style.adb, sem_ch9.adb, sem_ch10.adb, prep.adb,
+ sem_warn.adb, par-util.adb, scng.adb, sem_eval.adb, checks.adb,
+ sem_prag.adb, sem_ch12.adb, styleg.adb, sem_ch13.adb, par-ch3.adb,
+ par-tchk.adb, freeze.adb, sfn_scan.adb, par-ch4.adb, sem_util.adb,
+ sem_res.adb, par-ch5.adb, lib-xref.adb, sem_attr.adb, par-ch6.adb,
+ sem_disp.adb, prepcomp.adb, par-ch7.adb, sem_elab.adb, exp_ch4.adb,
+ errout.ads: Update comments. Minor reformatting.
+
2010-06-18 Geert Bosch <bosch@adacore.com>
* i-forbla-darwin.adb: Include -lgnala and -lm in linker options for
-- applied to an access [sub]type.
if not Is_Access_Type (Typ) then
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("`NOT NULL` allowed only for an access type", Error_Node);
-- Enforce legality rule RM 3.10(14/1): A null exclusion can only
elsif Can_Never_Be_Null (Typ)
and then Comes_From_Source (Typ)
then
- Error_Msg_NE -- CODEFIX???
+ Error_Msg_NE
("`NOT NULL` not allowed (& already excludes null)",
Error_Node, Typ);
end if;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- without appropriate coordination. If new messages are added which may
-- be susceptible to automatic codefix action, they are marked using:
- -- Error_Msg -- CODEFIX???
- -- (parameters)
-
- -- And subsequently either the appropriate code is added to codefix and the
- -- ??? are removed, or it is determined that this is not an appropriate
- -- case for codefix action, and the comment is removed.
-
------------------------------
-- Error Output Subprograms --
------------------------------
if Lcheck = LT or else Ucheck = GT then
if Warn1 then
- Error_Msg_N -- CODEFIX???
- ("?range test optimized away", N);
- Error_Msg_N -- CODEFIX???
- ("\?value is known to be out of range", N);
+ Error_Msg_N ("?range test optimized away", N);
+ Error_Msg_N ("\?value is known to be out of range", N);
end if;
Rewrite (N,
elsif Lcheck in Compare_GE and then Ucheck in Compare_LE then
if Warn1 then
- Error_Msg_N -- CODEFIX???
- ("?range test optimized away", N);
- Error_Msg_N -- CODEFIX???
- ("\?value is known to be in range", N);
+ Error_Msg_N ("?range test optimized away", N);
+ Error_Msg_N ("\?value is known to be in range", N);
end if;
Rewrite (N,
elsif Lcheck in Compare_GE then
if Warn2 and then not In_Instance then
- Error_Msg_N -- CODEFIX???
- ("?lower bound test optimized away", Lo);
- Error_Msg_N -- CODEFIX???
- ("\?value is known to be in range", Lo);
+ Error_Msg_N ("?lower bound test optimized away", Lo);
+ Error_Msg_N ("\?value is known to be in range", Lo);
end if;
Rewrite (N,
elsif Ucheck in Compare_LE then
if Warn2 and then not In_Instance then
- Error_Msg_N -- CODEFIX???
- ("?upper bound test optimized away", Hi);
- Error_Msg_N -- CODEFIX???
- ("\?value is known to be in range", Hi);
+ Error_Msg_N ("?upper bound test optimized away", Hi);
+ Error_Msg_N ("\?value is known to be in range", Hi);
end if;
Rewrite (N,
-- Result is out of range for valid value
if Lcheck = LT or else Ucheck = GT then
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("?value can only be in range if it is invalid", N);
-- Result is in range for valid value
elsif Lcheck in Compare_GE and then Ucheck in Compare_LE then
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("?value can only be out of range if it is invalid", N);
-- Lower bound check succeeds if value is valid
elsif Warn2 and then Lcheck in Compare_GE then
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("?lower bound check only fails if it is invalid", Lo);
-- Upper bound check succeeds if value is valid
elsif Warn2 and then Ucheck in Compare_LE then
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("?upper bound check only fails for invalid values", Hi);
end if;
end if;
and then Is_Integer_Type (Etype (Left_Opnd (N)))
and then not Has_Warnings_Off (Etype (Left_Opnd (N)))
then
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("can never be greater than, could replace by ""'=""?", N);
Warning_Generated := True;
end if;
and then Is_Integer_Type (Etype (Left_Opnd (N)))
and then not Has_Warnings_Off (Etype (Left_Opnd (N)))
then
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("can never be less than, could replace by ""'=""?", N);
Warning_Generated := True;
end if;
and then not In_Instance
then
if True_Result then
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("condition can only be False if invalid values present?",
N);
elsif False_Result then
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("condition can only be True if invalid values present?",
N);
end if;
and then not Is_Frozen (Typ)
then
Error_Msg_Sloc := Sloc (Subp);
- Error_Msg_NE -- CODEFIX???
+ Error_Msg_NE
("declaration must appear after completion of type &", N, Typ);
Error_Msg_NE
("\which is an untagged type in the profile of"
Adjusted := True;
end if;
- -- An abstract operation cannot be declared in the private part
- -- for a visible abstract type, because it could never be over-
- -- ridden. For explicit declarations this is checked at the
- -- point of declaration, but for inherited operations it must
- -- be done when building the dispatch table.
+ -- An abstract operation cannot be declared in the private part for a
+ -- visible abstract type, because it can't be overridden outside this
+ -- package hierarchy. For explicit declarations this is checked at
+ -- the point of declaration, but for inherited operations it must be
+ -- done when building the dispatch table.
-- Ada 2005 (AI-251): Primitives associated with interfaces are
-- excluded from this check because interfaces must be visible in
and then
not Is_TSS (Prim, TSS_Stream_Output)
then
- Error_Msg_NE -- CODEFIX???
+ Error_Msg_NE
("abstract inherited private operation&" &
" must be overridden (RM 3.9.3(10))",
Parent (Typ), Prim);
if Is_Controlled (Typ) then
if not Finalized then
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("controlled type has no explicit Finalize method?", Typ);
elsif not Adjusted then
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("controlled type has no explicit Adjust method?", Typ);
end if;
end if;
-- Generate warning if not suppressed
if W then
- Error_Msg_F -- CODEFIX???
+ Error_Msg_F
("?this code can never be executed and has been deleted!", N);
end if;
end if;
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
if not Placed_Component then
ADC :=
Get_Attribute_Definition_Clause (Rec, Attribute_Bit_Order);
- Error_Msg_N
- ("?Bit_Order specification has no effect", ADC);
+ Error_Msg_N ("?Bit_Order specification has no effect", ADC);
Error_Msg_N
("\?since no component clauses were specified", ADC);
-- Give warning if redundant constructs warnings on
if Warn_On_Redundant_Constructs then
- Error_Msg_N
+ Error_Msg_N -- CODEFIX
("?pragma Pack has no effect, no unplaced components",
Get_Rep_Pragma (Rec, Name_Pack));
end if;
declare
Sz : constant Node_Id := Size_Clause (Rec);
begin
- Error_Msg_NE -- CODEFIX
+ Error_Msg_NE -- CODEFIX
("size given for& too small", Sz, Rec);
- Error_Msg_N -- CODEFIX
+ Error_Msg_N -- CODEFIX
("\use explicit pragma Pack "
& "or use pragma Implicit_Packing", Sz);
end;
and then not Has_Size_Clause (F_Type)
and then VM_Target = No_VM
then
- Error_Msg_N
- ("& is an 8-bit Ada Boolean?", Formal);
+ Error_Msg_N ("& is an 8-bit Ada Boolean?", Formal);
Error_Msg_N
("\use appropriate corresponding type in C "
& "(e.g. char)?", Formal);
Object_Definition (Parent (E)));
if Is_CPP_Class (Etype (E)) then
- Error_Msg_NE ("\} may need a cpp_constructor",
+ Error_Msg_NE
+ ("\} may need a cpp_constructor",
Object_Definition (Parent (E)), Etype (E));
end if;
end if;
else
Error_Msg_NE
("size given for& too small", SZ, E);
- Error_Msg_N
+ Error_Msg_N -- CODEFIX
("\use explicit pragma Pack "
& "or use pragma Implicit_Packing", SZ);
end if;
-- --
-- B o d y --
-- --
--- Copyright (C) 2001-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 2001-2010, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
begin
if Spec < Min then
Error_Msg_Uint_1 := Min;
- Error_Msg_NE
- ("size for & too small, minimum allowed is ^", SC, E);
+ Error_Msg_NE ("size for & too small, minimum allowed is ^", SC, E);
Init_Esize (E);
Init_RM_Size (E);
end if;
BE := First_Entity (Current_Scope);
while Present (BE) loop
if Chars (BE) = Chars (E) then
- Error_Msg_NE
+ Error_Msg_NE -- CODEFIX
("?pragma Unreferenced given for&!", N, BE);
exit;
end if;
-- Here we issue the warning, since this is a real reference
else
- Error_Msg_NE ("?pragma Unreferenced given for&!", N, E);
+ Error_Msg_NE -- CODEFIX
+ ("?pragma Unreferenced given for&!", N, E);
end if;
end if;
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
Get_Expected_Unit_Type
(File_Name (Current_Source_File)) = Expect_Body
then
- Error_Msg_BC ("keyword BODY expected here [see file name]");
+ Error_Msg_BC -- CODEFIX
+ ("keyword BODY expected here [see file name]");
Restore_Scan_State (Scan_State);
Set_Unit (Comp_Unit_Node, P_Package (Pf_Pbod));
else
-- Otherwise we saved the semicolon position, so complain
else
- Error_Msg (""";"" should be IS", SIS_Semicolon_Sloc);
+ Error_Msg -- CODEFIX
+ (""";"" should be IS", SIS_Semicolon_Sloc);
end if;
Body_Node := Unit (Comp_Unit_Node);
end if;
if Token /= Tok_With then
- Error_Msg_SC ("unexpected LIMITED ignored");
+ Error_Msg_SC -- CODEFIX
+ ("unexpected LIMITED ignored");
end if;
if Ada_Version < Ada_05 then
-- WITH TYPE is an obsolete GNAT specific extension
- Error_Msg_SP
- ("`WITH TYPE` is an obsolete 'G'N'A'T extension");
+ Error_Msg_SP ("`WITH TYPE` is an obsolete 'G'N'A'T extension");
Error_Msg_SP ("\use Ada 2005 `LIMITED WITH` clause instead");
Scan; -- past TYPE
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2008, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
Set_Choice_Parameter (Handler_Node, Choice_Param_Node);
elsif Token = Tok_Others then
- Error_Msg_AP ("missing "":""");
+ Error_Msg_AP -- CODEFIX
+ ("missing "":""");
Change_Identifier_To_Defining_Identifier (Choice_Param_Node);
Set_Choice_Parameter (Handler_Node, Choice_Param_Node);
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
Scan; -- past OTHERS
if Token /= Tok_Arrow then
- Error_Msg_BC ("expect arrow after others");
+ Error_Msg_BC ("expect arrow after others");
else
Scan; -- past arrow
end if;
Scan;
if Token = Tok_Private then
- Error_Msg_SC ("TAGGED should be WITH");
+ Error_Msg_SC -- CODEFIX
+ ("TAGGED should be WITH");
Set_Private_Present (Def_Node, True);
T_Private;
else
elsif Nkind_In (N, N_In, N_Not_In)
and then Paren_Count (N) = 0
then
- Error_Msg_N -- CODEFIX???
- ("|this expression must be parenthesized!", N);
+ Error_Msg_N ("|this expression must be parenthesized!", N);
Error_Msg_N
("\|since extensions (and set notation) are allowed", N);
end if;
or else Token = Tok_Record
or else Token = Tok_Null
then
- Error_Msg_AP -- CODEFIX???
- ("TAGGED expected");
+ Error_Msg_AP ("TAGGED expected");
end if;
end if;
-- Special check for misuse of Aliased
if Token = Tok_Aliased or else Token_Name = Name_Aliased then
- Error_Msg_SC -- CODEFIX???
- ("ALIASED not allowed in type definition");
+ Error_Msg_SC ("ALIASED not allowed in type definition");
Scan; -- past ALIASED
end if;
elsif Abstract_Present
and then Prev_Token /= Tok_Tagged
then
- Error_Msg_SP -- CODEFIX???
- ("TAGGED expected");
+ Error_Msg_SP ("TAGGED expected");
end if;
Typedef_Node := P_Record_Definition;
if Nkind (Typedef_Node) =
N_Derived_Type_Definition
then
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("SYNCHRONIZED not allowed for record extension",
Typedef_Node);
else
else
if Token /= Tok_Interface then
- Error_Msg_SC -- CODEFIX???
- ("NEW or INTERFACE expected");
+ Error_Msg_SC ("NEW or INTERFACE expected");
end if;
Typedef_Node :=
Set_Abstract_Present (Typedef_Node, Abstract_Present);
elsif Abstract_Present then
- Error_Msg -- CODEFIX???
- ("ABSTRACT not allowed here, ignored", Abstract_Loc);
+ Error_Msg ("ABSTRACT not allowed here, ignored", Abstract_Loc);
end if;
Decl_Node := New_Node (N_Full_Type_Declaration, Type_Loc);
end if;
else
- Error_Msg_SP -- CODEFIX???
- ("NULL expected");
+ Error_Msg_SP ("NULL expected");
end if;
if Token = Tok_New then
- Error_Msg -- CODEFIX???
- ("`NOT NULL` comes after NEW, not before", Not_Loc);
+ Error_Msg ("`NOT NULL` comes after NEW, not before", Not_Loc);
end if;
return True;
return Subtype_Mark;
else
if Not_Null_Present then
- Error_Msg_SP -- CODEFIX???
- ("`NOT NULL` not allowed if constraint given");
+ Error_Msg_SP ("`NOT NULL` not allowed if constraint given");
end if;
Indic_Node := New_Node (N_Subtype_Indication, Sloc (Subtype_Mark));
procedure No_List is
begin
if Num_Idents > 1 then
- Error_Msg -- CODEFIX???
+ Error_Msg
("identifier list not allowed for RENAMES",
Sloc (Idents (2)));
end if;
Scan; -- past :=
if Token = Tok_Constant then
- Error_Msg_SP -- CODEFIX???
- ("colon expected");
+ Error_Msg_SP ("colon expected");
else
Restore_Scan_State (Scan_State);
if Present (Init_Expr) then
if Not_Null_Present then
- Error_Msg_SP -- CODEFIX???
+ Error_Msg_SP
("`NOT NULL` not allowed in numeric expression");
end if;
end if;
if Token = Tok_Renames then
- Error_Msg -- CODEFIX???
+ Error_Msg
("CONSTANT not permitted in renaming declaration",
Con_Loc);
Scan; -- Past renames
if Token_Is_Renames then
if Ada_Version < Ada_05 then
- Error_Msg_SP -- CODEFIX???
+ Error_Msg_SP
("`NOT NULL` not allowed in object renaming");
raise Error_Resync;
-- illegal
if Token_Is_Renames then
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("constraint not allowed in object renaming "
& "declaration",
Constraint (Object_Definition (Decl_Node)));
-- a constraint on the Type_Node and renames, which is illegal
if Token_Is_Renames then
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("constraint not allowed in object renaming declaration",
Constraint (Object_Definition (Decl_Node)));
raise Error_Resync;
end loop;
if Token /= Tok_With then
- Error_Msg_SC -- CODEFIX???
- ("WITH expected");
+ Error_Msg_SC ("WITH expected");
raise Error_Resync;
end if;
end if;
T_With; -- past WITH or give error message
if Token = Tok_Limited then
- Error_Msg_SC -- CODEFIX???
- ("LIMITED keyword not allowed in private extension");
+ Error_Msg_SC ("LIMITED keyword not allowed in private extension");
Scan; -- ignore LIMITED
end if;
if Nkind (Expr_Node) in N_Subexpr
and then Paren_Count (Expr_Node) /= 0
then
- Error_Msg -- CODEFIX???
- ("|parentheses not allowed for subtype mark", Save_Loc);
+ Error_Msg ("|parentheses not allowed for subtype mark", Save_Loc);
Set_Paren_Count (Expr_Node, 0);
end if;
end if;
if Aliased_Present then
- Error_Msg_SP -- CODEFIX???
- ("ALIASED not allowed here");
+ Error_Msg_SP ("ALIASED not allowed here");
end if;
Set_Subtype_Indication (CompDef_Node, Empty);
if Token = Tok_Colon then
Restore_Scan_State (Scan_State);
- Error_Msg_SC -- CODEFIX???
- ("component may not follow variant part");
+ Error_Msg_SC ("component may not follow variant part");
Discard_Junk_Node (P_Component_List);
elsif Token = Tok_Case then
Set_Defining_Identifier (Decl_Node, Idents (Ident));
if Token = Tok_Constant then
- Error_Msg_SC -- CODEFIX???
- ("constant components are not permitted");
+ Error_Msg_SC ("constant components are not permitted");
Scan;
end if;
end if;
if Aliased_Present then
- Error_Msg_SP -- CODEFIX???
- ("ALIASED not allowed here");
+ Error_Msg_SP ("ALIASED not allowed here");
end if;
Set_Subtype_Indication (CompDef_Node, Empty);
Set_Null_Exclusion_Present (CompDef_Node, Not_Null_Present);
if Token = Tok_Array then
- Error_Msg_SC -- CODEFIX???
- ("anonymous arrays not allowed as components");
+ Error_Msg_SC ("anonymous arrays not allowed as components");
raise Error_Resync;
end if;
Error_Msg ("discriminant name expected", Sloc (Case_Node));
elsif Paren_Count (Case_Node) /= 0 then
- Error_Msg -- CODEFIX???
+ Error_Msg
("|discriminant name may not be parenthesized",
Sloc (Case_Node));
Set_Paren_Count (Case_Node, 0);
end if;
if Abstract_Present then
- Error_Msg_SP -- CODEFIX???
+ Error_Msg_SP
("ABSTRACT not allowed in interface type definition " &
"(RM 3.9.4(2/2))");
end if;
else
if Token /= Tok_And then
- Error_Msg_AP -- CODEFIX???
- ("AND expected");
+ Error_Msg_AP ("AND expected");
else
Scan; -- past AND
end if;
Scan; -- past possible junk subprogram name
if Token = Tok_Left_Paren or else Token = Tok_Semicolon then
- Error_Msg_SP -- CODEFIX???
- ("unexpected subprogram name ignored");
+ Error_Msg_SP ("unexpected subprogram name ignored");
return;
else
if Token = Tok_All then
if Ada_Version < Ada_05 then
- Error_Msg_SP -- CODEFIX???
+ Error_Msg_SP
("ALL is not permitted for anonymous access types");
end if;
when Tok_With =>
Check_Bad_Layout;
- Error_Msg_SC -- CODEFIX???
- ("WITH can only appear in context clause");
+ Error_Msg_SC ("WITH can only appear in context clause");
raise Error_Resync;
-- BEGIN terminates the scan of a sequence of declarations unless
if In_Spec then
Done := True;
else
- Error_Msg_SC -- CODEFIX???
- ("PRIVATE not allowed in body");
+ Error_Msg_SC ("PRIVATE not allowed in body");
Scan; -- past PRIVATE
end if;
Kind = N_Task_Body or else
Kind = N_Protected_Body
then
- Error_Msg -- CODEFIX???
- ("proper body not allowed in package spec", Sloc (Decl));
+ Error_Msg ("proper body not allowed in package spec", Sloc (Decl));
-- Test for body stub scanned, not acceptable as basic decl item
elsif Kind in N_Body_Stub then
- Error_Msg -- CODEFIX???
- ("body stub not allowed in package spec", Sloc (Decl));
+ Error_Msg ("body stub not allowed in package spec", Sloc (Decl));
elsif Kind = N_Assignment_Statement then
- Error_Msg -- CODEFIX???
+ Error_Msg
("assignment statement not allowed in package spec",
Sloc (Decl));
end if;
-- not allowed in package spec. This message never gets changed.
if In_Spec then
- Error_Msg_SC -- CODEFIX???
- ("statement not allowed in package spec");
+ Error_Msg_SC ("statement not allowed in package spec");
-- If in declarative part, then we give the message complaining
-- about finding a statement when a declaration is expected. This
-- find that no BEGIN is present.
else
- Error_Msg_SC -- CODEFIX???
- ("statement not allowed in declarative part");
+ Error_Msg_SC ("statement not allowed in declarative part");
end if;
-- Capture message Id. This is used for two purposes, first to
begin
if Token_Is_At_Start_Of_Line then
Restore_Scan_State (Scan_State); -- to apostrophe
- Error_Msg_SC -- CODEFIX???
- ("|""''"" should be "";""");
+ Error_Msg_SC ("|""''"" should be "";""");
Token := Tok_Semicolon;
return True;
else
elsif Token = Tok_Range then
if Expr_Form /= EF_Simple_Name then
- Error_Msg_SC -- CODEFIX???
- ("subtype mark must precede RANGE");
+ Error_Msg_SC ("subtype mark must precede RANGE");
raise Error_Resync;
end if;
-- a possible fix.
if Nkind (Expr_Node) = N_Op_Eq then
- Error_Msg_N -- CODEFIX???
- ("\maybe `='>` was intended", Expr_Node);
+ Error_Msg_N ("\maybe `='>` was intended", Expr_Node);
end if;
-- We go back to scanning out expressions, so that we do not get
and then
Nkind (Aggr_Node) /= N_Extension_Aggregate
then
- Error_Msg -- CODEFIX???
+ Error_Msg
("aggregate may not have single positional component", Aggr_Sloc);
return Error;
else
if Nkind (Expr_Node) = N_Attribute_Reference
and then Attribute_Name (Expr_Node) = Name_Range
then
- Error_Msg -- CODEFIX???
+ Error_Msg
("|parentheses not allowed for range attribute", Lparen_Sloc);
Scan; -- past right paren
return Expr_Node;
Scan; -- scan past right paren if present
end if;
- Error_Msg -- CODEFIX???
- ("parentheses not allowed for range attribute", Lptr);
+ Error_Msg ("parentheses not allowed for range attribute", Lptr);
return Attr_Node;
end if;
-- that way with an error message.
elsif Extensions_Allowed then
- Error_Msg_SC -- CODEFIX???
+ Error_Msg_SC
("conditional expression must be parenthesized");
return P_Conditional_Expression;
-- with an error message.
elsif Extensions_Allowed then
- Error_Msg_SC -- CODEFIX???
- ("case expression must be parenthesized");
+ Error_Msg_SC ("case expression must be parenthesized");
return P_Case_Expression;
-- Otherwise treat as misused identifier
-- If we have an END CASE, diagnose as not needed
if Token = Tok_End then
- Error_Msg_SC -- CODEFIX???
- ("`END CASE` not allowed at end of case expression");
+ Error_Msg_SC ("`END CASE` not allowed at end of case expression");
Scan; -- past END
if Token = Tok_Case then
-- If we have an END IF, diagnose as not needed
if Token = Tok_End then
- Error_Msg_SC -- CODEFIX???
+ Error_Msg_SC
("`END IF` not allowed at end of conditional expression");
Scan; -- past END
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
procedure Test_Statement_Required is
begin
if Statement_Required then
- Error_Msg_BC ("statement expected");
+ Error_Msg_BC -- CODEFIX
+ ("statement expected");
end if;
end Test_Statement_Required;
or else
Nkind (Name_Node) = N_Selected_Component)
then
- Error_Msg_SC ("""/"" should be "".""");
+ Error_Msg_SC -- CODEFIX
+ ("""/"" should be "".""");
Statement_Required := False;
raise Error_Resync;
Junk_Declaration;
else
- Error_Msg_BC ("statement expected");
+ Error_Msg_BC -- CODEFIX
+ ("statement expected");
raise Error_Resync;
end if;
end case;
-- of WHEN expression =>
if Token = Tok_Arrow then
- Error_Msg_SC ("THEN expected");
+ Error_Msg_SC -- CODEFIX
+ ("THEN expected");
Scan; -- past the arrow
Pop_Scope_Stack; -- remove unneeded entry
raise Error_Resync;
Scan; -- past ELSE
if Else_Should_Be_Elsif then
- Error_Msg_SP ("ELSE should be ELSIF");
+ Error_Msg_SP -- CODEFIX
+ ("ELSE should be ELSIF");
Add_Elsif_Part;
else
if Token = Tok_Colon_Equal then
while Token = Tok_Colon_Equal loop
- Error_Msg_SC (""":="" should be ""=""");
+ Error_Msg_SC -- CODEFIX
+ (""":="" should be ""=""");
Scan; -- past junk :=
Discard_Junk_Node (P_Expression_No_Right_Paren);
end loop;
-- What we are interested in is whether it was a case of a bad IS.
if Scope.Table (Scope.Last + 1).Etyp = E_Bad_Is then
- Error_Msg ("|IS should be "";""", Scope.Table (Scope.Last + 1).S_Is);
+ Error_Msg -- CODEFIX
+ ("|IS should be "";""", Scope.Table (Scope.Last + 1).S_Is);
Set_Bad_Is_Detected (Parent, True);
end if;
TF_Then;
while Token = Tok_Then loop
- Error_Msg_SC ("redundant THEN");
+ Error_Msg_SC -- CODEFIX
+ ("redundant THEN");
TF_Then;
end loop;
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
if Token = Tok_Return then
Restore_Scan_State (Scan_State);
- Error_Msg_SC ("|extra "";"" ignored");
+ Error_Msg_SC -- CODEFIX
+ ("|extra "";"" ignored");
Scan; -- rescan past junk semicolon
else
Restore_Scan_State (Scan_State);
Not_Overriding := True;
else
- Error_Msg_SC ("OVERRIDING expected!");
+ Error_Msg_SC -- CODEFIX
+ ("OVERRIDING expected!");
end if;
-- Ada 2005: scan leading OVERRIDING indicator
if Token = Tok_Return then
if not Func then
- Error_Msg ("PROCEDURE should be FUNCTION", Fproc_Sloc);
+ Error_Msg -- CODEFIX
+ ("PROCEDURE should be FUNCTION", Fproc_Sloc);
Func := True;
end if;
Scan; -- past semicolon
if Token = Tok_Is then
- Error_Msg_SP ("extra "";"" ignored");
+ Error_Msg_SP -- CODEFIX
+ ("extra "";"" ignored");
else
Restore_Scan_State (Scan_State);
end if;
-- semicolon, and go process the body.
if Token = Tok_Is then
- Error_Msg_SP ("|extra "";"" ignored");
+ Error_Msg_SP -- CODEFIX
+ ("|extra "";"" ignored");
T_Is; -- scan past IS
goto Subprogram_Body;
elsif Token = Tok_Begin
and then Start_Column >= Scope.Table (Scope.Last).Ecol
then
- Error_Msg_SP ("|"";"" should be IS!");
+ Error_Msg_SP -- CODEFIX
+ ("|"";"" should be IS!");
goto Subprogram_Body;
else
-- Deal nicely with (now obsolete) use of <> in place of abstract
if Token = Tok_Box then
- Error_Msg_SC ("ABSTRACT expected");
+ Error_Msg_SC -- CODEFIX
+ ("ABSTRACT expected");
Token := Tok_Abstract;
end if;
-- semicolon which should really be an IS
else
- Error_Msg_AP ("|missing "";""");
+ Error_Msg_AP -- CODEFIX
+ ("|missing "";""");
SIS_Missing_Semicolon_Message := Get_Msg_Id;
goto Subprogram_Declaration;
end if;
-- that semicolon should have been a right parenthesis and exit
if Token = Tok_Is or else Token = Tok_Return then
- Error_Msg_SP ("|"";"" should be "")""");
+ Error_Msg_SP -- CODEFIX
+ ("|"";"" should be "")""");
exit Specification_Loop;
end if;
-- assume we had a missing right parenthesis and terminate list
if Token in Token_Class_Declk then
- Error_Msg_AP ("missing "")""");
+ Error_Msg_AP -- CODEFIX
+ ("missing "")""");
Restore_Scan_State (Scan_State);
exit Specification_Loop;
end if;
Set_In_Present (Node, True);
if Style.Mode_In_Check and then Token /= Tok_Out then
- Error_Msg_SP ("(style) IN should be omitted");
+ Error_Msg_SP -- CODEFIX
+ ("(style) IN should be omitted");
end if;
if Token = Tok_Access then
end if;
if Token = Tok_In then
- Error_Msg_SC -- CODEFIX ???
- ("IN must precede OUT in parameter mode");
+ Error_Msg_SC ("IN must precede OUT in parameter mode");
Scan; -- past IN
Set_In_Present (Node, True);
end if;
if Token_Is_At_Start_Of_Line
and then Start_Column /= Error_Msg_Col
then
- Error_Msg_SC -- CODEFIX???
+ Error_Msg_SC
("(style) PRIVATE in wrong column, should be@");
end if;
end if;
-- Deal gracefully with multiple PRIVATE parts
while Token = Tok_Private loop
- Error_Msg_SC -- CODEFIX???
+ Error_Msg_SC
("only one private part allowed per package");
Scan; -- past PRIVATE
Append_List (P_Basic_Declarative_Items,
end if;
if Token = Tok_Begin then
- Error_Msg_SC -- CODEFIX???
- ("begin block not allowed in package spec");
+ Error_Msg_SC ("begin block not allowed in package spec");
Scan; -- past BEGIN
Discard_Junk_List (P_Sequence_Of_Statements (SS_None));
end if;
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
Scan; -- past semicolon
if Token = Tok_Entry then
- Error_Msg_SP ("|"";"" should be IS");
+ Error_Msg_SP -- CODEFIX
+ ("|"";"" should be IS");
Set_Task_Definition (Task_Node, P_Task_Definition);
else
Pop_Scope_Stack; -- Remove unused entry
end loop;
if Token /= Tok_With then
- Error_Msg_SC ("WITH expected");
+ Error_Msg_SC -- CODEFIX
+ ("WITH expected");
end if;
Scan; -- past WITH
if Token = Tok_Private then
- Error_Msg_SP
+ Error_Msg_SP -- CODEFIX
("PRIVATE not allowed in task type declaration");
end if;
end if;
if Token /= Tok_Is then
Restore_Scan_State (Scan_State);
- Error_Msg_SC ("missing IS");
+ Error_Msg_SC -- CODEFIX
+ ("missing IS");
Set_Protected_Definition (Protected_Node,
Make_Protected_Definition (Token_Ptr,
Visible_Declarations => Empty_List,
return Protected_Node;
end if;
- Error_Msg_SP ("|extra ""("" ignored");
+ Error_Msg_SP -- CODEFIX
+ ("|extra ""("" ignored");
end if;
T_Is;
end loop;
if Token /= Tok_With then
- Error_Msg_SC ("WITH expected");
+ Error_Msg_SC -- CODEFIX
+ ("WITH expected");
end if;
Scan; -- past WITH
Scan; -- past OVERRIDING
Not_Overriding := True;
else
- Error_Msg_SC ("OVERRIDING expected!");
+ Error_Msg_SC -- CODEFIX
+ ("OVERRIDING expected!");
end if;
else
Scan; -- past PRIVATE
elsif Token = Tok_Identifier then
- Error_Msg_SC
- ("all components must be declared in spec!");
+ Error_Msg_SC ("all components must be declared in spec!");
Resync_Past_Semicolon;
elsif Token in Token_Class_Declk then
Scan; -- part OVERRIDING
Not_Overriding := True;
else
- Error_Msg_SC ("OVERRIDING expected!");
+ Error_Msg_SC -- CODEFIX
+ ("OVERRIDING expected!");
end if;
elsif Token = Tok_Overriding then
Error_Msg_SP ("\unit must be compiled with -gnat05 switch");
elsif Token /= Tok_Entry then
- Error_Msg_SC ("ENTRY expected!");
+ Error_Msg_SC -- CODEFIX
+ ("ENTRY expected!");
end if;
end if;
Bnode := P_Expression_No_Right_Paren;
if Token = Tok_Colon_Equal then
- Error_Msg_SC ("|"":="" should be ""=""");
+ Error_Msg_SC -- CODEFIX
+ ("|"":="" should be ""=""");
Scan;
Bnode := P_Expression_No_Right_Paren;
end if;
Error_Msg_Name_2 := Name_On;
Error_Msg_Name_3 := Name_Off;
- Error_Msg -- CODEFIX???
- ("argument for pragma% must be% or%", Sloc (Argx));
+ Error_Msg ("argument for pragma% must be% or%", Sloc (Argx));
raise Error_Resync;
end if;
end Check_Arg_Is_On_Or_Off;
for J in 1 .. Name_Len loop
if Is_Directory_Separator (Name_Buffer (J)) then
- Error_Msg -- CODEFIX???
+ Error_Msg
("directory separator character not allowed",
Sloc (Expression (Arg)) + Source_Ptr (J));
end if;
end if;
end if;
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("Casing argument for pragma% must be " &
"one of Mixedcase, Lowercase, Uppercase",
Arg);
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- A little recovery helper, accept then in place of =>
elsif Token = Tok_Then then
- Error_Msg_BC ("|THEN should be ""='>""");
+ Error_Msg_BC -- CODEFIX
+ ("|THEN should be ""='>""");
Scan; -- past THEN used in place of =>
elsif Token = Tok_Colon_Equal then
- Error_Msg_SC ("|"":="" should be ""='>""");
+ Error_Msg_SC -- CODEFIX
+ ("|"":="" should be ""='>""");
Scan; -- past := used in place of =>
else
- Error_Msg_AP ("missing ""='>""");
+ Error_Msg_AP -- CODEFIX
+ ("missing ""='>""");
end if;
end T_Arrow;
if Token = Tok_Box then
Scan;
else
- Error_Msg_AP ("missing ""'<'>""");
+ Error_Msg_AP -- CODEFIX
+ ("missing ""'<'>""");
end if;
end T_Box;
if Token = Tok_Colon then
Scan;
else
- Error_Msg_AP ("missing "":""");
+ Error_Msg_AP -- CODEFIX
+ ("missing "":""");
end if;
end T_Colon;
Scan;
elsif Token = Tok_Equal then
- Error_Msg_SC ("|""="" should be "":=""");
+ Error_Msg_SC -- CODEFIX
+ ("|""="" should be "":=""");
Scan;
elsif Token = Tok_Colon then
- Error_Msg_SC ("|"":"" should be "":=""");
+ Error_Msg_SC -- CODEFIX
+ ("|"":"" should be "":=""");
Scan;
elsif Token = Tok_Is then
- Error_Msg_SC ("|IS should be "":=""");
+ Error_Msg_SC -- CODEFIX
+ ("|IS should be "":=""");
Scan;
else
- Error_Msg_AP ("missing "":=""");
+ Error_Msg_AP -- CODEFIX
+ ("missing "":=""");
end if;
end T_Colon_Equal;
if Token = Tok_Comma then
Scan;
else
- Error_Msg_AP ("missing "",""");
+ Error_Msg_AP -- CODEFIX
+ ("missing "",""");
end if;
end if;
if Token = Tok_Dot_Dot then
Scan;
else
- Error_Msg_AP ("missing ""..""");
+ Error_Msg_AP -- CODEFIX
+ ("missing ""..""");
end if;
end T_Dot_Dot;
if Token = Tok_Greater_Greater then
Scan;
else
- Error_Msg_AP ("missing ""'>'>""");
+ Error_Msg_AP -- CODEFIX
+ ("missing ""'>'>""");
end if;
end T_Greater_Greater;
-- Allow OF, => or = to substitute for IS with complaint
elsif Token = Tok_Arrow then
- Error_Msg_SC ("|""=>"" should be IS");
+ Error_Msg_SC -- CODEFIX
+ ("|""=>"" should be IS");
Scan; -- past =>
elsif Token = Tok_Of then
- Error_Msg_SC ("|OF should be IS");
+ Error_Msg_SC -- CODEFIX
+ ("|OF should be IS");
Scan; -- past OF
elsif Token = Tok_Equal then
- Error_Msg_SC ("|""="" should be IS");
+ Error_Msg_SC -- CODEFIX
+ ("|""="" should be IS");
Scan; -- past =
else
-- Ignore extra IS keywords
while Token = Tok_Is loop
- Error_Msg_SC ("|extra IS ignored");
+ Error_Msg_SC -- CODEFIX
+ ("|extra IS ignored");
Scan;
end loop;
end T_Is;
if Token = Tok_Left_Paren then
Scan;
else
- Error_Msg_AP ("missing ""(""");
+ Error_Msg_AP -- CODEFIX
+ ("missing ""(""");
end if;
end T_Left_Paren;
procedure T_Loop is
begin
if Token = Tok_Do then
- Error_Msg_SC ("LOOP expected");
+ Error_Msg_SC -- CODEFIX
+ ("LOOP expected");
Scan;
else
Check_Token (Tok_Loop, AP);
if Token = Tok_Right_Paren then
Scan;
else
- Error_Msg_AP ("|missing "")""");
+ Error_Msg_AP -- CODEFIX
+ ("|missing "")""");
end if;
end T_Right_Paren;
Scan;
if Token = Tok_Semicolon then
- Error_Msg_SC ("|extra "";"" ignored");
+ Error_Msg_SC -- CODEFIX
+ ("|extra "";"" ignored");
Scan;
end if;
return;
elsif Token = Tok_Colon then
- Error_Msg_SC ("|"":"" should be "";""");
+ Error_Msg_SC -- CODEFIX
+ ("|"":"" should be "";""");
Scan;
return;
elsif Token = Tok_Comma then
- Error_Msg_SC ("|"","" should be "";""");
+ Error_Msg_SC -- CODEFIX
+ ("|"","" should be "";""");
Scan;
return;
elsif Token = Tok_Dot then
- Error_Msg_SC ("|""."" should be "";""");
+ Error_Msg_SC -- CODEFIX
+ ("|""."" should be "";""");
Scan;
return;
-- If none of those tests return, we really have a missing semicolon
- Error_Msg_AP ("|missing "";""");
+ Error_Msg_AP -- CODEFIX
+ ("|missing "";""");
return;
end T_Semicolon;
Scan; -- skip RETURN and we are done
else
- Error_Msg_SC ("missing RETURN");
+ Error_Msg_SC -- CODEFIX
+ ("missing RETURN");
Save_Scan_State (Scan_State); -- at start of junk tokens
loop
if Token = Tok_Left_Paren then
Scan;
else
- Error_Msg_AP ("missing ""(""!");
+ Error_Msg_AP -- CODEFIX
+ ("missing ""(""!");
end if;
end U_Left_Paren;
if Token = Tok_Right_Paren then
Scan;
else
- Error_Msg_AP ("|missing "")""!");
+ Error_Msg_AP -- CODEFIX
+ ("|missing "")""!");
end if;
end U_Right_Paren;
Scan;
if Token = T then
- Error_Msg_SP ("|extra "";"" ignored");
+ Error_Msg_SP -- CODEFIX
+ ("|extra "";"" ignored");
Scan;
else
Error_Msg_SP (M);
Scan;
if Token = T then
- Error_Msg_SP ("|extra "","" ignored");
+ Error_Msg_SP -- CODEFIX
+ ("|extra "","" ignored");
Scan;
else
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
and then Name_Len = 7
and then Name_Buffer (1 .. 7) = "program"
then
- Error_Msg_SC ("PROCEDURE expected");
+ Error_Msg_SC -- CODEFIX
+ ("PROCEDURE expected");
Token := T;
return True;
M2 (P2 + J - 1) := Fold_Upper (S (J));
end loop;
- Error_Msg_SC -- CODEFIX???
- (M2 (1 .. P2 - 1 + S'Last));
+ Error_Msg_SC (M2 (1 .. P2 - 1 + S'Last));
Token := T;
return True;
end if;
<<Assume_Comma>>
Restore_Scan_State (Scan_State);
- Error_Msg_SC ("|"";"" should be "",""");
+ Error_Msg_SC -- CODEFIX
+ ("|"";"" should be "",""");
Scan; -- past the semicolon
return True;
begin
while Token = T loop
if T = Tok_Comma then
- Error_Msg_SC ("|extra "","" ignored");
+ Error_Msg_SC -- CODEFIX
+ ("|extra "","" ignored");
elsif T = Tok_Left_Paren then
- Error_Msg_SC ("|extra ""("" ignored");
+ Error_Msg_SC -- CODEFIX
+ ("|extra ""("" ignored");
elsif T = Tok_Right_Paren then
- Error_Msg_SC ("|extra "")"" ignored");
+ Error_Msg_SC -- CODEFIX
+ ("|extra "")"" ignored");
elsif T = Tok_Semicolon then
- Error_Msg_SC ("|extra "";"" ignored");
+ Error_Msg_SC -- CODEFIX
+ ("|extra "";"" ignored");
elsif T = Tok_Colon then
- Error_Msg_SC ("|extra "":"" ignored");
+ Error_Msg_SC -- CODEFIX
+ ("|extra "":"" ignored");
else
declare
Tname : constant String := Token_Type'Image (Token);
begin
- Error_Msg_SC
- ("|extra " & Tname (5 .. Tname'Last) & "ignored");
+ Error_Msg_SC ("|extra " & Tname (5 .. Tname'Last) & "ignored");
end;
end if;
end;
Error_Msg_Node_1 := Prev;
- Error_Msg_SC
- ("unexpected identifier, possibly & was meant here");
+ Error_Msg_SC ("unexpected identifier, possibly & was meant here");
Scan;
end Merge_Identifier;
-- --
-- B o d y --
-- --
--- Copyright (C) 2002-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 2002-2010, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
Scan.all;
else
- Error_Msg ("`)` expected", Token_Ptr);
+ Error_Msg -- CODEFIX
+ ("`)` expected", Token_Ptr);
end if;
when Tok_Not =>
Scan.all;
if Token /= Tok_Colon_Equal then
- Error_Msg ("`:=` expected", Token_Ptr);
+ Error_Msg -- CODEFIX
+ ("`:=` expected", Token_Ptr);
goto Cleanup;
end if;
elsif
Pp_States.Table (Pp_States.Last).Else_Ptr /= 0
then
- Error_Msg ("duplicate ELSE line", Token_Ptr);
+ Error_Msg -- CODEFIX
+ ("duplicate ELSE line", Token_Ptr);
No_Error_Found := False;
end if;
Scan.all;
if Token /= Tok_If then
- Error_Msg ("IF expected", Token_Ptr);
+ Error_Msg -- CODEFIX
+ ("IF expected", Token_Ptr);
No_Error_Found := False;
else
Scan.all;
if Token /= Tok_Semicolon then
- Error_Msg ("`;` Expected", Token_Ptr);
+ Error_Msg -- CODEFIX
+ ("`;` Expected", Token_Ptr);
No_Error_Found := False;
else
No_Error_Found := False;
if Pp_States.Last = 0 then
- Error_Msg ("IF expected", Token_Ptr);
+ Error_Msg -- CODEFIX
+ ("IF expected", Token_Ptr);
elsif
Pp_States.Table (Pp_States.Last).Else_Ptr = 0
then
- Error_Msg ("IF, ELSIF, ELSE, or `END IF` expected",
- Token_Ptr);
+ Error_Msg
+ ("IF, ELSIF, ELSE, or `END IF` expected",
+ Token_Ptr);
else
Error_Msg ("IF or `END IF` expected", Token_Ptr);
-- --
-- B o d y --
-- --
--- Copyright (C) 2003-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 2003-2010, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
while Token /= Tok_End_Of_Line and then Token /= Tok_EOF loop
if Token /= Tok_Minus then
- Error_Msg ("`'-` expected", Token_Ptr);
+ Error_Msg -- CODEFIX
+ ("`'-` expected", Token_Ptr);
Skip_To_End_Of_Line;
goto Scan_Line;
end if;
Scan;
if Token /= Tok_Equal then
- Error_Msg ("`=` expected", Token_Ptr);
+ Error_Msg -- CODEFIX
+ ("`=` expected", Token_Ptr);
Skip_To_End_Of_Line;
goto Scan_Line;
end if;
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
and then Source (Scan_Ptr + 2) = C
then
Scan_Ptr := Scan_Ptr + 1;
- Error_Msg_S ("no space allowed here");
+ Error_Msg_S -- CODEFIX
+ ("no space allowed here");
Scan_Ptr := Scan_Ptr + 2;
return True;
Error_Msg_S -- CODEFIX
("two consecutive underlines not permitted");
else
- Error_Msg_S -- CODEFIX???
- ("underline cannot follow punctuation character");
+ Error_Msg_S ("underline cannot follow punctuation character");
end if;
else
if Source (Scan_Ptr - 1) = '_' then
- Error_Msg_S -- CODEFIX???
- ("punctuation character cannot follow underline");
+ Error_Msg_S ("punctuation character cannot follow underline");
else
- Error_Msg_S -- CODEFIX???
+ Error_Msg_S
("two consecutive punctuation characters not permitted");
end if;
end if;
if Warn_On_Obsolescent_Feature then
Error_Msg_S
("use of "":"" is an obsolescent feature (RM J.2(3))?");
- Error_Msg_S
- ("\use ""'#"" instead?");
+ Error_Msg_S ("\use ""'#"" instead?");
end if;
end if;
elsif not Identifier_Char (C) then
if Base_Char = '#' then
- Error_Msg_S ("missing '#");
+ Error_Msg_S -- CODEFIX
+ ("missing '#");
else
- Error_Msg_S ("missing ':");
+ Error_Msg_S -- CODEFIX
+ ("missing ':");
end if;
exit;
end if;
end if;
- Error_Msg_S -- CODEFIX
+ Error_Msg_S -- CODEFIX
("missing string quote");
end Error_Unterminated_String;
Accumulate_Checksum ('&');
if Source (Scan_Ptr + 1) = '&' then
- Error_Msg_S ("'&'& should be `AND THEN`");
+ Error_Msg_S -- CODEFIX
+ ("'&'& should be `AND THEN`");
Scan_Ptr := Scan_Ptr + 2;
Token := Tok_And;
return;
and then Source (Scan_Ptr + 2) /= '-'
then
Token := Tok_Colon_Equal;
- Error_Msg (":- should be :=", Scan_Ptr);
+ Error_Msg -- CODEFIX
+ (":- should be :=", Scan_Ptr);
Scan_Ptr := Scan_Ptr + 2;
return;
return;
elsif Source (Scan_Ptr + 1) = '=' then
- Error_Msg_S ("== should be =");
+ Error_Msg_S -- CODEFIX
+ ("== should be =");
Scan_Ptr := Scan_Ptr + 1;
end if;
if Warn_On_Obsolescent_Feature then
Error_Msg_S
("use of ""'%"" is an obsolescent feature (RM J.2(4))?");
- Error_Msg_S
- ("\use """""" instead?");
+ Error_Msg_S ("\use """""" instead?");
end if;
Slit;
elsif Ada_Version >= Ada_05
and then Is_UTF_32_Non_Graphic (UTF_32 (Code))
then
- Error_Msg
+ Error_Msg -- CODEFIX????
("(Ada 2005) non-graphic character not permitted " &
"in character literal", Wptr);
end if;
if Source (Scan_Ptr) /= ''' then
- Error_Msg_S ("missing apostrophe");
+ Error_Msg_S ("missing apostrophe");
else
Scan_Ptr := Scan_Ptr + 1;
end if;
-- Special check for || to give nice message
if Source (Scan_Ptr + 1) = '|' then
- Error_Msg_S ("""'|'|"" should be `OR ELSE`");
+ Error_Msg_S -- CODEFIX
+ ("""'|'|"" should be `OR ELSE`");
Scan_Ptr := Scan_Ptr + 2;
Token := Tok_Or;
return;
if Warn_On_Obsolescent_Feature then
Error_Msg_S
("use of ""'!"" is an obsolescent feature (RM J.2(2))?");
- Error_Msg_S
- ("\use ""'|"" instead?");
+ Error_Msg_S ("\use ""'|"" instead?");
end if;
if Source (Scan_Ptr + 1) = '=' then
- Error_Msg_S ("'!= should be /=");
+ Error_Msg_S -- CODEFIX
+ ("'!= should be /=");
Scan_Ptr := Scan_Ptr + 2;
Token := Tok_Not_Equal;
return;
-- Punctuation is an error (at start of identifier)
elsif Is_UTF_32_Punctuation (Cat) then
- Error_Msg
- ("identifier cannot start with punctuation", Wptr);
+ Error_Msg ("identifier cannot start with punctuation", Wptr);
Scan_Ptr := Wptr;
Name_Len := 0;
Underline_Found := False;
-- Mark character is an error (at start of identifier)
elsif Is_UTF_32_Mark (Cat) then
- Error_Msg
- ("identifier cannot start with mark character", Wptr);
+ Error_Msg ("identifier cannot start with mark character", Wptr);
Scan_Ptr := Wptr;
Name_Len := 0;
Underline_Found := False;
-- aggregate must not be enclosed in parentheses.
if Paren_Count (Expr) /= 0 then
- Error_Msg_N -- CODEFIX???
- ("no parenthesis allowed here", Expr);
+ Error_Msg_N ("no parenthesis allowed here", Expr);
end if;
Make_String_Into_Aggregate (Expr);
-- a missing component association for a 1-aggregate.
if Paren_Count (Expr) > 0 then
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("\if single-component aggregate is intended,"
& " write e.g. (1 ='> ...)", Expr);
end if;
if Choice /= First (Choices (Assoc))
or else Present (Next (Choice))
then
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("OTHERS must appear alone in a choice list", Choice);
return Failure;
end if;
if Present (Next (Assoc)) then
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("OTHERS must appear last in an aggregate", Choice);
return Failure;
end if;
if Selector_Name /= First (Choices (Assoc))
or else Present (Next (Selector_Name))
then
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("OTHERS must appear alone in a choice list",
Selector_Name);
return;
elsif Present (Next (Assoc)) then
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("OTHERS must appear last in an aggregate",
Selector_Name);
return;
if Nkind (Parent (Base_Type (Root_Typ))) =
N_Private_Type_Declaration
then
- Error_Msg_NE -- CODEFIX???
+ Error_Msg_NE
("type of aggregate has private ancestor&!",
N, Root_Typ);
- Error_Msg_N -- CODEFIX???
- ("must use extension aggregate!", N);
+ Error_Msg_N ("must use extension aggregate!", N);
return;
end if;
N_Private_Extension_Declaration
then
if Nkind (N) /= N_Extension_Aggregate then
- Error_Msg_NE -- CODEFIX???
+ Error_Msg_NE
("type of aggregate has private ancestor&!",
N, Parent_Typ);
- Error_Msg_N -- CODEFIX???
- ("must use extension aggregate!", N);
+ Error_Msg_N ("must use extension aggregate!", N);
return;
elsif Parent_Typ /= Root_Typ then
if No (Others_Etype)
and then not Others_Box
then
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("OTHERS must represent at least one component", Selectr);
end if;
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
and then Base_Type (Typ) = Typ
and then Warn_On_Redundant_Constructs
then
- Error_Msg_NE
- ("?redundant attribute, & is its own base type", N, Typ);
+ Error_Msg_NE -- CODEFIX
+ ("?redundant attribute, & is its own base type", N, Typ);
end if;
Set_Etype (N, Base_Type (Entity (P)));
-- know will fail, so generate an appropriate warning.
if In_Instance_Body then
- Error_Msg_F
- ("?non-local pointer cannot point to local object", P);
+ Error_Msg_F ("?non-local pointer cannot point to local object", P);
Error_Msg_F
("\?Program_Error will be raised at run time", P);
Rewrite (N,
return;
else
- Error_Msg_F
- ("non-local pointer cannot point to local object", P);
+ Error_Msg_F ("non-local pointer cannot point to local object", P);
-- Check for case where we have a missing access definition
end if;
if Circularity then
- Error_Msg_N -- CODEFIX???
- ("circular dependency caused by with_clauses", N);
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N ("circular dependency caused by with_clauses", N);
+ Error_Msg_N
("\possibly missing limited_with clause"
& " in one of the following", N);
Unit_Name)
then
Error_Msg_Sloc := Sloc (It);
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("simultaneous visibility of limited "
& "and unlimited views not allowed",
Item);
- Error_Msg_NE -- CODEFIX???
+ Error_Msg_NE
("\unlimited view visible through "
& "context clause #",
Item, It);
if No (Nam)
or else not Is_Protected_Type (Etype (Nam))
then
- Error_Msg_N -- CODEFIX???
- ("missing specification for Protected body", N);
+ Error_Msg_N ("missing specification for Protected body", N);
else
Set_Scope (Defining_Entity (N), Current_Scope);
Set_Has_Completion (Etype (Nam));
end if;
if No (Nam) or else not Is_Task_Type (Etype (Nam)) then
- Error_Msg_N -- CODEFIX???
- ("missing specification for task body", N);
+ Error_Msg_N ("missing specification for task body", N);
else
Set_Scope (Defining_Entity (N), Current_Scope);
Generate_Reference (Nam, Defining_Identifier (N), 'b');
begin
if U_Kind = Implementation_Unit then
- Error_Msg_F -- CODEFIX???
- ("& is an internal 'G'N'A'T unit?", Name (N));
+ Error_Msg_F ("& is an internal 'G'N'A'T unit?", Name (N));
-- Add alternative name if available, otherwise issue a
-- general warning message.
if Error_Msg_Strlen /= 0 then
- Error_Msg_F -- CODEFIX???
- ("\use ""~"" instead", Name (N));
+ Error_Msg_F ("\use ""~"" instead", Name (N));
else
Error_Msg_F
("\use of this unit is non-portable " &
end loop;
if E2 = WEnt then
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("unlimited view visible through use clause ", W);
return;
end if;
N_Generic_Package_Declaration)
and then Nkind (Lib_Unit) not in N_Generic_Renaming_Declaration
then
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("child of a generic package must be a generic unit", Lib_Unit);
elsif not Is_Package_Or_Generic_Package (P_Name) then
-- installed.
if Kind = N_Package_Declaration then
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("simultaneous visibility of the limited and " &
"unlimited views not allowed", N);
Error_Msg_Sloc := Sloc (Item);
- Error_Msg_NE -- CODEFIX???
+ Error_Msg_NE
("\\ unlimited view of & visible through the " &
"context clause #", N, P);
Error_Msg_Sloc := Sloc (Decl);
Others_Present := True;
if Present (Next (Actual)) then
- Error_Msg_N -- CODEFIX???
- ("others must be last association", Actual);
+ Error_Msg_N ("others must be last association", Actual);
end if;
-- This subprogram is used both for formal packages and for
if Null_Exclusion_Present (N) then
if not Is_Access_Type (T) then
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("null exclusion can only apply to an access type", N);
elsif Can_Never_Be_Null (T) then
- Error_Msg_NE -- CODEFIX???
+ Error_Msg_NE
("`NOT NULL` not allowed (& already excludes null)",
N, T);
end if;
and then Ekind (Gen_Unit) /= E_Generic_Procedure
then
if Ekind (Gen_Unit) = E_Generic_Function then
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("cannot instantiate generic function as procedure", Gen_Id);
else
Error_Msg_N
and then Ekind (Gen_Unit) /= E_Generic_Function
then
if Ekind (Gen_Unit) = E_Generic_Procedure then
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("cannot instantiate generic procedure as function", Gen_Id);
else
Error_Msg_N
then
Error_Msg_NE ("access parameter& is controlling,",
N, Formal);
- Error_Msg_NE -- CODEFIX???
+ Error_Msg_NE
("\corresponding parameter of & must be"
& " explicitly null-excluding", N, Gen_Id);
end if;
if Is_Child_Unit (E)
and then not Is_Visible_Child_Unit (E)
then
- Error_Msg_NE -- CODEFIX???
+ Error_Msg_NE
("generic child unit& is not visible", Gen_Id, E);
end if;
if Is_Atomic_Object (Actual)
and then not Is_Atomic (Orig_Ftyp)
then
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("cannot instantiate non-atomic formal object " &
"with atomic actual", Actual);
elsif Is_Volatile_Object (Actual)
and then not Is_Volatile (Orig_Ftyp)
then
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("cannot instantiate non-volatile formal object " &
"with volatile actual", Actual);
end if;
and then Has_Null_Exclusion (Analyzed_Formal)
then
Error_Msg_Sloc := Sloc (Analyzed_Formal);
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("actual must exclude null to match generic formal#", Actual);
end if;
if Is_Access_Constant (A_Gen_T) then
if not Is_Access_Constant (Act_T) then
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("actual type must be access-to-constant type", Actual);
Abandon_Instantiation (Actual);
end if;
else
if Is_Access_Constant (Act_T) then
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("actual type must be access-to-variable type", Actual);
Abandon_Instantiation (Actual);
-- Ada 2005: null-exclusion indicators of the two types must agree
if Can_Never_Be_Null (A_Gen_T) /= Can_Never_Be_Null (Act_T) then
- Error_Msg_NE -- CODEFIX???
+ Error_Msg_NE
("non null exclusion of actual and formal & do not match",
Actual, Gen_T);
end if;
if Has_Aliased_Components (A_Gen_T)
and then not Has_Aliased_Components (Act_T)
then
- Error_Msg_NE -- CODEFIX???
+ Error_Msg_NE
("actual must have aliased components to match formal type &",
Actual, Gen_T);
end if;
-- Perform atomic/volatile checks (RM C.6(12))
if Is_Atomic (Act_T) and then not Is_Atomic (Ancestor) then
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("cannot have atomic actual type for non-atomic formal type",
Actual);
and then not Is_Volatile (Ancestor)
and then Is_By_Reference_Type (Ancestor)
then
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("cannot have volatile actual type for non-volatile formal type",
Actual);
end if;
and then not Is_Limited_Type (A_Gen_T)
and then False
then
- Error_Msg_NE -- CODEFIX???
+ Error_Msg_NE
("actual for non-limited & cannot be a limited type", Actual,
Gen_T);
Explain_Limited_Type (Act_T, Actual);
if Is_Limited_Type (Act_T)
and then not Is_Limited_Type (A_Gen_T)
then
- Error_Msg_NE -- CODEFIX???
+ Error_Msg_NE
("actual for non-limited & cannot be a limited type", Actual,
Gen_T);
Explain_Limited_Type (Act_T, Actual);
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
Error_Msg_N
("storage size clause for task is an " &
"obsolescent feature (RM J.9)?", N);
- Error_Msg_N
- ("\use Storage_Size pragma instead?", N);
+ Error_Msg_N ("\use Storage_Size pragma instead?", N);
end if;
FOnly := True;
elsif Is_Type (T)
and then Is_Generic_Type (Root_Type (T))
then
- Error_Msg_N
- ("representation item not allowed for generic type", N);
+ Error_Msg_N ("representation item not allowed for generic type", N);
return True;
end if;
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
if Is_Interface (Root_Type (Current_Scope)) then
Error_Msg_N
("\limitedness is not inherited from limited interface", N);
- Error_Msg_N
- ("\add LIMITED to type indication", N);
+ Error_Msg_N ("\add LIMITED to type indication", N);
end if;
Explain_Limited_Type (T, N);
-- them all, and not just the first one).
Error_Msg_Node_2 := Subp;
- Error_Msg_N
- ("nonabstract type& has abstract subprogram&!", T);
+ Error_Msg_N ("nonabstract type& has abstract subprogram&!", T);
end if;
end if;
Error_Msg_NE
("missing full declaration for }", Parent (E), E);
else
- Error_Msg_NE
- ("missing body for &", Parent (E), E);
+ Error_Msg_NE ("missing body for &", Parent (E), E);
end if;
-- Package body has no completion for a declaration that appears
Error_Msg_Sloc := Sloc (E);
if Is_Type (E) then
- Error_Msg_NE
- ("missing full declaration for }!", Body_Id, E);
+ Error_Msg_NE ("missing full declaration for }!", Body_Id, E);
elsif Is_Overloadable (E)
and then Current_Entity_In_Scope (E) /= E
and then not In_Private_Part (Current_Scope)
then
Error_Msg_Sloc := Sloc (Prev);
- Error_Msg_N ("full constant for declaration#"
- & " must be in private part", N);
+ Error_Msg_N
+ ("full constant for declaration#"
+ & " must be in private part", N);
elsif Ekind (Current_Scope) = E_Package
and then
-- is such an array type... (RM 3.6.1)
if Is_Constrained (T) then
- Error_Msg_N
- ("array type is already constrained", Subtype_Mark (SI));
+ Error_Msg_N ("array type is already constrained", Subtype_Mark (SI));
Constraint_OK := False;
else
Error_Msg_N
("(Ada 2005) incomplete subtype may not be constrained", C);
else
- Error_Msg_N
- ("invalid constraint: type has no discriminant", C);
+ Error_Msg_N ("invalid constraint: type has no discriminant", C);
end if;
Fixup_Bad_Constraint;
(not Is_Interface (Parent_Type)
or else not Is_Limited_Interface (Parent_Type))
then
- Error_Msg_NE ("parent type& of limited type must be limited",
- N, Parent_Type);
+ Error_Msg_NE
+ ("parent type& of limited type must be limited",
+ N, Parent_Type);
end if;
end if;
end Derived_Type_Declaration;
elsif Nkind (Type_Definition (N)) = N_Derived_Type_Definition then
if No (Record_Extension_Part (Type_Definition (N))) then
- Error_Msg_NE (
- "full declaration of } must be a record extension",
- Prev, Id);
+ Error_Msg_NE
+ ("full declaration of } must be a record extension",
+ Prev, Id);
-- Set some attributes to produce a usable full view
Iface := Find_Hidden_Interface (Priv_T_Ifaces, Full_T_Ifaces);
if Present (Iface) then
- Error_Msg_NE ("interface & not implemented by full type " &
- "(RM-2005 7.3 (7.3/2))", Priv_T, Iface);
+ Error_Msg_NE
+ ("interface & not implemented by full type " &
+ "(RM-2005 7.3 (7.3/2))", Priv_T, Iface);
end if;
Iface := Find_Hidden_Interface (Full_T_Ifaces, Priv_T_Ifaces);
if Present (Iface) then
- Error_Msg_NE ("interface & not implemented by partial view " &
- "(RM-2005 7.3 (7.3/2))", Full_T, Iface);
+ Error_Msg_NE
+ ("interface & not implemented by partial view " &
+ "(RM-2005 7.3 (7.3/2))", Full_T, Iface);
end if;
end;
end if;
end if;
if Opnd = Left_Opnd (N) then
- Error_Msg_N -- CODEFIX???
- ("\left operand has the following interpretations", N);
+ Error_Msg_N ("\left operand has the following interpretations", N);
else
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("\right operand has the following interpretations", N);
Err := Opnd;
end if;
begin
if Nkind (N) in N_Membership_Test then
- Error_Msg_N -- CODEFIX???
- ("ambiguous operands for membership", N);
+ Error_Msg_N ("ambiguous operands for membership", N);
elsif Nkind_In (N, N_Op_Eq, N_Op_Ne) then
- Error_Msg_N -- CODEFIX???
- ("ambiguous operands for equality", N);
+ Error_Msg_N ("ambiguous operands for equality", N);
else
- Error_Msg_N -- CODEFIX???
- ("ambiguous operands for comparison", N);
+ Error_Msg_N ("ambiguous operands for comparison", N);
end if;
if All_Errors_Mode then
elsif Nkind (Expr) = N_Null then
Error_Msg_N ("argument of conversion cannot be null", N);
- Error_Msg_N -- CODEFIX???
- ("\use qualified expression instead", N);
+ Error_Msg_N ("\use qualified expression instead", N);
Set_Etype (N, Any_Type);
elsif Nkind (Expr) = N_Aggregate then
Error_Msg_N ("argument of conversion cannot be aggregate", N);
- Error_Msg_N -- CODEFIX???
- ("\use qualified expression instead", N);
+ Error_Msg_N ("\use qualified expression instead", N);
elsif Nkind (Expr) = N_Allocator then
Error_Msg_N ("argument of conversion cannot be an allocator", N);
- Error_Msg_N -- CODEFIX???
- ("\use qualified expression instead", N);
+ Error_Msg_N ("\use qualified expression instead", N);
elsif Nkind (Expr) = N_String_Literal then
Error_Msg_N ("argument of conversion cannot be string literal", N);
- Error_Msg_N -- CODEFIX???
- ("\use qualified expression instead", N);
+ Error_Msg_N ("\use qualified expression instead", N);
elsif Nkind (Expr) = N_Character_Literal then
if Ada_Version = Ada_83 then
else
Error_Msg_N ("argument of conversion cannot be character literal",
N);
- Error_Msg_N -- CODEFIX???
- ("\use qualified expression instead", N);
+ Error_Msg_N ("\use qualified expression instead", N);
end if;
elsif Nkind (Expr) = N_Attribute_Reference
Attribute_Name (Expr) = Name_Unrestricted_Access)
then
Error_Msg_N ("argument of conversion cannot be access", N);
- Error_Msg_N -- CODEFIX???
- ("\use qualified expression instead", N);
+ Error_Msg_N ("\use qualified expression instead", N);
end if;
end Analyze_Type_Conversion;
and then From_With_Type (Etype (Actual))
then
Error_Msg_Qual_Level := 1;
- Error_Msg_NE -- CODEFIX???
+ Error_Msg_NE
("missing with_clause for scope of imported type&",
Actual, Etype (Actual));
Error_Msg_Qual_Level := 0;
(R,
Etype (Next_Formal (First_Formal (Op_Id))))
then
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("No legal interpretation for operator&", N);
- Error_Msg_NE -- CODEFIX???
+ Error_Msg_NE
("\use clause on& would make operation legal",
N, Scope (Op_Id));
exit;
Prefix => Relocate_Node (Obj)));
if not Is_Aliased_View (Obj) then
- Error_Msg_NE -- CODEFIX???
+ Error_Msg_NE
("object in prefixed call to& must be aliased"
& " (RM-2005 4.3.1 (13))",
Prefix (First_Actual), Subprog);
if Access_Formal and then not Access_Actual then
if Nkind (Parent (Op)) = N_Full_Type_Declaration then
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("\possible interpretation"
& " (inherited, with implicit 'Access) #", N);
else
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("\possible interpretation (with implicit 'Access) #", N);
end if;
elsif not Access_Formal and then Access_Actual then
if Nkind (Parent (Op)) = N_Full_Type_Declaration then
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("\possible interpretation"
& " ( inherited, with implicit dereference) #", N);
else
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("\possible interpretation (with implicit dereference) #", N);
end if;
else
if Nkind (Parent (Op)) = N_Full_Type_Declaration then
- Error_Msg_N -- CODEFIX???
- ("\possible interpretation (inherited)#", N);
+ Error_Msg_N ("\possible interpretation (inherited)#", N);
else
Error_Msg_N -- CODEFIX
("\possible interpretation#", N);
if Present (Valid_Candidate (Success, Call_Node, Hom))
and then Nkind (Call_Node) /= N_Function_Call
then
- Error_Msg_NE -- CODEFIX???
- ("ambiguous call to&", N, Hom);
+ Error_Msg_NE ("ambiguous call to&", N, Hom);
Report_Ambiguity (Matching_Op);
Report_Ambiguity (Hom);
Error := True;
if Present (Valid_Candidate (Success, Call_Node, Prim_Op))
and then Nkind (Call_Node) /= N_Function_Call
then
- Error_Msg_NE -- CODEFIX???
- ("ambiguous call to&", N, Prim_Op);
+ Error_Msg_NE ("ambiguous call to&", N, Prim_Op);
Report_Ambiguity (Matching_Op);
Report_Ambiguity (Prim_Op);
return True;
and then not Is_Tag_Indeterminate (Rhs)
and then not Is_Dynamically_Tagged (Rhs)
then
- Error_Msg_N -- CODEFIX???
- ("dynamically tagged expression required!", Rhs);
+ Error_Msg_N ("dynamically tagged expression required!", Rhs);
end if;
-- Propagate the tag from a class-wide target to the rhs when the rhs
and then Is_Entity_Name (Name (Rhs))
and then Is_Abstract_Subprogram (Entity (Name (Rhs)))
then
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("call to abstract function must be dispatching", Name (Rhs));
elsif Nkind (Rhs) = N_Qualified_Expression
and then
Is_Abstract_Subprogram (Entity (Name (Expression (Rhs))))
then
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("call to abstract function must be dispatching",
Name (Expression (Rhs)));
end if;
else
-- Both of them are user-defined
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("ambiguous bounds in range of iteration",
R_Copy);
- Error_Msg_N -- CODEFIX???
- ("\possible interpretations:", R_Copy);
+ Error_Msg_N ("\possible interpretations:", R_Copy);
Error_Msg_NE ("\\} ", R_Copy, Found);
Error_Msg_NE ("\\} ", R_Copy, It.Typ);
exit;
if Compile_Time_Compare
(L, H, Assume_Valid => False) = GT
then
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("?loop range is null, "
& "loop will not execute",
DS);
Intval (Original_Node (H)) = Uint_1)
then
Error_Msg_N ("?loop range may be null", DS);
- Error_Msg_N -- CODEFIX???
- ("\?bounds may be wrong way round", DS);
+ Error_Msg_N ("\?bounds may be wrong way round", DS);
end if;
end;
end if;
-- Now issue the warning
- Error_Msg -- CODEFIX???
- ("?unreachable code!", Error_Loc);
+ Error_Msg ("?unreachable code!", Error_Loc);
end if;
-- If the unconditional transfer of control instruction is
-- extended_return_statement.
if Returns_Object then
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("extended_return_statement cannot return value; " &
"use `""RETURN;""`", N);
end if;
and then No (Actuals)
and then Comes_From_Source (N)
then
- Error_Msg_N -- CODEFIX???
- ("missing explicit dereference in call", N);
+ Error_Msg_N ("missing explicit dereference in call", N);
end if;
Analyze_Call_And_Resolve;
if Present (Actuals) then
Analyze_Call_And_Resolve;
else
- Error_Msg_N -- CODEFIX???
- ("missing explicit dereference in call ", N);
+ Error_Msg_N ("missing explicit dereference in call ", N);
end if;
-- If not an access to subprogram, then the prefix must resolve to the
null;
elsif not Is_Overriding_Operation (Spec_Id) then
- Error_Msg_NE -- CODEFIX???
+ Error_Msg_NE
("subprogram& is not overriding", Body_Spec, Spec_Id);
end if;
elsif Must_Not_Override (Body_Spec) then
if Is_Overriding_Operation (Spec_Id) then
- Error_Msg_NE -- CODEFIX???
+ Error_Msg_NE
("subprogram& overrides inherited operation",
Body_Spec, Spec_Id);
elsif Nkind (Spec_Id) = N_Defining_Operator_Symbol
and then Operator_Matches_Spec (Spec_Id, Spec_Id)
then
- Error_Msg_NE -- CODEFIX???
+ Error_Msg_NE
("subprogram & overrides predefined operator ",
Body_Spec, Spec_Id);
elsif not Is_Primitive (Spec_Id)
and then Ekind (Scope (Spec_Id)) /= E_Protected_Type
then
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("overriding indicator only allowed " &
"if subprogram is primitive",
Body_Spec);
Set_Is_Child_Unit (Body_Id, Is_Child_Unit (Spec_Id));
if Is_Abstract_Subprogram (Spec_Id) then
- Error_Msg_N -- CODEFIX???
- ("an abstract subprogram cannot have a body", N);
+ Error_Msg_N ("an abstract subprogram cannot have a body", N);
return;
else
end loop;
if Is_Protected_Type (Current_Scope) then
- Error_Msg_N -- CODEFIX???
- ("protected operation cannot be a null procedure", N);
+ Error_Msg_N ("protected operation cannot be a null procedure", N);
end if;
end if;
and then Null_Present (Specification (N)))
then
Error_Msg_Name_1 := Chars (Defining_Entity (N));
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("(Ada 2005) interface subprogram % must be abstract or null",
N);
end if;
and then
(Nkind (Parent (N))) /= N_Formal_Abstract_Subprogram_Declaration
then
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("function that returns abstract type must be abstract", N);
end if;
end if;
when Mode_Conformant =>
if Nkind (Parent (Old_Id)) = N_Full_Type_Declaration then
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("not mode conformant with operation inherited#!",
Enode);
else
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("not mode conformant with declaration#!", Enode);
end if;
when Subtype_Conformant =>
if Nkind (Parent (Old_Id)) = N_Full_Type_Declaration then
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("not subtype conformant with operation inherited#!",
Enode);
else
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("not subtype conformant with declaration#!", Enode);
end if;
if Is_Interface_Conformant (Typ, Iface_Prim, Op)
and then Convention (Iface_Prim) /= Convention (Op)
then
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("inconsistent conventions in primitive operations", Typ);
Error_Msg_Name_1 := Chars (Op);
if Comes_From_Source (Op) then
if not Is_Overriding_Operation (Op) then
- Error_Msg_N -- CODEFIX???
- ("\\primitive % defined #", Typ);
+ Error_Msg_N ("\\primitive % defined #", Typ);
else
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("\\overriding operation % with " &
"convention % defined #", Typ);
end if;
else pragma Assert (Present (Alias (Op)));
Error_Msg_Sloc := Sloc (Alias (Op));
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("\\inherited operation % with " &
"convention % defined #", Typ);
end if;
Error_Msg_Name_2 :=
Get_Convention_Name (Convention (Iface_Prim));
Error_Msg_Sloc := Sloc (Iface_Prim);
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("\\overridden operation % with " &
"convention % defined #", Typ);
then
Error_Msg_Node_2 := Alias (Overridden_Subp);
Error_Msg_Sloc := Sloc (Error_Msg_Node_2);
- Error_Msg_NE -- CODEFIX???
+ Error_Msg_NE
("& does not match corresponding formal of&#",
Form1, Form1);
exit;
Error_Msg_Sloc := Sloc (Overridden_Subp);
if Ekind (Subp) = E_Entry then
- Error_Msg_NE -- CODEFIX???
+ Error_Msg_NE
("entry & overrides inherited operation #", Spec, Subp);
else
- Error_Msg_NE -- CODEFIX???
+ Error_Msg_NE
("subprogram & overrides inherited operation #", Spec, Subp);
end if;
if not Is_Primitive
and then Ekind (Scope (Subp)) /= E_Protected_Type
then
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("overriding indicator only allowed "
& "if subprogram is primitive", Subp);
elsif Can_Override then
- Error_Msg_NE -- CODEFIX???
+ Error_Msg_NE
("subprogram & overrides predefined operator ",
Spec, Subp);
end if;
Set_Is_Overriding_Operation (Subp);
elsif not Can_Override then
- Error_Msg_NE -- CODEFIX???
- ("subprogram & is not overriding", Spec, Subp);
+ Error_Msg_NE ("subprogram & is not overriding", Spec, Subp);
end if;
elsif not Error_Posted (Subp)
elsif Must_Override (Spec) then
if Ekind (Subp) = E_Entry then
- Error_Msg_NE -- CODEFIX???
- ("entry & is not overriding", Spec, Subp);
+ Error_Msg_NE ("entry & is not overriding", Spec, Subp);
else
- Error_Msg_NE -- CODEFIX???
- ("subprogram & is not overriding", Spec, Subp);
+ Error_Msg_NE ("subprogram & is not overriding", Spec, Subp);
end if;
-- If the operation is marked "not overriding" and it's not primitive
and then Ekind (Subp) /= E_Entry
and then Ekind (Scope (Subp)) /= E_Protected_Type
then
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("overriding indicator only allowed if subprogram is primitive",
Subp);
return;
and then (not Is_Overriding
or else not Is_Abstract_Subprogram (E))
then
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("abstract subprograms must be visible "
& "(RM 3.9.3(10))!", S);
and then T = Base_Type (Etype (S))
and then not Is_Overriding
then
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("private function with tagged result must"
& " override visible-part function", S);
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("\move subprogram to the visible part"
& " (RM 3.9.3(10))", S);
end if;
and then Null_Exclusion_Present (Param_Spec)
then
if not Is_Access_Type (Formal_Type) then
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("`NOT NULL` allowed only for an access type", Param_Spec);
else
if Can_Never_Be_Null (Formal_Type)
and then Comes_From_Source (Related_Nod)
then
- Error_Msg_NE -- CODEFIX???
+ Error_Msg_NE
("`NOT NULL` not allowed (& already excludes null)",
Param_Spec,
Formal_Type);
if Present (Default) then
if Out_Present (Param_Spec) then
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("default initialization only allowed for IN parameters",
Param_Spec);
end if;
N := N + 1;
if Present (Default_Value (F)) then
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("default values not allowed for operator parameters",
Parent (F));
end if;
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
Error_Msg_N
("optional package body (not allowed in Ada 95)?", N);
else
- Error_Msg_N
- ("spec of this package does not allow a body", N);
+ Error_Msg_N ("spec of this package does not allow a body", N);
end if;
end if;
end if;
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
Error_Msg_NE
("\?function & will be called only once", Nam,
Entity (Name (Nam)));
- Error_Msg_N
+ Error_Msg_N -- CODEFIX
("\?suggest using an initialized constant object instead",
Nam);
end if;
("a generic package is not allowed in a use clause",
Pack_Name);
else
- Error_Msg_N -- CODEFIX???
- ("& is not a usable package", Pack_Name);
+ Error_Msg_N ("& is not a usable package", Pack_Name);
end if;
else
if Warn_On_Redundant_Constructs
and then Pack = Current_Scope
then
- Error_Msg_NE
+ Error_Msg_NE -- CODEFIX
("& is already use-visible within itself?", Pack_Name, Pack);
end if;
end loop;
if Is_Child_Unit (Entity (Original_Node (Par))) then
- Error_Msg_NE
- ("& is not directly visible", Par, Entity (Par));
+ Error_Msg_NE ("& is not directly visible", Par, Entity (Par));
else
return;
end if;
Nkind (Parent (Parent (N))) = N_Use_Package_Clause
then
Error_Msg_Qual_Level := 99;
- Error_Msg_NE ("\\missing `WITH &;`", N, Ent);
+ Error_Msg_NE -- CODEFIX
+ ("\\missing `WITH &;`", N, Ent);
Error_Msg_Qual_Level := 0;
end if;
if Chars (Lit) /= Chars (N)
and then Is_Bad_Spelling_Of (Chars (N), Chars (Lit)) then
Error_Msg_Node_2 := Lit;
- Error_Msg_N
+ Error_Msg_N -- CODEFIX
("& is undefined, assume misspelling of &", N);
Rewrite (N, New_Occurrence_Of (Lit, Sloc (N)));
return;
-- this is a very common error for beginners to make).
if Chars (N) = Name_Put or else Chars (N) = Name_Put_Line then
- Error_Msg_N
+ Error_Msg_N -- CODEFIX
("\\possible missing `WITH Ada.Text_'I'O; " &
"USE Ada.Text_'I'O`!", N);
and then Is_Known_Unit (Parent (N))
then
Error_Msg_Node_2 := Selector_Name (Parent (N));
- Error_Msg_N ("\\missing `WITH &.&;`", Prefix (Parent (N)));
+ Error_Msg_N -- CODEFIX
+ ("\\missing `WITH &.&;`", Prefix (Parent (N)));
end if;
-- Now check for possible misspellings
else
Error_Msg_Qual_Level := 99;
- Error_Msg_NE ("missing `WITH &;`", Selector, Candidate);
+ Error_Msg_NE -- CODEFIX
+ ("missing `WITH &;`", Selector, Candidate);
Error_Msg_Qual_Level := 0;
end if;
if Is_Known_Unit (N) then
if not Error_Posted (N) then
Error_Msg_Node_2 := Selector;
- Error_Msg_N ("missing `WITH &.&;`", Prefix (N));
+ Error_Msg_N -- CODEFIX
+ ("missing `WITH &.&;`", Prefix (N));
end if;
-- If this is a selection from a dummy package, then suppress
(Generic_Parent (Parent (Entity (Prefix (N)))))
then
Error_Msg_Node_2 := Selector;
- Error_Msg_N ("\missing `WITH &.&;`", Prefix (N));
+ Error_Msg_N -- CODEFIX
+ ("\missing `WITH &.&;`", Prefix (N));
end if;
end if;
end if;
function Report_Overload return Entity_Id is
begin
if Is_Actual then
- Error_Msg_NE
+ Error_Msg_NE -- CODEFIX
("ambiguous actual subprogram&, " &
"possible interpretations:", N, Nam);
else
- Error_Msg_N
+ Error_Msg_N -- CODEFIX
("ambiguous subprogram, " &
"possible interpretations:", N);
end if;
and then Base_Type (Typ) = Typ
and then Warn_On_Redundant_Constructs
then
- Error_Msg_NE
+ Error_Msg_NE -- CODEFIX
("?redundant attribute, & is its own base type", N, Typ);
end if;
if Present (Redundant) then
Error_Msg_Sloc := Sloc (Prev_Use);
- Error_Msg_NE
+ Error_Msg_NE -- CODEFIX
("& is already use-visible through previous use clause #?",
Redundant, Pack_Name);
end if;
if Unit1 = Unit2 then
Error_Msg_Sloc := Sloc (Current_Use_Clause (T));
- Error_Msg_NE
+ Error_Msg_NE -- CODEFIX
("& is already use-visible through previous "
& "use_type_clause #?", Clause1, T);
return;
elsif Nkind (Unit1) = N_Subunit then
Error_Msg_Sloc := Sloc (Current_Use_Clause (T));
- Error_Msg_NE
+ Error_Msg_NE -- CODEFIX
("& is already use-visible through previous "
& "use_type_clause #?", Clause1, T);
return;
and then Nkind (Unit1) /= N_Subunit
then
Error_Msg_Sloc := Sloc (Clause1);
- Error_Msg_NE
+ Error_Msg_NE -- CODEFIX
("& is already use-visible through previous "
& "use_type_clause #?", Current_Use_Clause (T), T);
return;
end;
end if;
- Error_Msg_NE
+ Error_Msg_NE -- CODEFIX
("& is already use-visible through previous "
& "use_type_clause #?", Err_No, Id);
-- level. In this case we don't have location information.
else
- Error_Msg_NE
+ Error_Msg_NE -- CODEFIX
("& is already use-visible through previous "
& "use type clause?", Id, T);
end if;
-- where we do not have the location information available.
else
- Error_Msg_NE
+ Error_Msg_NE -- CODEFIX
("& is already use-visible through previous "
& "use type clause?", Id, T);
end if;
elsif In_Use (Scope (T)) then
Error_Msg_Sloc := Sloc (Current_Use_Clause (Scope (T)));
- Error_Msg_NE
+ Error_Msg_NE -- CODEFIX
("& is already use-visible through package use clause #?",
Id, T);
else
Error_Msg_Node_2 := Scope (T);
- Error_Msg_NE
+ Error_Msg_NE -- CODEFIX
("& is already use-visible inside package &?", Id, T);
end if;
end if;
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
Iface := Find_Hidden_Interface (Priv_T_Ifaces, Full_T_Ifaces);
if Present (Iface) then
- Error_Msg_NE ("interface & not implemented by full type " &
- "(RM-2005 7.3 (7.3/2))", Priv_T, Iface);
+ Error_Msg_NE
+ ("interface & not implemented by full type " &
+ "(RM-2005 7.3 (7.3/2))", Priv_T, Iface);
end if;
Iface := Find_Hidden_Interface (Full_T_Ifaces, Priv_T_Ifaces);
if Present (Iface) then
- Error_Msg_NE ("interface & not implemented by partial " &
- "view (RM-2005 7.3 (7.3/2))", T, Iface);
+ Error_Msg_NE
+ ("interface & not implemented by partial " &
+ "view (RM-2005 7.3 (7.3/2))", T, Iface);
end if;
end if;
end if;
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
end if;
if Present (Func) and then Is_Abstract_Subprogram (Func) then
- Error_Msg_N (
- "call to abstract function must be dispatching", N);
+ Error_Msg_N
+ ("call to abstract function must be dispatching", N);
end if;
end if;
and then not In_Instance
then
Error_Msg_N ("?declaration of& is too late!", Subp);
- Error_Msg_NE
+ Error_Msg_NE -- CODEFIX??
("\spec should appear immediately after declaration of &!",
Subp, Typ);
exit;
-- --
-- B o d y --
-- --
--- Copyright (C) 1997-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1997-2010, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
and then not Elaboration_Checks_Suppressed (Task_Scope)
then
Error_Msg_Node_2 := Task_Scope;
- Error_Msg_NE ("activation of an instance of task type&" &
+ Error_Msg_NE
+ ("activation of an instance of task type&" &
" requires pragma Elaborate_All on &?", N, Ent);
end if;
= Entity (Drange)
then
if Warn_On_Redundant_Constructs then
- Error_Msg_N -- CODEFIX???
- ("redundant slice denotes whole array?", N);
+ Error_Msg_N ("redundant slice denotes whole array?", N);
end if;
-- The following might be a useful optimization????
-- --
-- B o d y --
-- --
--- Copyright (C) 1996-2008, Free Software Foundation, Inc. --
+-- Copyright (C) 1996-2010, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
return;
elsif Chars (Mech_Name) = Name_Copy then
- Error_Msg_N
- ("bad mechanism name, Value assumed", Mech_Name);
+ Error_Msg_N ("bad mechanism name, Value assumed", Mech_Name);
Set_Mechanism (Ent, By_Copy);
else
("parameters out of order for pragma%", Arg);
Error_Msg_Name_1 := Names (K);
Error_Msg_Name_2 := Names (Highest_So_Far);
- Error_Msg_N -- CODEFIX???
- ("\% must appear before %", Arg);
+ Error_Msg_N ("\% must appear before %", Arg);
raise Pragma_Exit;
else
else
if Warn_On_Export_Import and not OpenVMS_On_Target then
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("?unrecognized convention name, C assumed",
Expression (Arg1));
end if;
Prag_Id = Pragma_Import_Valued_Procedure
then
if not Is_Imported (Ent) then
- Error_Pragma -- CODEFIX???
+ Error_Pragma
("pragma Import or Interface must precede pragma%");
end if;
-- these types have been supported this way for some time.
if not Is_Limited_Type (Def_Id) then
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("imported 'C'P'P type should be " &
"explicitly declared limited?",
Get_Pragma_Arg (Arg2));
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("\type will be considered limited",
Get_Pragma_Arg (Arg2));
end if;
if Front_End_Inlining
and then Analyzed (Corresponding_Body (Decl))
then
- Error_Msg_N -- CODEFIX???
- ("pragma appears too late, ignored?", N);
+ Error_Msg_N ("pragma appears too late, ignored?", N);
return True;
-- If the subprogram is a renaming as body, the body is just a
and then not Suppress_All_Inlining
then
if Inlining_Not_Possible (Subp) then
- Error_Msg_NE -- CODEFIX???
+ Error_Msg_NE
("pragma Inline for& is ignored?", N, Entity (Subp_Id));
else
- Error_Msg_NE -- CODEFIX???
+ Error_Msg_NE
("pragma Inline for& is redundant?", N, Entity (Subp_Id));
end if;
end if;
or else
Get_Character (C) = '/'))
then
- Error_Msg -- CODEFIX???
+ Error_Msg
("?interface name contains illegal character",
Sloc (SN) + Source_Ptr (J));
end if;
procedure Set_Exported (E : Entity_Id; Arg : Node_Id) is
begin
if Is_Imported (E) then
- Error_Pragma_Arg -- CODEFIX???
+ Error_Pragma_Arg
("cannot export entity& that was previously imported", Arg);
elsif Present (Address_Clause (E)) then
- Error_Pragma_Arg -- CODEFIX???
+ Error_Pragma_Arg
("cannot export entity& that has an address clause", Arg);
end if;
-- Not allowed at all for subprograms
if Is_Subprogram (E) then
- Error_Pragma_Arg -- CODEFIX???
- ("local subprogram& cannot be exported", Arg);
+ Error_Pragma_Arg ("local subprogram& cannot be exported", Arg);
-- Otherwise set public and statically allocated
end if;
if Warn_On_Export_Import and then Is_Type (E) then
- Error_Msg_NE -- CODEFIX???
- ("exporting a type has no effect?", Arg, E);
+ Error_Msg_NE ("exporting a type has no effect?", Arg, E);
end if;
if Warn_On_Export_Import and Inside_A_Generic then
("\(pragma% applies to all previous entities)", N);
Error_Msg_Sloc := Sloc (E);
- Error_Msg_NE -- CODEFIX???
- ("\import not allowed for& declared#", N, E);
+ Error_Msg_NE ("\import not allowed for& declared#", N, E);
-- Here if not previously imported or exported, OK to import
begin
if Warn_On_Obsolescent_Feature then
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("'G'N'A'T pragma cpp'_class is now obsolete; replace it" &
" by pragma import?", N);
end if;
-- been supported this way for some time.
if not Is_Limited_Type (Typ) then
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("imported 'C'P'P type should be " &
"explicitly declared limited?",
Get_Pragma_Arg (Arg1));
GNAT_Pragma;
if Warn_On_Obsolescent_Feature then
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("'G'N'A'T pragma cpp'_virtual is now obsolete and has " &
"no effect?", N);
end if;
GNAT_Pragma;
if Warn_On_Obsolescent_Feature then
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("'G'N'A'T pragma cpp'_vtable is now obsolete and has " &
"no effect?", N);
end if;
if Elab_Warnings and not Dynamic_Elaboration_Checks then
Error_Msg_N
("?use of pragma Elaborate may not be safe", N);
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("?use pragma Elaborate_All instead if possible", N);
end if;
end Elaborate;
Check_Too_Long (Internal);
if Is_Imported (Def_Id) or else Is_Exported (Def_Id) then
- Error_Pragma_Arg -- CODEFIX???
+ Error_Pragma_Arg
("cannot use pragma% for imported/exported object",
Internal);
end if;
if Is_Concurrent_Type (Etype (Internal)) then
- Error_Pragma_Arg -- CODEFIX???
+ Error_Pragma_Arg
("cannot specify pragma % for task/protected object",
Internal);
end if;
end if;
if Ekind (Def_Id) = E_Constant then
- Error_Pragma_Arg -- CODEFIX???
+ Error_Pragma_Arg
("cannot specify pragma % for a constant", Internal);
end if;
if not Effective
and then Warn_On_Redundant_Constructs
then
- Error_Msg_NE -- CODEFIX???
+ Error_Msg_NE
("pragma Pure_Function on& is redundant?",
N, Entity (E_Id));
end if;
Set_Ravenscar_Profile (N);
if Warn_On_Obsolescent_Feature then
- Error_Msg_N -- CODEFIX???
- ("pragma Ravenscar is an obsolescent feature?", N);
- Error_Msg_N -- CODEFIX???
- ("|use pragma Profile (Ravenscar) instead", N);
+ Error_Msg_N ("pragma Ravenscar is an obsolescent feature?", N);
+ Error_Msg_N ("|use pragma Profile (Ravenscar) instead", N);
end if;
-------------------------
(Restricted, N, Warn => Treat_Restrictions_As_Warnings);
if Warn_On_Obsolescent_Feature then
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("pragma Restricted_Run_Time is an obsolescent feature?", N);
- Error_Msg_N -- CODEFIX???
- ("|use pragma Profile (Restricted) instead", N);
+ Error_Msg_N ("|use pragma Profile (Restricted) instead", N);
end if;
------------------
return;
elsif Is_Limited_Type (Typ) then
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("Unchecked_Union must not be limited record type", Typ);
Explain_Limited_Type (Typ, Typ);
return;
else
if not Has_Discriminants (Typ) then
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("Unchecked_Union must have one discriminant", Typ);
return;
end if;
begin
if Nkind (C) = N_Character_Literal then
- Error_Msg_N -- CODEFIX???
- ("ambiguous character literal", C);
+ Error_Msg_N ("ambiguous character literal", C);
-- First the ones in Standard
- Error_Msg_N -- CODEFIX???
- ("\\possible interpretation: Character!", C);
- Error_Msg_N -- CODEFIX???
- ("\\possible interpretation: Wide_Character!", C);
+ Error_Msg_N ("\\possible interpretation: Character!", C);
+ Error_Msg_N ("\\possible interpretation: Wide_Character!", C);
-- Include Wide_Wide_Character in Ada 2005 mode
if Ada_Version >= Ada_05 then
- Error_Msg_N -- CODEFIX???
- ("\\possible interpretation: Wide_Wide_Character!", C);
+ Error_Msg_N ("\\possible interpretation: Wide_Wide_Character!", C);
end if;
-- Now any other types that match
E := Current_Entity (C);
while Present (E) loop
- Error_Msg_NE -- CODEFIX???
- ("\\possible interpretation:}!", C, Etype (E));
+ Error_Msg_NE ("\\possible interpretation:}!", C, Etype (E));
E := Homonym (E);
end loop;
end if;
and then Is_Entity_Name (Name (Arg))
and then Is_Overloaded (Name (Arg))
then
- Error_Msg_NE -- CODEFIX???
- ("ambiguous call to&", Arg, Name (Arg));
+ Error_Msg_NE ("ambiguous call to&", Arg, Name (Arg));
-- Could use comments on what is going on here ???
Error_Msg_Sloc := Sloc (It.Nam);
if Nkind (Parent (It.Nam)) = N_Full_Type_Declaration then
- Error_Msg_N -- CODEFIX???
- ("interpretation (inherited) #!", Arg);
+ Error_Msg_N ("interpretation (inherited) #!", Arg);
else
- Error_Msg_N -- CODEFIX???
- ("interpretation #!", Arg);
+ Error_Msg_N ("interpretation #!", Arg);
end if;
Get_Next_Interp (I, It);
if Nkind (N) = N_Function_Call
and then Nkind (Name (N)) = N_Explicit_Dereference
then
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("ambiguous expression "
& "(cannot resolve indirect call)!", N);
else
Ambiguous := True;
if Nkind (Parent (Seen)) = N_Full_Type_Declaration then
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("\\possible interpretation (inherited)#!", N);
else
Error_Msg_N -- CODEFIX
if It.Typ = Universal_Fixed
and then Scope (It.Nam) = Standard_Standard
then
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("\\possible interpretation as " &
"universal_fixed operation " &
"(RM 4.5.5 (19))", N);
else
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("\\possible interpretation (predefined)#!", N);
end if;
elsif
Nkind (Parent (It.Nam)) = N_Full_Type_Declaration
then
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("\\possible interpretation (inherited)#!", N);
else
Error_Msg_N -- CODEFIX
-- Introduce an implicit 'Access in prefix
if not Is_Aliased_View (Act) then
- Error_Msg_NE -- CODEFIX???
+ Error_Msg_NE
("object in prefixed call to& must be aliased"
& " (RM-2005 4.3.1 (13))",
Prefix (Act), Nam);
declare
Loc : constant Source_Ptr := Sloc (N);
begin
- Error_Msg_N -- CODEFIX???
- ("?allocation from empty storage pool!", N);
+ Error_Msg_N ("?allocation from empty storage pool!", N);
Error_Msg_N ("\?Storage_Error will be raised at run time!", N);
Insert_Action (N,
Make_Raise_Storage_Error (Loc,
elsif Typ = Universal_Integer or else Typ = Any_Modular then
if Parent_Is_Boolean then
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("operand of not must be enclosed in parentheses",
Right_Opnd (N));
else
and then not Is_Boolean_Type (Typ)
and then Parent_Is_Boolean
then
- Error_Msg_N -- CODEFIX???
- ("?not expression should be parenthesized here!", N);
+ Error_Msg_N ("?not expression should be parenthesized here!", N);
end if;
-- Warn on double negation if checking redundant constructs
and then Root_Type (Typ) = Standard_Boolean
and then Nkind (Right_Opnd (N)) = N_Op_Not
then
- Error_Msg_N -- CODEFIX???
- ("redundant double negation?", N);
+ Error_Msg_N ("redundant double negation?", N);
end if;
-- Complete resolution and evaluation of NOT
-- If we fall through warning should be issued
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("?unary minus expression should be parenthesized here!", N);
end if;
end if;
procedure Fixed_Point_Error is
begin
- Error_Msg_N -- CODEFIX???
- ("ambiguous universal_fixed_expression", N);
- Error_Msg_NE -- CODEFIX???
- ("\\possible interpretation as}", N, T1);
- Error_Msg_NE -- CODEFIX???
- ("\\possible interpretation as}", N, T2);
+ Error_Msg_N ("ambiguous universal_fixed_expression", N);
+ Error_Msg_NE ("\\possible interpretation as}", N, T1);
+ Error_Msg_NE ("\\possible interpretation as}", N, T2);
end Fixed_Point_Error;
-- Start of processing for Unique_Fixed_Point_Type
or else Modification_Comes_From_Source
then
if Has_Pragma_Unmodified (Ent) then
- Error_Msg_NE -- CODEFIX???
- ("?pragma Unmodified given for &!", N, Ent);
+ Error_Msg_NE ("?pragma Unmodified given for &!", N, Ent);
end if;
Set_Never_Set_In_Source (Ent, False);
and then Is_Entity_Name (Prefix (Exp))
then
Error_Msg_Sloc := Sloc (A);
- Error_Msg_NE -- CODEFIX???
+ Error_Msg_NE
("constant& may be modified via address clause#?",
N, Entity (Prefix (Exp)));
end if;
Error_Msg_N
("address arithmetic not predefined in package System",
Parent (Expr));
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("\possible missing with/use of System.Storage_Elements",
Parent (Expr));
return;
Ekind (Entity (Expr)) = E_Generic_Procedure)
then
if Ekind (Expec_Type) = E_Access_Subprogram_Type then
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("found procedure name, possibly missing Access attribute!",
Expr);
else
and then Etype (Designated_Type (Expec_Type)) = Etype (Expr)
and then No (Parameter_Associations (Expr))
then
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("found function name, possibly missing Access attribute!",
Expr);
and then not In_Use (Expec_Type)
and then Has_Compatible_Type (Right_Opnd (Expr), Expec_Type)
then
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("operator of the type is not directly visible!", Expr);
elsif Ekind (Found_Type) = E_Void
Setup_Asm_Inputs (N);
if No (Asm_Input_Value) then
- Error_Msg_F -- CODEFIX???
+ Error_Msg_F
("?code statement with no inputs should usually be Volatile!", N);
return;
end if;
Setup_Asm_Outputs (N);
if No (Asm_Output_Variable) then
- Error_Msg_F -- CODEFIX???
+ Error_Msg_F
("?code statement with no outputs should usually be Volatile!", N);
return;
end if;
and then Present (Prev (N))
and then Nkind (Prev (N)) = N_Code_Statement
then
- Error_Msg_F -- CODEFIX???
+ Error_Msg_F
("?code statements in sequence should usually be Volatile!", N);
Error_Msg_F
("\?(suggest using template with multiple instructions)!", N);
if (Is_Volatile (E1) or else Has_Volatile_Components (E1))
and then not Is_Imported (E1)
then
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("?& is not modified, volatile has no effect!", E1);
-- Another special case, Exception_Occurrence, this catches
and then Present (Hiding_Loop_Variable (E1))
and then not Warnings_Off_E1
then
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("?for loop implicitly declares loop variable!",
Hiding_Loop_Variable (E1));
if Warn_On_Constant then
Error_Msg_N
("?formal parameter & is not modified!", E1);
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("\?mode could be IN instead of `IN OUT`!", E1);
-- We do not generate warnings for IN OUT parameters
-- default mode.
elsif Check_Unreferenced then
- Error_Msg_N -- CODEFIX???
+ Error_Msg_N
("?formal parameter& is read but "
& "never assigned!", E1);
end if;
-- Used only in context where Unmodified would have worked
elsif Warnings_Off_Used_Unmodified (E) then
- Error_Msg_NE -- CODEFIX???
+ Error_Msg_NE
("?could use Unmodified instead of "
& "Warnings Off for &", Pragma_Identifier (N), E);
-- Used only in context where Unreferenced would have worked
elsif Warnings_Off_Used_Unreferenced (E) then
- Error_Msg_NE -- CODEFIX???
+ Error_Msg_NE
("?could use Unreferenced instead of "
& "Warnings Off for &", Pragma_Identifier (N), E);
-- Not used at all
else
- Error_Msg_NE -- CODEFIX???
+ Error_Msg_NE
("?pragma Warnings Off for & unused, "
& "could be omitted", N, E);
end if;
if Is_Entity_Name (Original_Node (C))
and then Nkind (Cond) /= N_Op_Not
then
- Error_Msg_NE -- CODEFIX???
+ Error_Msg_NE
("object & is always True?", Cond, Original_Node (C));
Track (Original_Node (C), Cond);
else
- Error_Msg_N -- CODEFIX???
- ("condition is always True?", Cond);
+ Error_Msg_N ("condition is always True?", Cond);
Track (Cond, Cond);
end if;
else
- Error_Msg_N -- CODEFIX???
- ("condition is always False?", Cond);
+ Error_Msg_N ("condition is always False?", Cond);
Track (Cond, Cond);
end if;
end;
elsif Length_Reference (X) then
Warn1;
Error_Msg_Node_2 := Ent;
- Error_Msg_FE -- CODEFIX???
+ Error_Msg_FE
("\suggest replacement of `&''Length` by `&''Last`",
X, Ent);
then
Warn1;
Error_Msg_Node_2 := Ent;
- Error_Msg_FE -- CODEFIX???
+ Error_Msg_FE
("\suggest replacement of `&''Length` by `&''Last`",
Left_Opnd (X), Ent);
end if;
null;
when E_Discriminant =>
- Error_Msg_N -- CODEFIX???
- ("?discriminant & is not referenced!", E);
+ Error_Msg_N ("?discriminant & is not referenced!", E);
when E_Named_Integer |
E_Named_Real =>
-- --
-- B o d y --
-- --
--- Copyright (C) 2000-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 2000-2010, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
loop
if At_EOF or else S (P) = LF or else S (P) = CR then
- Error -- CODEFIX
+ Error -- CODEFIX
("missing string quote");
elsif S (P) = HT then
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2008, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
begin
if Style_Check_Array_Attribute_Index then
if D = 1 and then Present (E1) then
- Error_Msg_N
+ Error_Msg_N -- CODEFIX
("(style) index number not allowed for one dimensional array",
E1);
elsif D > 1 and then No (E1) then
- Error_Msg_N
+ Error_Msg_N -- CODEFIX
("(style) index number required for multi-dimensional array",
N);
end if;
then
Error_Msg_Node_1 := Def;
Error_Msg_Sloc := Sloc (Def);
- Error_Msg
+ Error_Msg -- CODEFIX
("(style) bad casing of & declared#", Sref);
return;
String (Tref (Sref .. Sref + Source_Ptr (Nlen) - 1));
Set_Casing (Cas);
Error_Msg_Name_1 := Name_Enter;
- Error_Msg_N
+ Error_Msg_N -- CODEFIX
("(style) bad casing of %% declared in Standard", Ref);
end if;
end if;
if Style_Check_Missing_Overriding and then Comes_From_Source (N) then
if Nkind (N) = N_Subprogram_Body then
- Error_Msg_N
+ Error_Msg_N -- CODEFIX
("(style) missing OVERRIDING indicator in body of%", N);
else
- Error_Msg_N
+ Error_Msg_N -- CODEFIX
("(style) missing OVERRIDING indicator in declaration of%", N);
end if;
end if;
procedure Subprogram_Not_In_Alpha_Order (Name : Node_Id) is
begin
if Style_Check_Order_Subprograms then
- Error_Msg_N
+ Error_Msg_N -- CODEFIX
("(style) subprogram body& not in alphabetical order", Name);
end if;
end Subprogram_Not_In_Alpha_Order;
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- Otherwise we have an error
elsif Nkind (Orig) = N_Op_And then
- Error_Msg ("(style) `AND THEN` required", Sloc (Orig));
+ Error_Msg -- CODEFIX
+ ("(style) `AND THEN` required", Sloc (Orig));
else
- Error_Msg ("(style) `OR ELSE` required", Sloc (Orig));
+ Error_Msg -- CODEFIX
+ ("(style) `OR ELSE` required", Sloc (Orig));
end if;
end;
end if;
if Scan_Ptr > Source_First (Current_Source_File)
and then Source (Scan_Ptr - 1) > ' '
then
- Error_Msg_S ("(style) space required");
+ Error_Msg_S -- CODEFIX
+ ("(style) space required");
end if;
end if;
if Source (Scan_Ptr + 2) > ' '
and then not Is_Special_Character (Source (Scan_Ptr + 2))
then
- Error_Msg ("(style) space required", Scan_Ptr + 2);
+ Error_Msg -- CODEFIX
+ ("(style) space required", Scan_Ptr + 2);
end if;
end if;
if Is_Box_Comment then
Error_Space_Required (Scan_Ptr + 2);
else
- Error_Msg ("(style) two spaces required", Scan_Ptr + 2);
+ Error_Msg -- CODEFIX
+ ("(style) two spaces required", Scan_Ptr + 2);
end if;
return;
-- We expect one blank line, from the EOF, but no more than one
if Blank_Lines = 2 then
- Error_Msg
+ Error_Msg -- CODEFIX
("(style) blank line not allowed at end of file",
Blank_Line_Location);
elsif Blank_Lines >= 3 then
- Error_Msg
+ Error_Msg -- CODEFIX
("(style) blank lines not allowed at end of file",
Blank_Line_Location);
end if;
procedure Check_HT is
begin
if Style_Check_Horizontal_Tabs then
- Error_Msg_S ("(style) horizontal tab not allowed");
+ Error_Msg_S -- CODEFIX
+ ("(style) horizontal tab not allowed");
end if;
end Check_HT;
if Token_Ptr = First_Non_Blank_Location
and then Start_Column rem Style_Check_Indentation /= 0
then
- Error_Msg_SC ("(style) bad indentation");
+ Error_Msg_SC -- CODEFIX
+ ("(style) bad indentation");
end if;
end if;
end Check_Indentation;
if Style_Check_Form_Feeds then
if Source (Scan_Ptr) = ASCII.FF then
- Error_Msg_S ("(style) form feed not allowed");
+ Error_Msg_S -- CODEFIX
+ ("(style) form feed not allowed");
elsif Source (Scan_Ptr) = ASCII.VT then
- Error_Msg_S ("(style) vertical tab not allowed");
+ Error_Msg_S -- CODEFIX
+ ("(style) vertical tab not allowed");
end if;
end if;
-- Issue message for blanks at end of line if option enabled
if Style_Check_Blanks_At_End and then L < Len then
- Error_Msg
+ Error_Msg -- CODEFIX
("(style) trailing spaces not permitted", S);
end if;
else
if Token = Tok_Then then
- Error_Msg
+ Error_Msg -- CODEFIX
("(style) no statements may follow THEN on same line", S);
else
Error_Msg
procedure Check_Xtra_Parens (Loc : Source_Ptr) is
begin
if Style_Check_Xtra_Parens then
- Error_Msg ("redundant parentheses?", Loc);
+ Error_Msg -- CODEFIX
+ ("redundant parentheses?", Loc);
end if;
end Check_Xtra_Parens;
procedure Error_Space_Not_Allowed (S : Source_Ptr) is
begin
- Error_Msg ("(style) space not allowed", S);
+ Error_Msg -- CODEFIX
+ ("(style) space not allowed", S);
end Error_Space_Not_Allowed;
--------------------------
procedure Error_Space_Required (S : Source_Ptr) is
begin
- Error_Msg ("(style) space required", S);
+ Error_Msg -- CODEFIX
+ ("(style) space required", S);
end Error_Space_Required;
--------------------
begin
if Style_Check_End_Labels then
Error_Msg_Node_1 := Name;
- Error_Msg_SP ("(style) `END &` required");
+ Error_Msg_SP -- CODEFIX
+ ("(style) `END &` required");
end if;
end No_End_Name;
begin
if Style_Check_End_Labels then
Error_Msg_Node_1 := Name;
- Error_Msg_SP ("(style) `EXIT &` required");
+ Error_Msg_SP -- CODEFIX
+ ("(style) `EXIT &` required");
end if;
end No_Exit_Name;
procedure Non_Lower_Case_Keyword is
begin
if Style_Check_Keyword_Casing then
- Error_Msg_SC -- CODEIX
+ Error_Msg_SC -- CODEFIX
("(style) reserved words must be all lower case");
end if;
end Non_Lower_Case_Keyword;
projects / gcc.git / commitdiff