par-ch9.adb, [...]: Update comments.

* 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.

From-SVN: r160979
This commit is contained in:
Arnaud Charlet 2010-06-18 12:14:52 +00:00 committed by Arnaud Charlet
parent 9628d8f667
commit ed2233dc6d
47 changed files with 614 additions and 627 deletions

View File

@ -1,3 +1,16 @@
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

View File

@ -2851,7 +2851,7 @@ package body Checks is
-- 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
@ -2860,7 +2860,7 @@ package body Checks is
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;

View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -601,13 +601,6 @@ package Errout is
-- 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 --
------------------------------

View File

@ -4433,10 +4433,8 @@ package body Exp_Ch4 is
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,
@ -4451,10 +4449,8 @@ package body Exp_Ch4 is
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,
@ -4470,10 +4466,8 @@ package body Exp_Ch4 is
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,
@ -4490,10 +4484,8 @@ package body Exp_Ch4 is
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,
@ -4517,25 +4509,25 @@ package body Exp_Ch4 is
-- 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;
@ -9867,7 +9859,7 @@ package body Exp_Ch4 is
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;
@ -9892,7 +9884,7 @@ package body Exp_Ch4 is
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;
@ -9930,11 +9922,11 @@ package body Exp_Ch4 is
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;

View File

@ -3520,7 +3520,7 @@ package body Exp_Disp is
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"
@ -7317,11 +7317,11 @@ package body Exp_Disp is
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
@ -7350,7 +7350,7 @@ package body Exp_Disp is
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);
@ -7364,11 +7364,11 @@ package body Exp_Disp is
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;

View File

@ -3491,7 +3491,7 @@ package body Exp_Util is
-- 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;

View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -2004,8 +2004,7 @@ package body Freeze is
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);
@ -2063,7 +2062,7 @@ package body Freeze is
-- 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;
@ -2232,9 +2231,9 @@ package body Freeze is
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;
@ -2463,8 +2462,7 @@ package body Freeze is
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);
@ -2731,7 +2729,8 @@ package body Freeze is
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;
@ -3011,7 +3010,7 @@ package body Freeze is
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;

View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -2736,8 +2736,7 @@ package body Layout is
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;

View File

@ -699,7 +699,7 @@ package body Lib.Xref is
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;
@ -711,7 +711,8 @@ package body Lib.Xref is
-- 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;

View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -344,7 +344,8 @@ package body Ch10 is
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
@ -395,7 +396,8 @@ package body Ch10 is
-- 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);
@ -836,7 +838,8 @@ package body Ch10 is
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
@ -876,8 +879,7 @@ package body Ch10 is
-- 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

View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -119,7 +119,8 @@ package body Ch11 is
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);

View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -346,7 +346,7 @@ package body Ch12 is
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;
@ -912,7 +912,8 @@ package body Ch12 is
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

View File

@ -124,8 +124,7 @@ package body Ch3 is
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;
@ -440,8 +439,7 @@ package body Ch3 is
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;
@ -456,8 +454,7 @@ package body Ch3 is
-- 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;
@ -679,8 +676,7 @@ package body Ch3 is
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;
@ -815,7 +811,7 @@ package body Ch3 is
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
@ -830,8 +826,7 @@ package body Ch3 is
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 :=
@ -922,8 +917,7 @@ package body Ch3 is
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);
@ -1040,13 +1034,11 @@ package body Ch3 is
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;
@ -1098,8 +1090,7 @@ package body Ch3 is
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));
@ -1367,7 +1358,7 @@ package body Ch3 is
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;
@ -1444,8 +1435,7 @@ package body Ch3 is
Scan; -- past :=
if Token = Tok_Constant then
Error_Msg_SP -- CODEFIX???
("colon expected");
Error_Msg_SP ("colon expected");
else
Restore_Scan_State (Scan_State);
@ -1565,7 +1555,7 @@ package body Ch3 is
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;
@ -1616,7 +1606,7 @@ package body Ch3 is
end if;
if Token = Tok_Renames then
Error_Msg -- CODEFIX???
Error_Msg
("CONSTANT not permitted in renaming declaration",
Con_Loc);
Scan; -- Past renames
@ -1732,7 +1722,7 @@ package body Ch3 is
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;
@ -1762,7 +1752,7 @@ package body Ch3 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)));
@ -1825,7 +1815,7 @@ package body Ch3 is
-- 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;
@ -1978,8 +1968,7 @@ package body Ch3 is
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;
@ -1995,8 +1984,7 @@ package body Ch3 is
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;
@ -2195,8 +2183,7 @@ package body Ch3 is
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;
@ -2671,8 +2658,7 @@ package body Ch3 is
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);
@ -3319,8 +3305,7 @@ package body Ch3 is
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
@ -3413,8 +3398,7 @@ package body Ch3 is
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;
@ -3442,8 +3426,7 @@ package body Ch3 is
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);
@ -3457,8 +3440,7 @@ package body Ch3 is
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;
@ -3537,7 +3519,7 @@ package body Ch3 is
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);
@ -3770,7 +3752,7 @@ package body Ch3 is
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;
@ -3794,8 +3776,7 @@ package body Ch3 is
else
if Token /= Tok_And then
Error_Msg_AP -- CODEFIX???
("AND expected");
Error_Msg_AP ("AND expected");
else
Scan; -- past AND
end if;
@ -3881,8 +3862,7 @@ package body Ch3 is
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
@ -4063,7 +4043,7 @@ package body Ch3 is
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;
@ -4274,8 +4254,7 @@ package body Ch3 is
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
@ -4440,8 +4419,7 @@ package body Ch3 is
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;
@ -4550,17 +4528,15 @@ package body Ch3 is
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;
@ -4649,8 +4625,7 @@ package body Ch3 is
-- 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
@ -4658,8 +4633,7 @@ package body Ch3 is
-- 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

View File

@ -367,8 +367,7 @@ package body Ch4 is
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
@ -567,8 +566,7 @@ package body Ch4 is
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;
@ -740,8 +738,7 @@ package body Ch4 is
-- 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
@ -1092,7 +1089,7 @@ package body Ch4 is
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
@ -1264,7 +1261,7 @@ package body Ch4 is
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;
@ -2131,8 +2128,7 @@ package body Ch4 is
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;
@ -2357,7 +2353,7 @@ package body Ch4 is
-- 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;
@ -2383,8 +2379,7 @@ package body Ch4 is
-- 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
@ -2717,8 +2712,7 @@ package body Ch4 is
-- 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
@ -2817,7 +2811,7 @@ package body Ch4 is
-- 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

View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -193,7 +193,8 @@ package body Ch5 is
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;
@ -607,7 +608,8 @@ package body Ch5 is
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;
@ -857,7 +859,8 @@ package body Ch5 is
Junk_Declaration;
else
Error_Msg_BC ("statement expected");
Error_Msg_BC -- CODEFIX
("statement expected");
raise Error_Resync;
end if;
end case;
@ -1172,7 +1175,8 @@ package body Ch5 is
-- 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;
@ -1208,7 +1212,8 @@ package body Ch5 is
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
@ -1258,7 +1263,8 @@ package body Ch5 is
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;
@ -2196,7 +2202,8 @@ package body Ch5 is
-- 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;
@ -2225,7 +2232,8 @@ package body Ch5 is
TF_Then;
while Token = Tok_Then loop
Error_Msg_SC ("redundant THEN");
Error_Msg_SC -- CODEFIX
("redundant THEN");
TF_Then;
end loop;

View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -64,7 +64,8 @@ package body Ch6 is
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);
@ -195,7 +196,8 @@ package body Ch6 is
Not_Overriding := True;
else
Error_Msg_SC ("OVERRIDING expected!");
Error_Msg_SC -- CODEFIX
("OVERRIDING expected!");
end if;
-- Ada 2005: scan leading OVERRIDING indicator
@ -348,7 +350,8 @@ package body Ch6 is
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;
@ -421,7 +424,8 @@ package body Ch6 is
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;
@ -440,7 +444,8 @@ package body Ch6 is
-- 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;
@ -452,7 +457,8 @@ package body Ch6 is
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
@ -492,7 +498,8 @@ package body Ch6 is
-- 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;
@ -556,7 +563,8 @@ package body Ch6 is
-- 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;
@ -1219,7 +1227,8 @@ package body Ch6 is
-- 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;
@ -1227,7 +1236,8 @@ package body Ch6 is
-- 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;
@ -1290,7 +1300,8 @@ package body Ch6 is
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
@ -1305,8 +1316,7 @@ package body Ch6 is
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;

View File

@ -205,7 +205,7 @@ package body Ch7 is
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;
@ -217,7 +217,7 @@ package body Ch7 is
-- 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,
@ -234,8 +234,7 @@ package body Ch7 is
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;

View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -154,7 +154,8 @@ package body Ch9 is
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
@ -181,13 +182,14 @@ package body Ch9 is
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;
@ -454,7 +456,8 @@ package body Ch9 is
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,
@ -466,7 +469,8 @@ package body Ch9 is
return Protected_Node;
end if;
Error_Msg_SP ("|extra ""("" ignored");
Error_Msg_SP -- CODEFIX
("|extra ""("" ignored");
end if;
T_Is;
@ -492,7 +496,8 @@ package body Ch9 is
end loop;
if Token /= Tok_With then
Error_Msg_SC ("WITH expected");
Error_Msg_SC -- CODEFIX
("WITH expected");
end if;
Scan; -- past WITH
@ -625,7 +630,8 @@ package body Ch9 is
Scan; -- past OVERRIDING
Not_Overriding := True;
else
Error_Msg_SC ("OVERRIDING expected!");
Error_Msg_SC -- CODEFIX
("OVERRIDING expected!");
end if;
else
@ -758,8 +764,7 @@ package body Ch9 is
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
@ -809,7 +814,8 @@ package body Ch9 is
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
@ -823,7 +829,8 @@ package body Ch9 is
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;
@ -1115,7 +1122,8 @@ package body Ch9 is
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;

View File

@ -150,8 +150,7 @@ function Prag (Pragma_Node : Node_Id; Semi : Source_Ptr) return Node_Id is
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;
@ -539,7 +538,7 @@ begin
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;
@ -606,7 +605,7 @@ begin
end if;
end if;
Error_Msg_N -- CODEFIX???
Error_Msg_N
("Casing argument for pragma% must be " &
"one of Mixedcase, Lowercase, Uppercase",
Arg);

View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -83,15 +83,18 @@ package body Tchk is
-- 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;
@ -122,7 +125,8 @@ package body Tchk is
if Token = Tok_Box then
Scan;
else
Error_Msg_AP ("missing ""'<'>""");
Error_Msg_AP -- CODEFIX
("missing ""'<'>""");
end if;
end T_Box;
@ -135,7 +139,8 @@ package body Tchk is
if Token = Tok_Colon then
Scan;
else
Error_Msg_AP ("missing "":""");
Error_Msg_AP -- CODEFIX
("missing "":""");
end if;
end T_Colon;
@ -149,19 +154,23 @@ package body Tchk is
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;
@ -182,7 +191,8 @@ package body Tchk is
if Token = Tok_Comma then
Scan;
else
Error_Msg_AP ("missing "",""");
Error_Msg_AP -- CODEFIX
("missing "",""");
end if;
end if;
@ -200,7 +210,8 @@ package body Tchk is
if Token = Tok_Dot_Dot then
Scan;
else
Error_Msg_AP ("missing ""..""");
Error_Msg_AP -- CODEFIX
("missing ""..""");
end if;
end T_Dot_Dot;
@ -222,7 +233,8 @@ package body Tchk is
if Token = Tok_Greater_Greater then
Scan;
else
Error_Msg_AP ("missing ""'>'>""");
Error_Msg_AP -- CODEFIX
("missing ""'>'>""");
end if;
end T_Greater_Greater;
@ -271,15 +283,18 @@ package body Tchk is
-- 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
@ -289,7 +304,8 @@ package body Tchk is
-- 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;
@ -303,7 +319,8 @@ package body Tchk is
if Token = Tok_Left_Paren then
Scan;
else
Error_Msg_AP ("missing ""(""");
Error_Msg_AP -- CODEFIX
("missing ""(""");
end if;
end T_Left_Paren;
@ -314,7 +331,8 @@ package body Tchk is
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);
@ -393,7 +411,8 @@ package body Tchk is
if Token = Tok_Right_Paren then
Scan;
else
Error_Msg_AP ("|missing "")""");
Error_Msg_AP -- CODEFIX
("|missing "")""");
end if;
end T_Right_Paren;
@ -408,24 +427,28 @@ package body Tchk is
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;
@ -464,7 +487,8 @@ package body Tchk is
-- 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;
@ -646,7 +670,8 @@ package body Tchk is
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
@ -814,7 +839,8 @@ package body Tchk is
if Token = Tok_Left_Paren then
Scan;
else
Error_Msg_AP ("missing ""(""!");
Error_Msg_AP -- CODEFIX
("missing ""(""!");
end if;
end U_Left_Paren;
@ -827,7 +853,8 @@ package body Tchk is
if Token = Tok_Right_Paren then
Scan;
else
Error_Msg_AP ("|missing "")""!");
Error_Msg_AP -- CODEFIX
("|missing "")""!");
end if;
end U_Right_Paren;
@ -846,7 +873,8 @@ package body Tchk is
Scan;
if Token = T then
Error_Msg_SP ("|extra "";"" ignored");
Error_Msg_SP -- CODEFIX
("|extra "";"" ignored");
Scan;
else
Error_Msg_SP (M);
@ -856,7 +884,8 @@ package body Tchk is
Scan;
if Token = T then
Error_Msg_SP ("|extra "","" ignored");
Error_Msg_SP -- CODEFIX
("|extra "","" ignored");
Scan;
else

View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -72,7 +72,8 @@ package body Util is
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;
@ -86,8 +87,7 @@ package body Util is
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;
@ -334,7 +334,8 @@ package body Util is
<<Assume_Comma>>
Restore_Scan_State (Scan_State);
Error_Msg_SC ("|"";"" should be "",""");
Error_Msg_SC -- CODEFIX
("|"";"" should be "",""");
Scan; -- past the semicolon
return True;
@ -384,26 +385,30 @@ package body Util is
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;
@ -567,8 +572,7 @@ package body Util is
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;

View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -411,7 +411,8 @@ package body Prep is
Scan.all;
else
Error_Msg ("`)` expected", Token_Ptr);
Error_Msg -- CODEFIX
("`)` expected", Token_Ptr);
end if;
when Tok_Not =>
@ -906,7 +907,8 @@ package body Prep is
Scan.all;
if Token /= Tok_Colon_Equal then
Error_Msg ("`:=` expected", Token_Ptr);
Error_Msg -- CODEFIX
("`:=` expected", Token_Ptr);
goto Cleanup;
end if;
@ -1219,7 +1221,8 @@ package body Prep is
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;
@ -1269,14 +1272,16 @@ package body Prep is
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
@ -1312,13 +1317,15 @@ package body Prep is
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);

View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -342,7 +342,8 @@ package body Prepcomp is
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;
@ -463,7 +464,8 @@ package body Prepcomp is
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;

View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -325,7 +325,8 @@ package body Scng is
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;
@ -380,16 +381,14 @@ package body Scng is
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;
@ -572,8 +571,7 @@ package body Scng is
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;
@ -658,9 +656,11 @@ package body Scng is
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;
@ -875,7 +875,7 @@ package body Scng is
end if;
end if;
Error_Msg_S -- CODEFIX
Error_Msg_S -- CODEFIX
("missing string quote");
end Error_Unterminated_String;
@ -1215,7 +1215,8 @@ package body Scng is
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;
@ -1263,7 +1264,8 @@ package body Scng is
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;
@ -1367,7 +1369,8 @@ package body Scng is
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;
@ -1588,8 +1591,7 @@ package body Scng is
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;
@ -1669,13 +1671,13 @@ package body Scng is
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;
@ -1789,7 +1791,8 @@ package body Scng is
-- 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;
@ -1815,12 +1818,12 @@ package body Scng is
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;
@ -2068,8 +2071,7 @@ package body Scng is
-- 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;
@ -2078,8 +2080,7 @@ package body Scng is
-- 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;

View File

@ -1431,8 +1431,7 @@ package body Sem_Aggr is
-- 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);
@ -1444,7 +1443,7 @@ package body Sem_Aggr is
-- 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;
@ -1549,13 +1548,13 @@ package body Sem_Aggr is
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;
@ -3025,13 +3024,13 @@ package body Sem_Aggr is
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;
@ -3246,11 +3245,10 @@ package body Sem_Aggr is
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;
@ -3283,11 +3281,10 @@ package body Sem_Aggr is
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
@ -3772,7 +3769,7 @@ package body Sem_Aggr is
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;

View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -2384,8 +2384,8 @@ package body Sem_Attr is
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)));
@ -7643,8 +7643,7 @@ package body Sem_Attr is
-- 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,
@ -7654,8 +7653,7 @@ package body Sem_Attr is
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

View File

@ -692,9 +692,8 @@ package body Sem_Ch10 is
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);
@ -1472,11 +1471,11 @@ package body Sem_Ch10 is
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);
@ -1855,8 +1854,7 @@ package body Sem_Ch10 is
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));
@ -2255,8 +2253,7 @@ package body Sem_Ch10 is
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');
@ -2397,15 +2394,13 @@ package body Sem_Ch10 is
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 " &
@ -3455,7 +3450,7 @@ package body Sem_Ch10 is
end loop;
if E2 = WEnt then
Error_Msg_N -- CODEFIX???
Error_Msg_N
("unlimited view visible through use clause ", W);
return;
end if;
@ -3805,7 +3800,7 @@ package body Sem_Ch10 is
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
@ -4497,11 +4492,11 @@ package body Sem_Ch10 is
-- 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);

View File

@ -1144,8 +1144,7 @@ package body Sem_Ch12 is
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
@ -1835,11 +1834,11 @@ package body Sem_Ch12 is
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;
@ -4089,7 +4088,7 @@ package body Sem_Ch12 is
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
@ -4100,7 +4099,7 @@ package body Sem_Ch12 is
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
@ -4228,7 +4227,7 @@ package body Sem_Ch12 is
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;
@ -5045,7 +5044,7 @@ package body Sem_Ch12 is
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;
@ -8356,14 +8355,14 @@ package body Sem_Ch12 is
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;
@ -8530,7 +8529,7 @@ package body Sem_Ch12 is
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;
@ -9214,13 +9213,13 @@ package body Sem_Ch12 is
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);
@ -9270,7 +9269,7 @@ package body Sem_Ch12 is
-- 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;
@ -9392,7 +9391,7 @@ package body Sem_Ch12 is
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;
@ -9581,7 +9580,7 @@ package body Sem_Ch12 is
-- 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);
@ -9589,7 +9588,7 @@ package body Sem_Ch12 is
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;
@ -9944,7 +9943,7 @@ package body Sem_Ch12 is
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);
@ -9992,7 +9991,7 @@ package body Sem_Ch12 is
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);

View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -1810,8 +1810,7 @@ package body Sem_Ch13 is
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;
@ -4243,8 +4242,7 @@ package body Sem_Ch13 is
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;

View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -1912,8 +1912,7 @@ package body Sem_Ch3 is
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);
@ -8573,8 +8572,7 @@ package body Sem_Ch3 is
-- 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;
@ -8775,8 +8773,7 @@ package body Sem_Ch3 is
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
@ -8787,8 +8784,7 @@ package body Sem_Ch3 is
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
@ -9811,8 +9807,9 @@ package body Sem_Ch3 is
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
@ -10065,8 +10062,7 @@ package body Sem_Ch3 is
-- 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
@ -10814,8 +10810,7 @@ package body Sem_Ch3 is
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;
@ -13489,8 +13484,9 @@ package body Sem_Ch3 is
(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;
@ -13943,9 +13939,9 @@ package body Sem_Ch3 is
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
@ -16253,15 +16249,17 @@ package body Sem_Ch3 is
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;

View File

@ -307,10 +307,9 @@ package body Sem_Ch4 is
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;
@ -322,16 +321,13 @@ package body Sem_Ch4 is
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
@ -4148,24 +4144,20 @@ package body Sem_Ch4 is
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
@ -4173,8 +4165,7 @@ package body Sem_Ch4 is
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
@ -4184,8 +4175,7 @@ package body Sem_Ch4 is
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;
@ -4659,7 +4649,7 @@ package body Sem_Ch4 is
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;
@ -5680,9 +5670,9 @@ package body Sem_Ch4 is
(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;
@ -6373,7 +6363,7 @@ package body Sem_Ch4 is
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);
@ -6428,28 +6418,27 @@ package body Sem_Ch4 is
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);
@ -6650,8 +6639,7 @@ package body Sem_Ch4 is
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;
@ -7068,8 +7056,7 @@ package body Sem_Ch4 is
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;

View File

@ -558,8 +558,7 @@ package body Sem_Ch5 is
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
@ -573,7 +572,7 @@ package body Sem_Ch5 is
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
@ -582,7 +581,7 @@ package body Sem_Ch5 is
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;
@ -1636,11 +1635,10 @@ package body Sem_Ch5 is
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;
@ -1892,7 +1890,7 @@ package body Sem_Ch5 is
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);
@ -1946,8 +1944,7 @@ package body Sem_Ch5 is
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;
@ -2244,8 +2241,7 @@ package body Sem_Ch5 is
-- 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

View File

@ -315,7 +315,7 @@ package body Sem_Ch6 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;
@ -1126,8 +1126,7 @@ package body Sem_Ch6 is
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;
@ -1175,8 +1174,7 @@ package body Sem_Ch6 is
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
@ -1829,20 +1827,20 @@ package body Sem_Ch6 is
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);
@ -1852,7 +1850,7 @@ package body Sem_Ch6 is
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);
@ -2060,8 +2058,7 @@ package body Sem_Ch6 is
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
@ -2638,8 +2635,7 @@ package body Sem_Ch6 is
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;
@ -2735,7 +2731,7 @@ package body Sem_Ch6 is
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;
@ -2912,7 +2908,7 @@ package body Sem_Ch6 is
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;
@ -3520,21 +3516,21 @@ package body Sem_Ch6 is
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;
@ -4007,7 +4003,7 @@ package body Sem_Ch6 is
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);
@ -4016,17 +4012,16 @@ package body Sem_Ch6 is
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;
@ -4035,7 +4030,7 @@ package body Sem_Ch6 is
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);
@ -4455,7 +4450,7 @@ package body Sem_Ch6 is
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;
@ -4490,10 +4485,10 @@ package body Sem_Ch6 is
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;
@ -4544,12 +4539,12 @@ package body Sem_Ch6 is
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;
@ -4559,8 +4554,7 @@ package body Sem_Ch6 is
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)
@ -4589,11 +4583,9 @@ package body Sem_Ch6 is
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
@ -4606,7 +4598,7 @@ package body Sem_Ch6 is
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;
@ -6916,7 +6908,7 @@ package body Sem_Ch6 is
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);
@ -6925,10 +6917,10 @@ package body Sem_Ch6 is
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;
@ -8084,14 +8076,14 @@ package body Sem_Ch6 is
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);
@ -8149,7 +8141,7 @@ package body Sem_Ch6 is
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;
@ -8813,7 +8805,7 @@ package body Sem_Ch6 is
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;

View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -261,8 +261,7 @@ package body Sem_Ch7 is
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;

View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -893,7 +893,7 @@ package body Sem_Ch8 is
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;
@ -2581,8 +2581,7 @@ package body Sem_Ch8 is
("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
@ -2703,7 +2702,7 @@ package body Sem_Ch8 is
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;
@ -3071,8 +3070,7 @@ package body Sem_Ch8 is
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;
@ -3836,7 +3834,8 @@ package body Sem_Ch8 is
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;
@ -3914,7 +3913,7 @@ package body Sem_Ch8 is
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;
@ -3978,7 +3977,7 @@ package body Sem_Ch8 is
-- 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);
@ -3991,7 +3990,8 @@ package body Sem_Ch8 is
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
@ -4729,7 +4729,8 @@ package body Sem_Ch8 is
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;
@ -4786,7 +4787,8 @@ package body Sem_Ch8 is
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
@ -4867,7 +4869,8 @@ package body Sem_Ch8 is
(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;
@ -5159,11 +5162,11 @@ package body Sem_Ch8 is
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;
@ -5743,7 +5746,7 @@ package body Sem_Ch8 is
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;
@ -6544,7 +6547,7 @@ package body Sem_Ch8 is
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;
@ -7522,14 +7525,14 @@ package body Sem_Ch8 is
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;
@ -7539,7 +7542,7 @@ package body Sem_Ch8 is
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;
@ -7590,7 +7593,7 @@ package body Sem_Ch8 is
end;
end if;
Error_Msg_NE
Error_Msg_NE -- CODEFIX
("& is already use-visible through previous "
& "use_type_clause #?", Err_No, Id);
@ -7599,7 +7602,7 @@ package body Sem_Ch8 is
-- 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;
@ -7609,7 +7612,7 @@ package body Sem_Ch8 is
-- 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;
@ -7618,7 +7621,7 @@ package body Sem_Ch8 is
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);
@ -7626,7 +7629,7 @@ package body Sem_Ch8 is
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;

View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -2424,15 +2424,17 @@ package body Sem_Ch9 is
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;

View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -640,8 +640,8 @@ package body Sem_Disp is
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;
@ -746,7 +746,7 @@ package body Sem_Disp is
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;

View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -2432,7 +2432,8 @@ package body Sem_Elab is
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;

View File

@ -3058,8 +3058,7 @@ package body Sem_Eval is
= 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????

View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -92,8 +92,7 @@ package body Sem_Mech is
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

View File

@ -1049,8 +1049,7 @@ package body Sem_Prag is
("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
@ -2618,7 +2617,7 @@ package body Sem_Prag is
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;
@ -3270,7 +3269,7 @@ package body Sem_Prag is
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;
@ -3729,11 +3728,11 @@ package body Sem_Prag is
-- 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;
@ -3855,8 +3854,7 @@ package body Sem_Prag is
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
@ -4080,10 +4078,10 @@ package body Sem_Prag is
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;
@ -4155,7 +4153,7 @@ package body Sem_Prag is
or else
Get_Character (C) = '/'))
then
Error_Msg -- CODEFIX???
Error_Msg
("?interface name contains illegal character",
Sloc (SN) + Source_Ptr (J));
end if;
@ -4689,11 +4687,11 @@ package body Sem_Prag is
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;
@ -4712,8 +4710,7 @@ package body Sem_Prag is
-- 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
@ -4739,8 +4736,7 @@ package body Sem_Prag is
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
@ -4862,8 +4858,7 @@ package body Sem_Prag is
("\(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
@ -6376,7 +6371,7 @@ package body Sem_Prag is
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;
@ -6412,7 +6407,7 @@ package body Sem_Prag is
-- 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));
@ -6575,7 +6570,7 @@ package body Sem_Prag is
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;
@ -6590,7 +6585,7 @@ package body Sem_Prag is
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;
@ -6833,7 +6828,7 @@ package body Sem_Prag is
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;
@ -10471,13 +10466,13 @@ package body Sem_Prag is
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;
@ -10490,7 +10485,7 @@ package body Sem_Prag is
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;
@ -10651,7 +10646,7 @@ package body Sem_Prag is
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;
@ -10826,10 +10821,8 @@ package body Sem_Prag is
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;
-------------------------
@ -10846,10 +10839,9 @@ package body Sem_Prag is
(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;
------------------
@ -11799,14 +11791,14 @@ package body Sem_Prag is
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;

View File

@ -282,29 +282,24 @@ package body Sem_Res is
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;
@ -1774,8 +1769,7 @@ package body Sem_Res is
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 ???
@ -1784,11 +1778,9 @@ package body Sem_Res is
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);
@ -2083,7 +2075,7 @@ package body Sem_Res is
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
@ -2095,7 +2087,7 @@ package body Sem_Res is
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
@ -2173,19 +2165,19 @@ package body Sem_Res is
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
@ -2938,7 +2930,7 @@ package body Sem_Res is
-- 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);
@ -4229,8 +4221,7 @@ package body Sem_Res is
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,
@ -7422,7 +7413,7 @@ package body Sem_Res is
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
@ -7444,8 +7435,7 @@ package body Sem_Res is
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
@ -7456,8 +7446,7 @@ package body Sem_Res is
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
@ -8881,7 +8870,7 @@ package body Sem_Res is
-- 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;
@ -9262,12 +9251,9 @@ package body Sem_Res is
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

View File

@ -9299,8 +9299,7 @@ package body Sem_Util is
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);
@ -9355,7 +9354,7 @@ package body Sem_Util is
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;
@ -11362,7 +11361,7 @@ package body Sem_Util is
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;
@ -11451,7 +11450,7 @@ package body Sem_Util is
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
@ -11464,7 +11463,7 @@ package body Sem_Util is
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);
@ -11478,7 +11477,7 @@ package body Sem_Util is
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

View File

@ -199,7 +199,7 @@ package body Sem_Warn is
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;
@ -207,7 +207,7 @@ package body Sem_Warn is
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;
@ -218,7 +218,7 @@ package body Sem_Warn is
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);
@ -1083,7 +1083,7 @@ package body Sem_Warn is
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
@ -1275,7 +1275,7 @@ package body Sem_Warn is
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));
@ -2771,7 +2771,7 @@ package body Sem_Warn is
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
@ -2781,7 +2781,7 @@ package body Sem_Warn is
-- default mode.
elsif Check_Unreferenced then
Error_Msg_N -- CODEFIX???
Error_Msg_N
("?formal parameter& is read but "
& "never assigned!", E1);
end if;
@ -2968,21 +2968,21 @@ package body Sem_Warn is
-- 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;
@ -3606,19 +3606,17 @@ package body Sem_Warn is
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;
@ -4002,7 +4000,7 @@ package body Sem_Warn is
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);
@ -4013,7 +4011,7 @@ package body Sem_Warn is
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;
@ -4218,8 +4216,7 @@ package body Sem_Warn is
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 =>

View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -637,7 +637,7 @@ package body SFN_Scan is
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

View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -78,11 +78,11 @@ package body Style is
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;
@ -161,7 +161,7 @@ package body Style is
then
Error_Msg_Node_1 := Def;
Error_Msg_Sloc := Sloc (Def);
Error_Msg
Error_Msg -- CODEFIX
("(style) bad casing of & declared#", Sref);
return;
@ -222,7 +222,7 @@ package body Style is
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;
@ -243,10 +243,10 @@ package body Style is
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;
@ -259,7 +259,7 @@ package body Style is
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;

View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -237,9 +237,11 @@ package body Styleg is
-- 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;
@ -434,7 +436,8 @@ package body Styleg is
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;
@ -447,7 +450,8 @@ package body Styleg is
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;
@ -505,7 +509,8 @@ package body Styleg is
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;
@ -558,12 +563,12 @@ package body Styleg is
-- 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;
@ -590,7 +595,8 @@ package body Styleg is
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;
@ -608,7 +614,8 @@ package body Styleg is
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;
@ -682,9 +689,11 @@ package body Styleg is
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;
@ -717,7 +726,7 @@ package body Styleg is
-- 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;
@ -913,7 +922,7 @@ package body Styleg is
else
if Token = Tok_Then then
Error_Msg
Error_Msg -- CODEFIX
("(style) no statements may follow THEN on same line", S);
else
Error_Msg
@ -977,7 +986,8 @@ package body Styleg is
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;
@ -996,7 +1006,8 @@ package body Styleg is
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;
--------------------------
@ -1005,7 +1016,8 @@ package body Styleg is
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;
--------------------
@ -1037,7 +1049,8 @@ package body Styleg is
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;
@ -1052,7 +1065,8 @@ package body Styleg is
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;
@ -1067,7 +1081,7 @@ package body Styleg is
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;