Commit dbfeb4fa by Robert Dewar Committed by Arnaud Charlet

errout.adb (Set_Msg_Insertion_Warning): Correct typo causing tests to fail if…

errout.adb (Set_Msg_Insertion_Warning): Correct typo causing tests to fail if insertion sequence is at end of message...

2013-01-02  Robert Dewar  <dewar@adacore.com>

	* errout.adb (Set_Msg_Insertion_Warning): Correct typo causing
	tests to fail if insertion sequence is at end of message string.
	* opt.ads: Minor comment fixes and additions.
	* sem_ch7.adb, sem_ch8.adb, sem_ch9.adb, sem_ch10.adb, sem_ch11.adb,
	sem_ch12.adb, sem_ch13.adb: Add tags to warning messages.
	* sem_ch6.ads, sem_ch6.adb (Cannot_Inline): Deal with warning message
	tags. Add tags to warning messages.

From-SVN: r194785
parent a3633438
2013-01-02 Robert Dewar <dewar@adacore.com>
* errout.adb (Set_Msg_Insertion_Warning): Correct typo causing
tests to fail if insertion sequence is at end of message string.
* opt.ads: Minor comment fixes and additions.
* sem_ch7.adb, sem_ch8.adb, sem_ch9.adb, sem_ch10.adb, sem_ch11.adb,
sem_ch12.adb, sem_ch13.adb: Add tags to warning messages.
* sem_ch6.ads, sem_ch6.adb (Cannot_Inline): Deal with warning message
tags. Add tags to warning messages.
2013-01-02 Robert Dewar <dewar@adacore.com>
* err_vars.ads (Warning_Doc_Switch): New flag.
* errout.adb (Error_Msg_Internal): Implement new warning flag
doc tag stuff (Set_Msg_Insertion_Warning): New procedure.
......
......@@ -2677,14 +2677,14 @@ package body Errout is
begin
Warning_Msg_Char := ' ';
if P + 1 <= Text'Last and then Text (P) = '?' then
if P <= Text'Last and then Text (P) = '?' then
if Warning_Doc_Switch then
Warning_Msg_Char := '?';
end if;
P := P + 1;
elsif P + 2 <= Text'Last
elsif P + 1 <= Text'Last
and then (Text (P) in 'a' .. 'z'
or else
Text (P) in 'A' .. 'Z')
......
......@@ -1506,8 +1506,8 @@ package Opt is
Warn_On_Biased_Representation : Boolean := True;
-- GNAT
-- Set to True to generate warnings for size clauses, component clauses
-- and component_size clauses that force biased representation. Set False
-- by -gnatw.B.
-- and component_size clauses that force biased representation. Modified
-- by use of -gnatw.b/.B.
Warn_On_Constant : Boolean := False;
-- GNAT
......@@ -1567,12 +1567,14 @@ package Opt is
Warn_On_Object_Renames_Function : Boolean := False;
-- GNAT
-- Set to True to generate warnings when a function result is renamed as
-- an object. The default is that this warning is disabled.
-- an object. The default is that this warning is disabled. Modified by
-- use of -gnatw.r/.R.
Warn_On_Obsolescent_Feature : Boolean := False;
-- GNAT
-- Set to True to generate warnings on use of any feature in Annex or if a
-- subprogram is called for which a pragma Obsolescent applies.
-- subprogram is called for which a pragma Obsolescent applies. Modified
-- by use of -gnatwj/J.
Warn_On_Overlap : Boolean := False;
-- GNAT
......@@ -1600,7 +1602,7 @@ package Opt is
-- GNAT
-- Set to True to generate warning (informational) messages for component
-- clauses that are affected by non-standard bit-order. The default is
-- that this warning is enabled.
-- that this warning is enabled. Modified by -gnatw.v/.V.
Warn_On_Suspicious_Contract : Boolean := False;
-- GNAT
......@@ -1616,8 +1618,8 @@ package Opt is
Warn_On_Unchecked_Conversion : Boolean := True;
-- GNAT
-- Set to True to generate warnings for unchecked conversions that may have
-- non-portable semantics (e.g. because sizes of types differ). The default
-- is that this warning is enabled.
-- non-portable semantics (e.g. because sizes of types differ). Modified
-- by use of -gnatw.z/.Z.
Warn_On_Unordered_Enumeration_Type : Boolean := False;
-- GNAT
......@@ -1635,7 +1637,7 @@ package Opt is
-- GNAT
-- Set to True to generate warnings for the case of components of record
-- which have a record representation clause but this component does not
-- have a component clause. The default is that this warning is disabled.
-- have a component clause. Modified by use of -gnatw.c/.C.
Warn_On_Warnings_Off : Boolean := False;
-- GNAT
......
......@@ -556,7 +556,7 @@ package body Sem_Ch10 is
Used_In_Spec)
then
Error_Msg_N -- CODEFIX
("?redundant with clause in body", Clause);
("redundant with clause in body??", Clause);
end if;
Used_In_Body := False;
......@@ -585,7 +585,7 @@ package body Sem_Ch10 is
if Withed then
Error_Msg_N -- CODEFIX
("?redundant with clause", Clause);
("redundant with clause??", Clause);
end if;
end;
end if;
......@@ -1793,7 +1793,7 @@ package body Sem_Ch10 is
Error_Msg_File_1 :=
Get_File_Name (Subunit_Name, Subunit => True);
Error_Msg_N
("subunit$$ in file{ not found?!!", N);
("subunit$$ in file{ not found??!!", N);
Subunits_Missing := True;
end if;
......@@ -2513,30 +2513,30 @@ package body Sem_Ch10 is
begin
if U_Kind = Implementation_Unit then
Error_Msg_F ("& is an internal 'G'N'A'T unit?", Name (N));
Error_Msg_F ("& is an internal 'G'N'A'T unit?i?", Name (N));
-- Add alternative name if available, otherwise issue a
-- general warning message.
if Error_Msg_Strlen /= 0 then
Error_Msg_F ("\use ""~"" instead", Name (N));
Error_Msg_F ("\use ""~"" instead?i?", Name (N));
else
Error_Msg_F
("\use of this unit is non-portable " &
"and version-dependent?", Name (N));
"and version-dependent?i?", Name (N));
end if;
elsif U_Kind = Ada_2005_Unit
and then Ada_Version < Ada_2005
and then Warn_On_Ada_2005_Compatibility
then
Error_Msg_N ("& is an Ada 2005 unit?", Name (N));
Error_Msg_N ("& is an Ada 2005 unit?i?", Name (N));
elsif U_Kind = Ada_2012_Unit
and then Ada_Version < Ada_2012
and then Warn_On_Ada_2012_Compatibility
then
Error_Msg_N ("& is an Ada 2012 unit?", Name (N));
Error_Msg_N ("& is an Ada 2012 unit?i?", Name (N));
end if;
end;
end if;
......@@ -3342,7 +3342,7 @@ package body Sem_Ch10 is
procedure License_Error is
begin
Error_Msg_N
("?license of withed unit & may be inconsistent",
("license of withed unit & may be inconsistent??",
Name (Item));
end License_Error;
......@@ -4129,7 +4129,7 @@ package body Sem_Ch10 is
then
Error_Msg_NE
("child unit& hides compilation unit " &
"with the same name?",
"with the same name??",
Name (Item), Id);
exit;
end if;
......
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2012, 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- --
......@@ -266,7 +266,7 @@ package body Sem_Ch11 is
and then Scope (Entity (Id)) = Current_Scope
then
Error_Msg_NE
("?exception & is never raised", Entity (Id), Id);
("exception & is never raised?r?", Entity (Id), Id);
end if;
if Present (Renamed_Entity (Entity (Id))) then
......@@ -276,9 +276,9 @@ package body Sem_Ch11 is
if Warn_On_Obsolescent_Feature then
Error_Msg_N
("Numeric_Error is an " &
"obsolescent feature (RM J.6(1))?", Id);
"obsolescent feature (RM J.6(1))?j?", Id);
Error_Msg_N
("\use Constraint_Error instead?", Id);
("\use Constraint_Error instead?j?", Id);
end if;
end if;
end if;
......@@ -345,7 +345,7 @@ package body Sem_Ch11 is
N_Others_Choice)
then
Error_Msg_N
("useless handler contains only a reraise statement?",
("useless handler contains only a reraise statement?r?",
Handler);
end if;
......@@ -445,8 +445,7 @@ package body Sem_Ch11 is
end if;
-- Check for useless assignment to OUT or IN OUT scalar preceding the
-- raise. Right now we only look at assignment statements, we could do
-- more.
-- raise. Right now only look at assignment statements, could do more???
if Is_List_Member (N) then
declare
......@@ -496,11 +495,11 @@ package body Sem_Ch11 is
if No (Exception_Handlers (Par)) then
Error_Msg_N
("?assignment to pass-by-copy formal " &
"may have no effect", P);
("assignment to pass-by-copy formal " &
"may have no effect??", P);
Error_Msg_N
("\?RAISE statement may result in abnormal return" &
" (RM 6.4.1(17))", P);
("\RAISE statement may result in abnormal return" &
" (RM 6.4.1(17))??", P);
end if;
end if;
end if;
......
......@@ -10491,8 +10491,7 @@ package body Sem_Ch12 is
-- This is a binding interpretation that applies to previous versions
-- of the language, but for now we retain the milder check in order
-- to preserve ACATS tests.
-- These will be protested eventually ???
-- to preserve ACATS tests. These will be protested eventually ???
if Ada_Version < Ada_2012 then
Check_Mode_Conformant
......@@ -12155,8 +12154,8 @@ package body Sem_Ch12 is
E1 := First_Entity (Form);
E2 := First_Entity (Act);
while Present (E1) and then E1 /= First_Private_Entity (Form) loop
-- Could this test be a single condition???
-- Seems like it could, and isn't FPE (Form) a constant anyway???
-- Could this test be a single condition??? Seems like it could, and
-- isn't FPE (Form) a constant anyway???
if not Is_Internal (E1)
and then Present (Parent (E1))
......@@ -12422,7 +12421,7 @@ package body Sem_Ch12 is
-- provide additional warning which might explain the error.
Set_Is_Immediately_Visible (Cur, Vis);
Error_Msg_NE ("& hides outer unit with the same name?",
Error_Msg_NE ("& hides outer unit with the same name??",
N, Defining_Unit_Name (N));
end if;
......
......@@ -279,16 +279,16 @@ package body Sem_Ch13 is
then
Error_Msg_N
("multi-byte field specified with non-standard"
& " Bit_Order?", CLC);
& " Bit_Order??", CLC);
if Bytes_Big_Endian then
Error_Msg_N
("bytes are not reversed "
& "(component is big-endian)?", CLC);
& "(component is big-endian)??", CLC);
else
Error_Msg_N
("bytes are not reversed "
& "(component is little-endian)?", CLC);
& "(component is little-endian)??", CLC);
end if;
-- Do not allow non-contiguous field
......@@ -314,14 +314,14 @@ package body Sem_Ch13 is
and then Warn_On_Reverse_Bit_Order
then
Error_Msg_N
("?Bit_Order clause does not affect " &
"byte ordering", Pos);
("Bit_Order clause does not affect " &
"byte ordering?V?", Pos);
Error_Msg_Uint_1 :=
Intval (Pos) + Intval (FB) /
System_Storage_Unit;
Error_Msg_N
("?position normalized to ^ before bit " &
"order interpreted", Pos);
("position normalized to ^ before bit " &
"order interpreted?V?", Pos);
end if;
-- Here is where we fix up the Component_Bit_Offset value
......@@ -390,10 +390,8 @@ package body Sem_Ch13 is
if Present (CC) then
declare
Fbit : constant Uint :=
Static_Integer (First_Bit (CC));
Lbit : constant Uint :=
Static_Integer (Last_Bit (CC));
Fbit : constant Uint := Static_Integer (First_Bit (CC));
Lbit : constant Uint := Static_Integer (Last_Bit (CC));
begin
-- Case of component with last bit >= max machine scalar
......@@ -410,16 +408,16 @@ package body Sem_Ch13 is
if Warn_On_Reverse_Bit_Order then
Error_Msg_N
("multi-byte field specified with "
& " non-standard Bit_Order?", CC);
& " non-standard Bit_Order?V?", CC);
if Bytes_Big_Endian then
Error_Msg_N
("\bytes are not reversed "
& "(component is big-endian)?", CC);
& "(component is big-endian)?V?", CC);
else
Error_Msg_N
("\bytes are not reversed "
& "(component is little-endian)?", CC);
& "(component is little-endian)?V?", CC);
end if;
end if;
......@@ -633,19 +631,19 @@ package body Sem_Ch13 is
Error_Msg_Uint_1 := MSS;
Error_Msg_N
("info: reverse bit order in machine " &
"scalar of length^?", First_Bit (CC));
"scalar of length^?V?", First_Bit (CC));
Error_Msg_Uint_1 := NFB;
Error_Msg_Uint_2 := NLB;
if Bytes_Big_Endian then
Error_Msg_NE
("?\info: big-endian range for "
& "component & is ^ .. ^",
("\info: big-endian range for "
& "component & is ^ .. ^?V?",
First_Bit (CC), Comp);
else
Error_Msg_NE
("?\info: little-endian range "
& "for component & is ^ .. ^",
("\info: little-endian range "
& "for component & is ^ .. ^?V?",
First_Bit (CC), Comp);
end if;
end if;
......@@ -2759,9 +2757,9 @@ package body Sem_Ch13 is
and then Comes_From_Source (Scope (U_Ent))
then
Error_Msg_N
("?entry address declared for entry in task type", N);
("??entry address declared for entry in task type", N);
Error_Msg_N
("\?only one task can be declared of this type", N);
("\??only one task can be declared of this type", N);
end if;
-- Entry address clauses are obsolescent
......@@ -2770,10 +2768,10 @@ package body Sem_Ch13 is
if Warn_On_Obsolescent_Feature then
Error_Msg_N
("attaching interrupt to task entry is an " &
"obsolescent feature (RM J.7.1)?", N);
("?j?attaching interrupt to task entry is an " &
"obsolescent feature (RM J.7.1)", N);
Error_Msg_N
("\use interrupt procedure instead?", N);
("\?j?use interrupt procedure instead", N);
end if;
-- Case of an address clause for a controlled object which we
......@@ -2783,9 +2781,9 @@ package body Sem_Ch13 is
or else Has_Controlled_Component (Etype (U_Ent))
then
Error_Msg_NE
("?controlled object& must not be overlaid", Nam, U_Ent);
("??controlled object& must not be overlaid", Nam, U_Ent);
Error_Msg_N
("\?Program_Error will be raised at run time", Nam);
("\??Program_Error will be raised at run time", Nam);
Insert_Action (Declaration_Node (U_Ent),
Make_Raise_Program_Error (Loc,
Reason => PE_Overlaid_Controlled_Object));
......@@ -2822,9 +2820,9 @@ package body Sem_Ch13 is
or else Is_Controlled (Etype (O_Ent)))
then
Error_Msg_N
("?cannot overlay with controlled object", Expr);
("??cannot overlay with controlled object", Expr);
Error_Msg_N
("\?Program_Error will be raised at run time", Expr);
("\??Program_Error will be raised at run time", Expr);
Insert_Action (Declaration_Node (U_Ent),
Make_Raise_Program_Error (Loc,
Reason => PE_Overlaid_Controlled_Object));
......@@ -2834,7 +2832,7 @@ package body Sem_Ch13 is
and then Ekind (U_Ent) = E_Constant
and then not Is_Constant_Object (O_Ent)
then
Error_Msg_N ("constant overlays a variable?", Expr);
Error_Msg_N ("??constant overlays a variable", Expr);
-- Imported variables can have an address clause, but then
-- the import is pretty meaningless except to suppress
......@@ -3005,7 +3003,7 @@ package body Sem_Ch13 is
if Is_Tagged_Type (U_Ent) and then Align > Max_Align then
Error_Msg_N
("?alignment for & set to Maximum_Aligment", Nam);
("alignment for & set to Maximum_Aligment??", Nam);
Set_Alignment (U_Ent, Max_Align);
-- All other cases
......@@ -3133,7 +3131,7 @@ package body Sem_Ch13 is
if not GNAT_Mode then
Error_Msg_N
("?component size ignored in this configuration", N);
("component size ignored in this configuration??", N);
end if;
end if;
......@@ -3144,8 +3142,7 @@ package body Sem_Ch13 is
and then RM_Size (Ctyp) /= Csize
then
Error_Msg_NE
("?component size overrides size clause for&",
N, Ctyp);
("component size overrides size clause for&?S?", N, Ctyp);
end if;
Set_Has_Component_Size_Clause (Btype, True);
......@@ -3301,11 +3298,12 @@ package body Sem_Ch13 is
if not Is_Library_Level_Entity (U_Ent) then
Error_Msg_NE
("?non-unique external tag supplied for &", N, U_Ent);
("??non-unique external tag supplied for &", N, U_Ent);
Error_Msg_N
("?\same external tag applies to all subprogram calls", N);
("\??same external tag applies to all "
& "subprogram calls", N);
Error_Msg_N
("?\corresponding internal tag cannot be obtained", N);
("\??corresponding internal tag cannot be obtained", N);
end if;
end if;
end External_Tag;
......@@ -3586,7 +3584,7 @@ package body Sem_Ch13 is
-- case this is useless.
Error_Msg_N
("?size clauses are ignored in this configuration", N);
("size clauses are ignored in this configuration??", N);
end if;
if Is_Type (U_Ent) then
......@@ -3875,9 +3873,9 @@ package body Sem_Ch13 is
if Warn_On_Obsolescent_Feature then
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);
("?j?storage size clause for task is an " &
"obsolescent feature (RM J.9)", N);
Error_Msg_N ("\?j?use Storage_Size pragma instead", N);
end if;
FOnly := True;
......@@ -4510,7 +4508,7 @@ package body Sem_Ch13 is
if First_Entity (E) /= Last_Entity (E) then
Error_Msg_N
("?'C'P'P type must import at least one primitive from C++",
("'C'P'P type must import at least one primitive from C++??",
E);
end if;
end if;
......@@ -4537,15 +4535,15 @@ package body Sem_Ch13 is
or else Convention (Prim) /= Convention_CPP
then
Error_Msg_N
("?primitives of 'C'P'P types must be imported from C++"
& " or abstract", Prim);
("primitives of 'C'P'P types must be imported from C++ "
& "or abstract??", Prim);
elsif not Has_Constructors
and then not Error_Reported
then
Error_Msg_Name_1 := Chars (E);
Error_Msg_N
("?'C'P'P constructor required for type %", Prim);
("??'C'P'P constructor required for type %", Prim);
Error_Reported := True;
end if;
end if;
......@@ -4723,7 +4721,7 @@ package body Sem_Ch13 is
Error_Msg_N
("?j?mod clause is an obsolescent feature (RM J.8)", N);
Error_Msg_N
("\?j?use alignment attribute definition clause instead?", N);
("\?j?use alignment attribute definition clause instead", N);
end if;
if Present (P) then
......@@ -4910,7 +4908,7 @@ package body Sem_Ch13 is
& "with representation of ancestor", CC);
elsif Warn_On_Redundant_Constructs then
Error_Msg_N
("?redundant component clause "
("?r?redundant component clause "
& "for inherited component!", CC);
end if;
end;
......@@ -4950,7 +4948,7 @@ package body Sem_Ch13 is
and then RM_Size (Etype (Comp)) /= Esize (Comp)
then
Error_Msg_NE
("?component size overrides size clause for&",
("?S?component size overrides size clause for&",
Component_Name (CC), Etype (Comp));
end if;
......@@ -5016,7 +5014,7 @@ package body Sem_Ch13 is
Next_Component_Or_Discriminant (Comp);
end loop;
-- If no Complete_Representation pragma, warn if missing components
-- Give missing components warning if required
elsif Warn_On_Unrepped_Components then
declare
......@@ -5060,7 +5058,7 @@ package body Sem_Ch13 is
then
Error_Msg_Sloc := Sloc (Comp);
Error_Msg_NE
("?no component clause given for & declared #",
("?C?no component clause given for & declared #",
N, Comp);
end if;
......@@ -5089,9 +5087,7 @@ package body Sem_Ch13 is
-- Check for duplicate definiations.
if Has_Invariants (Typ)
and then Present (Invariant_Procedure (Typ))
then
if Has_Invariants (Typ) and then Present (Invariant_Procedure (Typ)) then
return Empty;
end if;
......@@ -5567,7 +5563,7 @@ package body Sem_Ch13 is
then
Error_Msg_Sloc := Sloc (Predicate_Function (T));
Error_Msg_Node_2 := T;
Error_Msg_N ("?info: & inherits predicate from & #", Typ);
Error_Msg_N ("info: & inherits predicate from & #??", Typ);
end if;
end if;
end Add_Call;
......@@ -6777,7 +6773,7 @@ package body Sem_Ch13 is
("visibility of aspect for& changes after freeze point",
ASN, Ent);
Error_Msg_NE
("?info: & is frozen here, aspects evaluated at this point",
("info: & is frozen here, aspects evaluated at this point??",
Freeze_Node (Ent), Ent);
end if;
end Check_Aspect_At_End_Of_Declarations;
......@@ -7954,7 +7950,7 @@ package body Sem_Ch13 is
if Error_Msg_Uint_1 > 0 then
Error_Msg_NE
("?^-bit gap before component&",
("?H?^-bit gap before component&",
Component_Name (Component_Clause (CEnt)), CEnt);
end if;
......@@ -8909,7 +8905,7 @@ package body Sem_Ch13 is
if Present (Freeze_Node (S)) then
Error_Msg_NE
("?no more representation items for }", Freeze_Node (S), S);
("??no more representation items for }", Freeze_Node (S), S);
end if;
return True;
......@@ -9291,7 +9287,7 @@ package body Sem_Ch13 is
if Warn_On_Biased_Representation then
Error_Msg_NE
("?" & Msg & " forces biased representation for&", N, E);
("?B?" & Msg & " forces biased representation for&", N, E);
end if;
end if;
end Set_Biased;
......@@ -9400,13 +9396,13 @@ package body Sem_Ch13 is
Error_Msg_NE
("?& overlays smaller object", ACCR.N, ACCR.X);
Error_Msg_N
("\?program execution may be erroneous", ACCR.N);
("\??program execution may be erroneous", ACCR.N);
Error_Msg_Uint_1 := X_Size;
Error_Msg_NE
("\?size of & is ^", ACCR.N, ACCR.X);
("\??size of & is ^", ACCR.N, ACCR.X);
Error_Msg_Uint_1 := Y_Size;
Error_Msg_NE
("\?size of & is ^", ACCR.N, ACCR.Y);
("\??size of & is ^", ACCR.N, ACCR.Y);
-- Check for inadequate alignment, both of the base object
-- and of the offset, if any.
......@@ -9427,24 +9423,20 @@ package body Sem_Ch13 is
/= Known_Compatible))
then
Error_Msg_NE
("?specified address for& may be inconsistent "
& "with alignment",
ACCR.N, ACCR.X);
("??specified address for& may be inconsistent "
& "with alignment", ACCR.N, ACCR.X);
Error_Msg_N
("\?program execution may be erroneous (RM 13.3(27))",
("\??program execution may be erroneous (RM 13.3(27))",
ACCR.N);
Error_Msg_Uint_1 := X_Alignment;
Error_Msg_NE
("\?alignment of & is ^",
ACCR.N, ACCR.X);
("\??alignment of & is ^", ACCR.N, ACCR.X);
Error_Msg_Uint_1 := Y_Alignment;
Error_Msg_NE
("\?alignment of & is ^",
ACCR.N, ACCR.Y);
("\??alignment of & is ^", ACCR.N, ACCR.Y);
if Y_Alignment >= X_Alignment then
Error_Msg_N
("\?but offset is not multiple of alignment",
ACCR.N);
("\??but offset is not multiple of alignment", ACCR.N);
end if;
end if;
end if;
......@@ -9805,7 +9797,8 @@ package body Sem_Ch13 is
or else OpenVMS_On_Target
then
Error_Msg_N
("?conversion between pointers with different conventions!", N);
("?Z?conversion between pointers with different conventions!",
N);
end if;
end if;
......@@ -9831,7 +9824,7 @@ package body Sem_Ch13 is
if Source = Calendar_Time or else Target = Calendar_Time then
Error_Msg_N
("?representation of 'Time values may change between " &
("?Z?representation of 'Time values may change between " &
"'G'N'A'T versions", N);
end if;
end;
......@@ -9853,7 +9846,8 @@ package body Sem_Ch13 is
-- known statically, then we need the annotation.
if Known_Static_RM_Size (Source)
and then Known_Static_RM_Size (Target)
and then
Known_Static_RM_Size (Target)
then
null;
else
......@@ -9931,7 +9925,7 @@ package body Sem_Ch13 is
if Source_Siz /= Target_Siz then
Error_Msg
("?types for unchecked conversion have different sizes!",
("?Z?types for unchecked conversion have different sizes!",
Eloc);
if All_Errors_Mode then
......@@ -9939,7 +9933,7 @@ package body Sem_Ch13 is
Error_Msg_Uint_1 := Source_Siz;
Error_Msg_Name_2 := Chars (Target);
Error_Msg_Uint_2 := Target_Siz;
Error_Msg ("\size of % is ^, size of % is ^?", Eloc);
Error_Msg ("\size of % is ^, size of % is ^?Z?", Eloc);
Error_Msg_Uint_1 := UI_Abs (Source_Siz - Target_Siz);
......@@ -9949,44 +9943,41 @@ package body Sem_Ch13 is
then
if Source_Siz > Target_Siz then
Error_Msg
("\?^ high order bits of source will be ignored!",
Eloc);
("\?Z?^ high order bits of source will "
& "be ignored!", Eloc);
elsif Is_Unsigned_Type (Source) then
Error_Msg
("\?source will be extended with ^ high order " &
"zero bits?!", Eloc);
("\?Z?source will be extended with ^ high order "
& "zero bits?!", Eloc);
else
Error_Msg
("\?source will be extended with ^ high order " &
"sign bits!",
Eloc);
("\?Z?source will be extended with ^ high order "
& "sign bits!", Eloc);
end if;
elsif Source_Siz < Target_Siz then
if Is_Discrete_Type (Target) then
if Bytes_Big_Endian then
Error_Msg
("\?target value will include ^ undefined " &
"low order bits!",
Eloc);
("\?Z?target value will include ^ undefined "
& "low order bits!", Eloc);
else
Error_Msg
("\?target value will include ^ undefined " &
"high order bits!",
Eloc);
("\?Z?target value will include ^ undefined "
& "high order bits!", Eloc);
end if;
else
Error_Msg
("\?^ trailing bits of target value will be " &
"undefined!", Eloc);
("\?Z?^ trailing bits of target value will be "
& "undefined!", Eloc);
end if;
else pragma Assert (Source_Siz > Target_Siz);
Error_Msg
("\?^ trailing bits of source will be ignored!",
("\?Z?^ trailing bits of source will be ignored!",
Eloc);
end if;
end if;
......@@ -10039,11 +10030,11 @@ package body Sem_Ch13 is
Error_Msg_Node_1 := D_Target;
Error_Msg_Node_2 := D_Source;
Error_Msg
("?alignment of & (^) is stricter than " &
"alignment of & (^)!", Eloc);
("?Z?alignment of & (^) is stricter than "
& "alignment of & (^)!", Eloc);
Error_Msg
("\?resulting access value may have invalid " &
"alignment!", Eloc);
("\?Z?resulting access value may have invalid "
& "alignment!", Eloc);
end if;
end;
end if;
......
......@@ -261,7 +261,7 @@ package body Sem_Ch6 is
or else Scop /= Scope (Etype (First_Formal (Designator))))
then
Error_Msg_N
("?abstract subprogram is not dispatching or overriding", N);
("abstract subprogram is not dispatching or overriding?r?", N);
end if;
Generate_Reference_To_Formals (Designator);
......@@ -579,16 +579,16 @@ package body Sem_Ch6 is
if Inside_A_Generic then
Error_Msg_N
("return of limited object not permitted in Ada 2005 "
& "(RM-2005 6.5(5.5/2))?", Expr);
& "(RM-2005 6.5(5.5/2))?y?", Expr);
elsif Is_Immutably_Limited_Type (R_Type) then
Error_Msg_N
("return by reference not permitted in Ada 2005 "
& "(RM-2005 6.5(5.5/2))?", Expr);
& "(RM-2005 6.5(5.5/2))?y?", Expr);
else
Error_Msg_N
("cannot copy object of a limited type in Ada 2005 "
& "(RM-2005 6.5(5.5/2))?", Expr);
& "(RM-2005 6.5(5.5/2))?y?", Expr);
end if;
-- Ada 95 mode, compatibility warnings disabled
......@@ -847,7 +847,12 @@ package body Sem_Ch6 is
if Has_Aliased then
if Ada_Version < Ada_2012 then
Error_Msg_N ("aliased only allowed for limited"
-- Shouldn't this test Warn_On_Ada_2012_Compatibility ???
-- Can it really happen (extended return???)
Error_Msg_N
("aliased only allowed for limited"
& " return objects in Ada 2012?", N);
elsif not Is_Immutably_Limited_Type (R_Type) then
......@@ -937,7 +942,6 @@ package body Sem_Ch6 is
and then Object_Access_Level (Expr) >
Subprogram_Access_Level (Scope_Id)
then
-- Suppress the message in a generic, where the rewriting
-- is irrelevant.
......@@ -951,9 +955,9 @@ package body Sem_Ch6 is
Analyze (N);
Error_Msg_N
("cannot return a local value by reference?", N);
("cannot return a local value by reference??", N);
Error_Msg_NE
("\& will be raised at run time?",
("\& will be raised at run time??",
N, Standard_Program_Error);
end if;
end if;
......@@ -965,7 +969,7 @@ package body Sem_Ch6 is
Apply_Compile_Time_Constraint_Error
(N => Expr,
Msg => "(Ada 2005) null not allowed for "
& "null-excluding return?",
& "null-excluding return??",
Reason => CE_Null_Not_Allowed);
end if;
......@@ -4168,7 +4172,7 @@ package body Sem_Ch6 is
Error_Msg_NE (Msg (Msg'First .. Msg'Last - 1), N, Subp);
elsif Ineffective_Inline_Warnings then
Error_Msg_NE (Msg, N, Subp);
Error_Msg_NE (Msg & "p?", N, Subp);
end if;
return;
......@@ -4207,7 +4211,7 @@ package body Sem_Ch6 is
(Unit_File_Name (Get_Source_Unit (Gen_P)))
then
Set_Is_Inlined (Subp, False);
Error_Msg_NE (Msg, N, Subp);
Error_Msg_NE (Msg & "p?", N, Subp);
return;
end if;
end;
......@@ -4225,7 +4229,7 @@ package body Sem_Ch6 is
-- For backward compatibility we still report a warning.
if Ineffective_Inline_Warnings then
Error_Msg_NE (Msg, N, Subp);
Error_Msg_NE (Msg & "p?", N, Subp);
end if;
end if;
......@@ -6912,10 +6916,10 @@ package body Sem_Ch6 is
if Mode = 'F' then
if not Raise_Exception_Call then
Error_Msg_N
("??RETURN statement missing following this statement!",
("RETURN statement missing following this statement??!",
Last_Stm);
Error_Msg_N
("\??Program_Error may be raised at run time!",
("\Program_Error may be raised at run time??!",
Last_Stm);
end if;
......@@ -6931,11 +6935,11 @@ package body Sem_Ch6 is
else
if not Raise_Exception_Call then
Error_Msg_N
("?implied return after this statement " &
"will raise Program_Error",
("implied return after this statement " &
"will raise Program_Error??",
Last_Stm);
Error_Msg_NE
("\?procedure & is marked as No_Return!",
("\procedure & is marked as No_Return??!",
Last_Stm, Proc);
end if;
......@@ -7172,7 +7176,7 @@ package body Sem_Ch6 is
No_Warning_On_Some_Postcondition := True;
else
Error_Msg_N
("?`Ensures` component refers only to pre-state", Prag);
("`Ensures` component refers only to pre-state??", Prag);
end if;
end if;
......@@ -7229,7 +7233,7 @@ package body Sem_Ch6 is
No_Warning_On_Some_Postcondition := True;
else
Error_Msg_N
("?postcondition refers only to pre-state", Prag);
("postcondition refers only to pre-state??", Prag);
end if;
end if;
end if;
......@@ -7283,16 +7287,16 @@ package body Sem_Ch6 is
then
if Present (Last_Postcondition) then
if Present (Last_Contract_Case) then
Error_Msg_N ("?neither function postcondition nor " &
"contract cases do mention result",
Error_Msg_N ("neither function postcondition nor "
& "contract cases mention result??",
Last_Postcondition);
else
Error_Msg_N ("?function postcondition does not mention result",
Error_Msg_N ("function postcondition does not mention result??",
Last_Postcondition);
end if;
else
Error_Msg_N ("?contract cases do not mention result",
Error_Msg_N ("contract cases do not mention result??",
Last_Contract_Case);
end if;
end if;
......@@ -8143,14 +8147,14 @@ package body Sem_Ch6 is
then
if Scope (E) /= Standard_Standard then
Error_Msg_Sloc := Sloc (E);
Error_Msg_N ("declaration of & hides one#?", S);
Error_Msg_N ("declaration of & hides one#?h?", S);
elsif Nkind (S) = N_Defining_Operator_Symbol
and then
Scope (Base_Type (Etype (First_Formal (S)))) /= Scope (S)
then
Error_Msg_N
("declaration of & hides predefined operator?", S);
("declaration of & hides predefined operator?h?", S);
end if;
end if;
end loop;
......@@ -8199,17 +8203,15 @@ package body Sem_Ch6 is
& "before type& is frozen", Eq_Op, Typ);
Obj_Decl := Next (Parent (Typ));
while Present (Obj_Decl)
and then Obj_Decl /= Decl
loop
while Present (Obj_Decl) and then Obj_Decl /= Decl loop
if Nkind (Obj_Decl) = N_Object_Declaration
and then Etype (Defining_Identifier (Obj_Decl)) = Typ
then
Error_Msg_NE ("type& is frozen by declaration?",
Obj_Decl, Typ);
Error_Msg_NE
("type& is frozen by declaration??", Obj_Decl, Typ);
Error_Msg_N
("\an equality operator cannot be declared after this "
& "point (RM 4.5.2 (9.8)) (Ada 2012))?", Obj_Decl);
& "point (RM 4.5.2 (9.8)) (Ada 2012))??", Obj_Decl);
exit;
end if;
......@@ -9328,7 +9330,7 @@ package body Sem_Ch6 is
Error_Msg_Node_2 := F_Typ;
Error_Msg_NE
("private operation& in generic unit does not override " &
"any primitive operation of& (RM 12.3 (18))?",
"any primitive operation of& (RM 12.3 (18))??",
New_E, New_E);
end if;
......@@ -9350,24 +9352,22 @@ package body Sem_Ch6 is
and then (Is_Subprogram (E) or else Is_Generic_Subprogram (E))
then
declare
Inherited : constant Subprogram_List :=
Inherited_Subprograms (E);
Inherited : constant Subprogram_List := Inherited_Subprograms (E);
P : Node_Id;
begin
for J in Inherited'Range loop
P := Spec_PPC_List (Contract (Inherited (J)));
while Present (P) loop
Error_Msg_Sloc := Sloc (P);
if Class_Present (P) and then not Split_PPC (P) then
if Pragma_Name (P) = Name_Precondition then
Error_Msg_N
("?info: & inherits `Pre''Class` aspect from #", E);
("info: & inherits `Pre''Class` aspect from #?", E);
else
Error_Msg_N
("?info: & inherits `Post''Class` aspect from #", E);
("info: & inherits `Post''Class` aspect from #?", E);
end if;
end if;
......@@ -10659,7 +10659,7 @@ package body Sem_Ch6 is
and then No (F1)
and then No (F2)
then
Error_Msg_NE ("calls to& may be ambiguous?", S, S);
Error_Msg_NE ("calls to& may be ambiguous??", S, S);
end if;
end;
end if;
......@@ -11094,7 +11094,7 @@ package body Sem_Ch6 is
if Convention (Formal_Type) = Convention_Ada_Pass_By_Copy then
Error_Msg_N
("?cannot pass aliased parameter & by copy", Formal);
("cannot pass aliased parameter & by copy?", Formal);
end if;
-- Force mechanism if type has Convention Ada_Pass_By_Ref/Copy
......
......@@ -58,26 +58,30 @@ package Sem_Ch6 is
Is_Serious : Boolean := False);
-- This procedure is called if the node N, an instance of a call to
-- subprogram Subp, cannot be inlined. Msg is the message to be issued,
-- and has a ? as the last character. Temporarily the behavior of this
-- routine depends on the value of -gnatd.k:
-- which ends with ? (but not ?p?, this routine takes care of the need
-- to change ? to ?p?). Temporarily the behavior of this routine depends
-- on the value of -gnatd.k:
--
-- * If -gnatd.k is not set (ie. old inlining model) then if Subp has
-- a pragma Always_Inlined, then an error message is issued (by
-- removing the last character of Msg). If Subp is not Always_Inlined,
-- then a warning is issued if the flag Ineffective_Inline_Warnings
-- is set, and if not, the call has no effect.
--
-- * If -gnatd.k is set (ie. new inlining model) then:
-- - If Is_Serious is true, then an error is reported (by removing the
-- last character of Msg);
-- - otherwise:
--
-- * Compiling without optimizations if Subp has a pragma
-- Always_Inlined, then an error message is issued; if Subp is
-- not Always_Inlined, then a warning is issued if the flag
-- Ineffective_Inline_Warnings is set, and if not, the call
-- has no effect.
-- * Compiling with optimizations then a warning is issued if
-- the flag Ineffective_Inline_Warnings is set; otherwise the
-- call has no effect since inlining may be performed by the
-- backend.
--
-- * Compiling with optimizations then a warning is issued if the
-- flag Ineffective_Inline_Warnings is set; otherwise the call has
-- no effect since inlining may be performed by the backend.
procedure Check_Conventions (Typ : Entity_Id);
-- Ada 2005 (AI-430): Check that the conventions of all inherited and
......
......@@ -261,7 +261,7 @@ package body Sem_Ch7 is
then
if Ada_Version = Ada_83 then
Error_Msg_N
("optional package body (not allowed in Ada 95)?", N);
("optional package body (not allowed in Ada 95)??", N);
else
Error_Msg_N ("spec of this package does not allow a body", N);
end if;
......
......@@ -1017,13 +1017,13 @@ package body Sem_Ch8 is
and then Comes_From_Source (Nam)
then
Error_Msg_N
("?renaming function result object is suspicious", Nam);
("renaming function result object is suspicious?R?", Nam);
Error_Msg_NE
("\?function & will be called only once", Nam,
("\function & will be called only once?R?", Nam,
Entity (Name (Nam)));
Error_Msg_N -- CODEFIX
("\?suggest using an initialized constant object instead",
Nam);
("\suggest using an initialized constant "
& "object instead?R?", Nam);
end if;
end case;
......@@ -2289,10 +2289,10 @@ package body Sem_Ch8 is
and then Hidden /= Old_S
then
Error_Msg_Sloc := Sloc (Hidden);
Error_Msg_N ("?default subprogram is resolved " &
Error_Msg_N ("default subprogram is resolved " &
"in the generic declaration " &
"(RM 12.6(17))", N);
Error_Msg_NE ("\?and will not use & #", N, Hidden);
"(RM 12.6(17))??", N);
Error_Msg_NE ("\and will not use & #??", N, Hidden);
end if;
end;
end if;
......@@ -2942,7 +2942,7 @@ package body Sem_Ch8 is
and then Chars (Old_S) /= Chars (New_S)
then
Error_Msg_NE
("?& is being renamed as a different operator", N, Old_S);
("& is being renamed as a different operator??", N, Old_S);
end if;
-- Check for renaming of obsolescent subprogram
......@@ -2965,7 +2965,7 @@ package body Sem_Ch8 is
and then Chars (Current_Scope) /= Chars (Old_S)
then
Error_Msg_N
("?redundant renaming, entity is directly visible", Name (N));
("redundant renaming, entity is directly visible?r?", Name (N));
end if;
-- Implementation-defined aspect specifications can appear in a renaming
......@@ -3219,7 +3219,7 @@ package body Sem_Ch8 is
and then Pack = Current_Scope
then
Error_Msg_NE -- CODEFIX
("& is already use-visible within itself?", Pack_Name, Pack);
("& is already use-visible within itself?r?", Pack_Name, Pack);
end if;
return False;
......@@ -6015,7 +6015,8 @@ package body Sem_Ch8 is
then
-- Selected component of record. Type checking will validate
-- name of selector.
-- ??? could we rewrite an implicit dereference into an explicit
-- ??? Could we rewrite an implicit dereference into an explicit
-- one here?
Analyze_Selected_Component (N);
......@@ -6275,18 +6276,18 @@ package body Sem_Ch8 is
Set_Entity (N, Any_Type);
return;
-- ??? This test is temporarily disabled (always False)
-- because it causes an unwanted warning on GNAT sources
-- (built with -gnatg, which includes Warn_On_Obsolescent_
-- Feature). Once this issue is cleared in the sources, it
-- can be enabled.
-- ??? This test is temporarily disabled (always
-- False) because it causes an unwanted warning on
-- GNAT sources (built with -gnatg, which includes
-- Warn_On_Obsolescent_ Feature). Once this issue
-- is cleared in the sources, it can be enabled.
elsif Warn_On_Obsolescent_Feature
and then False
then
Error_Msg_N
("applying 'Class to an untagged incomplete type"
& " is an obsolescent feature (RM J.11)", N);
& " is an obsolescent feature (RM J.11)?r?", N);
end if;
end if;
......@@ -6379,7 +6380,7 @@ package body Sem_Ch8 is
and then Base_Type (Typ) = Typ
then
Error_Msg_NE -- CODEFIX
("?redundant attribute, & is its own base type", N, Typ);
("redundant attribute, & is its own base type?r?", N, Typ);
end if;
T := Base_Type (Typ);
......@@ -7248,7 +7249,7 @@ package body Sem_Ch8 is
if Present (Redundant) then
Error_Msg_Sloc := Sloc (Prev_Use);
Error_Msg_NE -- CODEFIX
("& is already use-visible through previous use clause #?",
("& is already use-visible through previous use clause #??",
Redundant, Pack_Name);
end if;
end Note_Redundant_Use;
......@@ -8362,14 +8363,14 @@ package body Sem_Ch8 is
Error_Msg_Sloc := Sloc (Current_Use_Clause (T));
Error_Msg_NE -- CODEFIX
("& is already use-visible through previous "
& "use_type_clause #?", Clause1, T);
& "use_type_clause #??", Clause1, T);
return;
elsif Nkind (Unit1) = N_Subunit then
Error_Msg_Sloc := Sloc (Current_Use_Clause (T));
Error_Msg_NE -- CODEFIX
("& is already use-visible through previous "
& "use_type_clause #?", Clause1, T);
& "use_type_clause #??", Clause1, T);
return;
elsif Nkind_In (Unit2, N_Package_Body, N_Subprogram_Body)
......@@ -8379,7 +8380,7 @@ package body Sem_Ch8 is
Error_Msg_Sloc := Sloc (Clause1);
Error_Msg_NE -- CODEFIX
("& is already use-visible through previous "
& "use_type_clause #?", Current_Use_Clause (T), T);
& "use_type_clause #??", Current_Use_Clause (T), T);
return;
end if;
......@@ -8431,7 +8432,7 @@ package body Sem_Ch8 is
Error_Msg_NE -- CODEFIX
("& is already use-visible through previous "
& "use_type_clause #?", Err_No, Id);
& "use_type_clause #??", Err_No, Id);
-- Case where current use type clause and the use type
-- clause for the type are not both at the compilation unit
......@@ -8440,7 +8441,7 @@ package body Sem_Ch8 is
else
Error_Msg_NE -- CODEFIX
("& is already use-visible through previous "
& "use type clause?", Id, T);
& "use type clause??", Id, T);
end if;
end Use_Clause_Known;
......@@ -8450,7 +8451,7 @@ package body Sem_Ch8 is
else
Error_Msg_NE -- CODEFIX
("& is already use-visible through previous "
& "use type clause?", Id, T);
& "use type clause??", Id, T);
end if;
-- The package where T is declared is already used
......@@ -8458,7 +8459,7 @@ package body Sem_Ch8 is
elsif In_Use (Scope (T)) then
Error_Msg_Sloc := Sloc (Current_Use_Clause (Scope (T)));
Error_Msg_NE -- CODEFIX
("& is already use-visible through package use clause #?",
("& is already use-visible through package use clause #??",
Id, T);
-- The current scope is the package where T is declared
......@@ -8466,7 +8467,7 @@ package body Sem_Ch8 is
else
Error_Msg_Node_2 := Scope (T);
Error_Msg_NE -- CODEFIX
("& is already use-visible inside package &?", Id, T);
("& is already use-visible inside package &??", Id, T);
end if;
end if;
end Use_One_Type;
......
......@@ -1062,9 +1062,9 @@ package body Sem_Ch9 is
and then Nkind (First (Else_Statements (N))) in N_Delay_Statement
then
Error_Msg_N
("suspicious form of conditional entry call?!", N);
("suspicious form of conditional entry call??!", N);
Error_Msg_N
("\`SELECT OR` may be intended rather than `SELECT ELSE`!", N);
("\`SELECT OR` may be intended rather than `SELECT ELSE`??!", N);
end if;
-- Postpone the analysis of the statements till expansion. Analyze only
......@@ -1987,11 +1987,11 @@ package body Sem_Ch9 is
if Error_Msg_Sloc = No_Location then
Error_Msg_N
("objects of this type will violate " &
"`No_Local_Protected_Objects`?", N);
"`No_Local_Protected_Objects`??", N);
else
Error_Msg_N
("objects of this type will violate " &
"`No_Local_Protected_Objects`?#", N);
"`No_Local_Protected_Objects`#??", N);
end if;
end if;
......@@ -2052,15 +2052,15 @@ package body Sem_Ch9 is
or else From_Aspect_Specification (Prio_Item)
then
Error_Msg_Name_1 := Chars (Identifier (Prio_Item));
Error_Msg_NE ("?aspect% for & has no effect when Lock_Free" &
" given", Prio_Item, Id);
Error_Msg_NE ("aspect% for & has no effect when Lock_Free" &
" given??", Prio_Item, Id);
-- Pragma case
else
Error_Msg_Name_1 := Pragma_Name (Prio_Item);
Error_Msg_NE ("?pragma% for & has no effect when Lock_Free" &
" given", Prio_Item, Id);
Error_Msg_NE ("pragma% for & has no effect when Lock_Free" &
" given??", Prio_Item, Id);
end if;
end if;
end;
......@@ -2089,16 +2089,16 @@ package body Sem_Ch9 is
or else From_Aspect_Specification (Prio_Item))
and then Chars (Identifier (Prio_Item)) = Name_Priority
then
Error_Msg_N ("?aspect Interrupt_Priority is preferred "
& "in presence of handlers", Prio_Item);
Error_Msg_N ("aspect Interrupt_Priority is preferred "
& "in presence of handlers??", Prio_Item);
-- Pragma case
elsif Nkind (Prio_Item) = N_Pragma
and then Pragma_Name (Prio_Item) = Name_Priority
then
Error_Msg_N ("?pragma Interrupt_Priority is preferred "
& "in presence of handlers", Prio_Item);
Error_Msg_N ("pragma Interrupt_Priority is preferred "
& "in presence of handlers??", Prio_Item);
end if;
end if;
end;
......@@ -2516,7 +2516,7 @@ package body Sem_Ch9 is
if Entity (EDN1) = Ent then
Error_Msg_Sloc := Sloc (Stm1);
Error_Msg_N
("?accept duplicates one on line#", Stm);
("accept duplicates one on line#??", Stm);
exit;
end if;
end if;
......@@ -2799,7 +2799,7 @@ package body Sem_Ch9 is
and then not Entry_Accepted (Ent)
and then Comes_From_Source (Ent)
then
Error_Msg_NE ("no accept for entry &?", N, Ent);
Error_Msg_NE ("no accept for entry &??", N, Ent);
end if;
Next_Entity (Ent);
......@@ -2923,10 +2923,10 @@ package body Sem_Ch9 is
if Error_Msg_Sloc = No_Location then
Error_Msg_N
("objects of this type will violate `No_Task_Hierarchy`?", N);
("objects of this type will violate `No_Task_Hierarchy`??", N);
else
Error_Msg_N
("objects of this type will violate `No_Task_Hierarchy`?#", N);
("objects of this type will violate `No_Task_Hierarchy`#??", N);
end if;
end if;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment