* [Ada] Further work on tags for warning messages
@ 2013-01-02 9:57 Arnaud Charlet
0 siblings, 0 replies; 2+ messages in thread
From: Arnaud Charlet @ 2013-01-02 9:57 UTC (permalink / raw)
To: gcc-patches; +Cc: Robert Dewar
[-- Attachment #1: Type: text/plain, Size: 628 bytes --]
This patch adds additional tags for warning messages.
Tested on x86_64-pc-linux-gnu, committed on trunk
2013-01-02 Robert Dewar <dewar@adacore.com>
* checks.adb, exp_ch4.adb, exp_ch6.adb, exp_ch7.adb, exp_ch9.adb,
exp_disp.adb, exp_dist.adb, exp_intr.adb, exp_prag.adb, exp_util.adb,
freeze.adb, gnat1drv.adb, inline.adb, layout.adb, lib-xref.adb,
par-ch10.adb, par-labl.adb, par-load.adb, par-util.adb, restrict.adb,
sem_ch13.adb, sem_ch4.adb, sem_ch6.adb, sem_dim.adb, sem_elab.adb,
sem_res.adb, sem_warn.adb, sinput-l.adb: Add tags to warning messages.
* sem_ch6.ads, warnsw.ads, opt.ads: Minor comment updates.
[-- Attachment #2: difs --]
[-- Type: text/plain, Size: 88127 bytes --]
Index: exp_prag.adb
===================================================================
--- exp_prag.adb (revision 194782)
+++ exp_prag.adb (working copy)
@@ -448,10 +448,12 @@
and then Entity (Original_Node (Cond)) = Standard_False
then
return;
+
elsif Nam = Name_Assertion then
- Error_Msg_N ("?assertion will fail at run time", N);
+ Error_Msg_N ("?A?assertion will fail at run time", N);
else
- Error_Msg_N ("?check will fail at run time", N);
+
+ Error_Msg_N ("?A?check will fail at run time", N);
end if;
end if;
end Expand_Pragma_Check;
Index: layout.adb
===================================================================
--- layout.adb (revision 194776)
+++ layout.adb (working copy)
@@ -2435,7 +2435,7 @@
Convention (E) = Convention_CPP)
then
Error_Msg_N
- ("?this access type does not correspond to C pointer", E);
+ ("?x?this access type does not correspond to C pointer", E);
end if;
-- If the designated type is a limited view it is unanalyzed. We can
@@ -2804,7 +2804,7 @@
begin
if Spec > Max then
Error_Msg_Uint_1 := Spec - Max;
- Error_Msg_NE ("?^ bits of & unused", SC, E);
+ Error_Msg_NE ("??^ bits of & unused", SC, E);
end if;
end Check_Unused_Bits;
@@ -2883,8 +2883,8 @@
and then not Is_Atomic (E)
then
if not Size_Known_At_Compile_Time (E) then
- Error_Msg_N ("Optimize_Alignment has no effect for &", E);
- Error_Msg_N ("\pragma is ignored for variable length record?", E);
+ Error_Msg_N ("Optimize_Alignment has no effect for &??", E);
+ Error_Msg_N ("\pragma is ignored for variable length record??", E);
else
Align := 1;
end if;
Index: exp_ch7.adb
===================================================================
--- exp_ch7.adb (revision 194776)
+++ exp_ch7.adb (working copy)
@@ -148,6 +148,7 @@
-- Set the field Node_To_Be_Wrapped of the current scope
-- ??? The entire comment needs to be rewritten
+ -- ??? which entire comment?
-----------------------------
-- Finalization Management --
@@ -3379,7 +3380,7 @@
-- with the array case and non-discriminated record cases.
Error_Msg_N
- ("task/protected object in variant record will not be freed?", N);
+ ("task/protected object in variant record will not be freed??", N);
return New_List (Make_Null_Statement (Loc));
end if;
Index: par-labl.adb
===================================================================
--- par-labl.adb (revision 194776)
+++ par-labl.adb (working copy)
@@ -81,6 +81,7 @@
-- Note that in the worst case, this is quadratic in the number
-- of labels. However, labels are not all that common, and this
-- is only called for explicit labels.
+
-- ???Nonetheless, the efficiency could be improved. For example,
-- call Labl for each body, rather than once per compilation.
@@ -356,7 +357,7 @@
Remove (Loop_Header);
Rewrite (Loop_End, Loop_Stmt);
Error_Msg_N
- ("info: code between label and backwards goto rewritten as loop?",
+ ("info: code between label and backwards goto rewritten as loop??",
Loop_End);
end Rewrite_As_Loop;
Index: exp_util.adb
===================================================================
--- exp_util.adb (revision 194786)
+++ exp_util.adb (working copy)
@@ -225,10 +225,10 @@
if Present (Msg_Node) then
Error_Msg_N
- ("?n?info: atomic synchronization set for &", Msg_Node);
+ ("?N?info: atomic synchronization set for &", Msg_Node);
else
Error_Msg_N
- ("?n?info: atomic synchronization set", N);
+ ("?N?info: atomic synchronization set", N);
end if;
end if;
end Activate_Atomic_Synchronization;
@@ -5127,7 +5127,7 @@
if W then
Error_Msg_F
- ("??this code can never be executed and has been deleted!",
+ ("?t?this code can never be executed and has been deleted!",
N);
end if;
end if;
Index: exp_ch9.adb
===================================================================
--- exp_ch9.adb (revision 194776)
+++ exp_ch9.adb (working copy)
@@ -8812,9 +8812,7 @@
if Present (Private_Declarations (Pdef)) then
Priv := First (Private_Declarations (Pdef));
-
while Present (Priv) loop
-
if Nkind (Priv) = N_Component_Declaration then
if not Static_Component_Size (Defining_Identifier (Priv)) then
@@ -8827,10 +8825,10 @@
Check_Restriction (No_Implicit_Heap_Allocations, Priv);
elsif Restriction_Active (No_Implicit_Heap_Allocations) then
- Error_Msg_N ("component has non-static size?", Priv);
+ Error_Msg_N ("component has non-static size??", Priv);
Error_Msg_NE
("\creation of protected object of type& will violate"
- & " restriction No_Implicit_Heap_Allocations?",
+ & " restriction No_Implicit_Heap_Allocations??",
Priv, Prot_Typ);
end if;
end if;
Index: inline.adb
===================================================================
--- inline.adb (revision 194776)
+++ inline.adb (working copy)
@@ -699,11 +699,11 @@
Error_Msg_Unit_1 := Bname;
Error_Msg_N
- ("one or more inlined subprograms accessed in $!?",
+ ("one or more inlined subprograms accessed in $!??",
Comp_Unit);
Error_Msg_File_1 :=
Get_File_Name (Bname, Subunit => False);
- Error_Msg_N ("\but file{ was not found!?", Comp_Unit);
+ Error_Msg_N ("\but file{ was not found!??", Comp_Unit);
else
-- If the package to be inlined is an ancestor unit of
@@ -882,11 +882,11 @@
then
Error_Msg_Node_2 := Child_Spec;
Error_Msg_NE
- ("body of & depends on child unit&?",
- With_Clause, P);
+ ("body of & depends on child unit&??",
+ With_Clause, P);
Error_Msg_N
- ("\subprograms in body cannot be inlined?",
- With_Clause);
+ ("\subprograms in body cannot be inlined??",
+ With_Clause);
-- Disable further inlining from this unit,
-- and keep Taft-amendment types incomplete.
@@ -916,8 +916,8 @@
elsif Ineffective_Inline_Warnings then
Error_Msg_Unit_1 := Bname;
Error_Msg_N
- ("unable to inline subprograms defined in $?", P);
- Error_Msg_N ("\body not found?", P);
+ ("unable to inline subprograms defined in $??", P);
+ Error_Msg_N ("\body not found??", P);
return;
end if;
end if;
Index: sem_dim.adb
===================================================================
--- sem_dim.adb (revision 194776)
+++ sem_dim.adb (working copy)
@@ -2451,7 +2451,7 @@
Add_String_To_Name_Buffer (Symbol_Of (Typ));
Error_Msg_Name_1 := Name_Find;
- Error_Msg_N ("?assumed to be%%", N);
+ Error_Msg_N ("??assumed to be%%", N);
end Dim_Warning_For_Numeric_Literal;
----------------------------------------
Index: checks.adb
===================================================================
--- checks.adb (revision 194776)
+++ checks.adb (working copy)
@@ -599,10 +599,10 @@
begin
if Address_Clause_Overlay_Warnings then
Error_Msg_FE
- ("?specified address for& may be inconsistent with alignment ",
+ ("?o?specified address for& may be inconsistent with alignment",
Aexp, E);
Error_Msg_FE
- ("\?program execution may be erroneous (RM 13.3(27))",
+ ("\?o?program execution may be erroneous (RM 13.3(27))",
Aexp, E);
Set_Address_Warning_Posted (AC);
end if;
@@ -1624,7 +1624,7 @@
exit;
else
Apply_Compile_Time_Constraint_Error
- (N, "incorrect value for discriminant&?",
+ (N, "incorrect value for discriminant&??",
CE_Discriminant_Check_Failed, Ent => Discr);
return;
end if;
@@ -2467,9 +2467,9 @@
elsif S = Predicate_Function (Typ) then
Error_Msg_N
("predicate check includes a function call that "
- & "requires a predicate check?", Parent (N));
+ & "requires a predicate check??", Parent (N));
Error_Msg_N
- ("\this will result in infinite recursion?", Parent (N));
+ ("\this will result in infinite recursion??", Parent (N));
Insert_Action (N,
Make_Raise_Storage_Error (Sloc (N),
Reason => SE_Infinite_Recursion));
@@ -2558,7 +2558,7 @@
procedure Bad_Value is
begin
Apply_Compile_Time_Constraint_Error
- (Expr, "value not in range of}?", CE_Range_Check_Failed,
+ (Expr, "value not in range of}??", CE_Range_Check_Failed,
Ent => Target_Typ,
Typ => Target_Typ);
end Bad_Value;
@@ -2904,7 +2904,7 @@
and then Entity (Cond) = Standard_True
then
Apply_Compile_Time_Constraint_Error
- (Ck_Node, "wrong length for array of}?",
+ (Ck_Node, "wrong length for array of}??",
CE_Length_Check_Failed,
Ent => Target_Typ,
Typ => Target_Typ);
@@ -2984,7 +2984,7 @@
if Nkind (Ck_Node) = N_Range then
Apply_Compile_Time_Constraint_Error
- (Low_Bound (Ck_Node), "static range out of bounds of}?",
+ (Low_Bound (Ck_Node), "static range out of bounds of}??",
CE_Range_Check_Failed,
Ent => Target_Typ,
Typ => Target_Typ);
@@ -3539,11 +3539,11 @@
case Check is
when Access_Check =>
Error_Msg_N
- ("Constraint_Error may be raised (access check)?",
+ ("Constraint_Error may be raised (access check)??",
Parent (Nod));
when Division_Check =>
Error_Msg_N
- ("Constraint_Error may be raised (zero divide)?",
+ ("Constraint_Error may be raised (zero divide)??",
Parent (Nod));
when others =>
@@ -3552,10 +3552,10 @@
if K = N_Op_And then
Error_Msg_N -- CODEFIX
- ("use `AND THEN` instead of AND?", P);
+ ("use `AND THEN` instead of AND??", P);
else
Error_Msg_N -- CODEFIX
- ("use `OR ELSE` instead of OR?", P);
+ ("use `OR ELSE` instead of OR??", P);
end if;
-- If not short-circuited, we need the check
@@ -3694,7 +3694,8 @@
Apply_Compile_Time_Constraint_Error
(N => Expression (N),
- Msg => "(Ada 2005) null-excluding objects must be initialized?",
+ Msg =>
+ "(Ada 2005) null-excluding objects must be initialized??",
Reason => CE_Null_Not_Allowed);
end if;
@@ -3712,7 +3713,7 @@
Apply_Compile_Time_Constraint_Error
(N => Expr,
Msg => "(Ada 2005) null not allowed " &
- "in null-excluding components?",
+ "in null-excluding components??",
Reason => CE_Null_Not_Allowed);
when N_Object_Declaration =>
@@ -3726,7 +3727,7 @@
Apply_Compile_Time_Constraint_Error
(N => Expr,
Msg => "(Ada 2005) null not allowed " &
- "in null-excluding formals?",
+ "in null-excluding formals??",
Reason => CE_Null_Not_Allowed);
when others =>
@@ -6466,7 +6467,7 @@
if not Inside_Init_Proc then
Apply_Compile_Time_Constraint_Error
(N,
- "null value not allowed here?",
+ "null value not allowed here??",
CE_Access_Check_Failed);
else
Insert_Action (N,
@@ -8251,12 +8252,12 @@
if L_Length > R_Length then
Add_Check
(Compile_Time_Constraint_Error
- (Wnode, "too few elements for}?", T_Typ));
+ (Wnode, "too few elements for}??", T_Typ));
elsif L_Length < R_Length then
Add_Check
(Compile_Time_Constraint_Error
- (Wnode, "too many elements for}?", T_Typ));
+ (Wnode, "too many elements for}??", T_Typ));
end if;
-- The comparison for an individual index subtype
@@ -8802,13 +8803,13 @@
Add_Check
(Compile_Time_Constraint_Error
(Low_Bound (Ck_Node),
- "static value out of range of}?", T_Typ));
+ "static value out of range of}??", T_Typ));
else
Add_Check
(Compile_Time_Constraint_Error
(Wnode,
- "static range out of bounds of}?", T_Typ));
+ "static range out of bounds of}??", T_Typ));
end if;
end if;
@@ -8817,13 +8818,13 @@
Add_Check
(Compile_Time_Constraint_Error
(High_Bound (Ck_Node),
- "static value out of range of}?", T_Typ));
+ "static value out of range of}??", T_Typ));
else
Add_Check
(Compile_Time_Constraint_Error
(Wnode,
- "static range out of bounds of}?", T_Typ));
+ "static range out of bounds of}??", T_Typ));
end if;
end if;
end if;
@@ -8944,13 +8945,13 @@
Add_Check
(Compile_Time_Constraint_Error
(Ck_Node,
- "static value out of range of}?", T_Typ));
+ "static value out of range of}??", T_Typ));
else
Add_Check
(Compile_Time_Constraint_Error
(Wnode,
- "static value out of range of}?", T_Typ));
+ "static value out of range of}??", T_Typ));
end if;
end if;
@@ -9132,7 +9133,7 @@
then
Add_Check
(Compile_Time_Constraint_Error
- (Wnode, "value out of range of}?", T_Typ));
+ (Wnode, "value out of range of}??", T_Typ));
else
Evolve_Or_Else
Index: freeze.adb
===================================================================
--- freeze.adb (revision 194776)
+++ freeze.adb (working copy)
@@ -1817,6 +1817,10 @@
Decl : constant Node_Id := Declaration_Node (Underlying_Type (Utype));
begin
+ if not Warn_On_Suspicious_Modulus_Value then
+ return;
+ end if;
+
if Nkind (Decl) = N_Full_Type_Declaration then
declare
Tdef : constant Node_Id := Type_Definition (Decl);
@@ -1826,6 +1830,7 @@
declare
Modulus : constant Node_Id :=
Original_Node (Expression (Tdef));
+
begin
if Nkind (Modulus) = N_Integer_Literal then
declare
@@ -1870,7 +1875,7 @@
Error_Msg_Uint_1 := Modv;
Error_Msg_N
- ("?2 '*'*^' may have been intended here",
+ ("?M?2 '*'*^' may have been intended here",
Modulus);
end;
end if;
@@ -2285,7 +2290,7 @@
if not (Placed_Component or else Is_Packed (Rec)) then
Error_Msg_N
- ("?scalar storage order specified but no component clause",
+ ("??scalar storage order specified but no component clause",
ADC);
end if;
@@ -2304,9 +2309,9 @@
if Present (ADC) and then Base_Type (Rec) = Rec then
if not (Placed_Component or else Is_Packed (Rec)) then
- 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);
+ ("\??since no component clauses were specified", ADC);
-- Here is where we do the processing for reversed bit order
@@ -2371,7 +2376,7 @@
if Warn_On_Redundant_Constructs then
Error_Msg_N -- CODEFIX
- ("?pragma Pack has no effect, no unplaced components",
+ ("??pragma Pack has no effect, no unplaced components",
Get_Rep_Pragma (Rec, Name_Pack));
end if;
end if;
@@ -2478,14 +2483,16 @@
if Convention (E) = Convention_C then
Error_Msg_N
- ("?variant record has no direct equivalent in C", A2);
+ ("?x?variant record has no direct equivalent in C",
+ A2);
else
Error_Msg_N
- ("?variant record has no direct equivalent in C++", A2);
+ ("?x?variant record has no direct equivalent in C++",
+ A2);
end if;
Error_Msg_NE
- ("\?use of convention for type& is dubious", A2, E);
+ ("\?x?use of convention for type& is dubious", A2, E);
end if;
end;
end if;
@@ -2689,6 +2696,7 @@
-- Case of entity being frozen is other than a type
if not Is_Type (E) then
+
-- If entity is exported or imported and does not have an external
-- name, now is the time to provide the appropriate default name.
-- Skip this if the entity is stubbed, since we don't need a name
@@ -2805,7 +2813,7 @@
and then Esize (F_Type) > Ttypes.System_Address_Size
then
Error_Msg_N
- ("?type of & does not correspond to C pointer!",
+ ("?x?type of & does not correspond to C pointer!",
Formal);
-- Check suspicious return of boolean
@@ -2816,10 +2824,11 @@
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?x?", Formal);
+ Error_Msg_N
("\use appropriate corresponding type in C "
- & "(e.g. char)?", Formal);
+ & "(e.g. char)?x?", Formal);
-- Check suspicious tagged type
@@ -2831,7 +2840,7 @@
and then Convention (E) = Convention_C
then
Error_Msg_N
- ("?& involves a tagged type which does not "
+ ("?x?& involves a tagged type which does not "
& "correspond to any C type!", Formal);
-- Check wrong convention subprogram pointer
@@ -2840,11 +2849,11 @@
and then not Has_Foreign_Convention (F_Type)
then
Error_Msg_N
- ("?subprogram pointer & should "
+ ("?x?subprogram pointer & should "
& "have foreign convention!", Formal);
Error_Msg_Sloc := Sloc (F_Type);
Error_Msg_NE
- ("\?add Convention pragma to declaration of &#",
+ ("\?x?add Convention pragma to declaration of &#",
Formal, F_Type);
end if;
@@ -2880,17 +2889,17 @@
if Formal = First_Formal (E) then
Error_Msg_NE
- ("?in inherited operation&", Warn_Node, E);
+ ("??in inherited operation&", Warn_Node, E);
end if;
else
Warn_Node := Formal;
end if;
Error_Msg_NE
- ("?type of argument& is unconstrained array",
+ ("?x?type of argument& is unconstrained array",
Warn_Node, Formal);
Error_Msg_NE
- ("?foreign caller must pass bounds explicitly",
+ ("?x?foreign caller must pass bounds explicitly",
Warn_Node, Formal);
Error_Msg_Qual_Level := 0;
end if;
@@ -2951,7 +2960,7 @@
and then not Has_Warnings_Off (R_Type)
then
Error_Msg_N
- ("?return type of& does not "
+ ("?x?return type of& does not "
& "correspond to C pointer!", E);
-- Check suspicious return of boolean
@@ -2968,11 +2977,11 @@
Result_Definition (Declaration_Node (E));
begin
Error_Msg_NE
- ("return type of & is an 8-bit Ada Boolean?",
+ ("return type of & is an 8-bit Ada Boolean?x?",
N, E);
Error_Msg_NE
("\use appropriate corresponding type in C "
- & "(e.g. char)?", N, E);
+ & "(e.g. char)?x?", N, E);
end;
-- Check suspicious return tagged type
@@ -2987,7 +2996,7 @@
and then not Has_Warnings_Off (R_Type)
then
Error_Msg_N
- ("?return type of & does not "
+ ("?x?return type of & does not "
& "correspond to C type!", E);
-- Check return of wrong convention subprogram pointer
@@ -2998,11 +3007,11 @@
and then not Has_Warnings_Off (R_Type)
then
Error_Msg_N
- ("?& should return a foreign "
+ ("?x?& should return a foreign "
& "convention subprogram pointer", E);
Error_Msg_Sloc := Sloc (R_Type);
Error_Msg_NE
- ("\?add Convention pragma to declaration of& #",
+ ("\?x?add Convention pragma to declaration of& #",
E, R_Type);
end if;
end if;
@@ -3037,7 +3046,7 @@
and then not Has_Warnings_Off (R_Type)
then
Error_Msg_N
- ("?foreign convention function& should not " &
+ ("?x?foreign convention function& should not " &
"return unconstrained array!", E);
end if;
end if;
@@ -3054,9 +3063,9 @@
and then Present (Contract (E))
and then Present (Spec_PPC_List (Contract (E)))
then
- Error_Msg_NE ("pre/post conditions on imported subprogram "
- & "are not enforced?",
- E, Spec_PPC_List (Contract (E)));
+ Error_Msg_NE
+ ("pre/post conditions on imported subprogram "
+ & "are not enforced??", E, Spec_PPC_List (Contract (E)));
end if;
end if;
@@ -3218,7 +3227,7 @@
then
Error_Msg_Uint_1 := UI_From_Int (Standard_Integer_Size);
Error_Msg_N
- ("?convention C enumeration object has size less than ^",
+ ("??convention C enumeration object has size less than ^",
E);
Error_Msg_N ("\?use explicit size clause to set size", E);
end if;
@@ -3595,10 +3604,10 @@
then
Error_Msg_Sloc := Sloc (Comp_Size_C);
Error_Msg_NE
- ("?pragma Pack for& ignored!",
+ ("?r?pragma Pack for& ignored!",
Pack_Pragma, Ent);
Error_Msg_N
- ("\?explicit component size given#!",
+ ("\?r?explicit component size given#!",
Pack_Pragma);
Set_Is_Packed (Base_Type (Ent), False);
Set_Is_Bit_Packed_Array (Base_Type (Ent), False);
@@ -3628,10 +3637,10 @@
if Present (Pack_Pragma) then
Error_Msg_N
- ("?pragma Pack causes component size "
+ ("??pragma Pack causes component size "
& "to be ^!", Pack_Pragma);
Error_Msg_N
- ("\?use Component_Size to set "
+ ("\??use Component_Size to set "
& "desired value!", Pack_Pragma);
end if;
end if;
@@ -3784,7 +3793,7 @@
then
Error_Msg_NE
("non-atomic components of type& may not be "
- & "accessible by separate tasks?", Clause, E);
+ & "accessible by separate tasks??", Clause, E);
if Has_Component_Size_Clause (E) then
Error_Msg_Sloc :=
@@ -3792,14 +3801,14 @@
(Get_Attribute_Definition_Clause
(FS, Attribute_Component_Size));
Error_Msg_N
- ("\because of component size clause#?",
+ ("\because of component size clause#??",
Clause);
elsif Has_Pragma_Pack (E) then
Error_Msg_Sloc :=
Sloc (Get_Rep_Pragma (FS, Name_Pack));
Error_Msg_N
- ("\because of pragma Pack#?", Clause);
+ ("\because of pragma Pack#??", Clause);
end if;
end if;
@@ -4273,16 +4282,16 @@
if Ada_Version >= Ada_2005 then
Error_Msg_N
- ("\would be legal if Storage_Size of 0 given?", E);
+ ("\would be legal if Storage_Size of 0 given??", E);
elsif No_Pool_Assigned (E) then
Error_Msg_N
- ("\would be legal in Ada 2005?", E);
+ ("\would be legal in Ada 2005??", E);
else
Error_Msg_N
("\would be legal in Ada 2005 if "
- & "Storage_Size of 0 given?", E);
+ & "Storage_Size of 0 given??", E);
end if;
end if;
end if;
@@ -4839,7 +4848,7 @@
and then not Is_Character_Type (Typ)
then
Error_Msg_N
- ("C enum types have the size of a C int?", Size_Clause (Typ));
+ ("C enum types have the size of a C int??", Size_Clause (Typ));
end if;
Adjust_Esize_For_Alignment (Typ);
@@ -6081,7 +6090,7 @@
and then Warn_On_Export_Import
then
Error_Msg_N
- ("?Valued_Procedure has no effect for convention Ada", E);
+ ("??Valued_Procedure has no effect for convention Ada", E);
Set_Is_Valued_Procedure (E, False);
end if;
@@ -6133,7 +6142,7 @@
and then VM_Target = No_VM
then
Error_Msg_N
- ("?foreign convention function& should not return " &
+ ("?x?foreign convention function& should not return " &
"unconstrained array", E);
return;
end if;
@@ -6150,7 +6159,7 @@
and then Present (Default_Value (F))
then
Error_Msg_N
- ("?parameter cannot be defaulted in non-Ada call",
+ ("?x?parameter cannot be defaulted in non-Ada call",
Default_Value (F));
end if;
@@ -6575,11 +6584,11 @@
if Present (Old) then
Error_Msg_Node_2 := Old;
Error_Msg_N
- ("default initialization of & may modify &?",
+ ("default initialization of & may modify &??",
Nam);
else
Error_Msg_N
- ("default initialization of & may modify overlaid storage?",
+ ("default initialization of & may modify overlaid storage??",
Nam);
end if;
@@ -6602,7 +6611,7 @@
then
Error_Msg_NE
("\packed array component& " &
- "will be initialized to zero?",
+ "will be initialized to zero??",
Nam, Comp);
exit;
else
@@ -6614,7 +6623,7 @@
Error_Msg_N
("\use pragma Import for & to " &
- "suppress initialization (RM B.1(24))?",
+ "suppress initialization (RM B.1(24))??",
Nam);
end if;
end Warn_Overlay;
Index: sem_res.adb
===================================================================
--- sem_res.adb (revision 194786)
+++ sem_res.adb (working copy)
@@ -8891,7 +8891,7 @@
-- of the First_Node call here.
Error_Msg_F
- ("??assertion would fail at run time!",
+ ("?A?assertion would fail at run time!",
Expression
(First (Pragma_Argument_Associations (Orig))));
end if;
@@ -8922,7 +8922,7 @@
-- comment above for an explanation of why we do this.
Error_Msg_F
- ("??check would fail at run time!",
+ ("?A?check would fail at run time!",
Expression
(Last (Pragma_Argument_Associations (Orig))));
end if;
Index: warnsw.ads
===================================================================
--- warnsw.ads (revision 194776)
+++ warnsw.ads (working copy)
@@ -44,12 +44,13 @@
Warn_On_Overridden_Size : Boolean := False;
-- Warn when explicit record component clause or array component_size
-- clause specifies a size that overrides a size for the typen which was
- -- set with an explicit size clause. Off by default, set by -gnatw.s (but
- -- not -gnatwa).
+ -- set with an explicit size clause. Off by default, modified by use of
+ -- -gnatw.s/.S, but not set by -gnatwa.
Warn_On_Standard_Redefinition : Boolean := False;
-- Warn when a program defines an identifier that matches a name in
- -- Standard. Off by default, set by -gnatw.k (and also by -gnatwa).
+ -- Standard. Off by default, modified by use of -gnatw.k/.K, but not
+ -- affected by -gnatwa.
-----------------
-- Subprograms --
Index: gnat1drv.adb
===================================================================
--- gnat1drv.adb (revision 194776)
+++ gnat1drv.adb (working copy)
@@ -677,9 +677,9 @@
and then not Compilation_Errors
then
Error_Msg_N
- ("package $$ does not require a body?", Main_Unit_Node);
+ ("package $$ does not require a body??", Main_Unit_Node);
Error_Msg_File_1 := Fname;
- Error_Msg_N ("body in file{? will be ignored", Main_Unit_Node);
+ Error_Msg_N ("body in file{ will be ignored??", Main_Unit_Node);
-- Ada 95 cases of a body file present when no body is
-- permitted. This we consider to be an error.
Index: sinput-l.adb
===================================================================
--- sinput-l.adb (revision 194776)
+++ sinput-l.adb (working copy)
@@ -668,7 +668,7 @@
if not Status then
Errout.Error_Msg
- ("?could not write processed file """ &
+ ("??could not write processed file """ &
Name_Buffer (1 .. Name_Len) & '"',
Lo);
end if;
Index: par-load.adb
===================================================================
--- par-load.adb (revision 194776)
+++ par-load.adb (working copy)
@@ -172,7 +172,7 @@
then
Error_Msg_File_1 := File_Name;
Error_Msg
- ("?file name does not match unit name, should be{", Sloc (Curunit));
+ ("??file name does not match unit name, should be{", Sloc (Curunit));
end if;
-- For units other than the main unit, the expected unit name is set and
Index: sem_elab.adb
===================================================================
--- sem_elab.adb (revision 194786)
+++ sem_elab.adb (working copy)
@@ -1030,7 +1030,7 @@
Error_Msg_Node_2 := W_Scope;
Error_Msg_NE
("call to& in elaboration code " &
- "requires pragma Elaborate_All on&??", N, E);
+ "requires pragma Elaborate_All on&?l?", N, E);
end if;
-- Set indication for binder to generate Elaborate_All
@@ -2506,7 +2506,7 @@
Error_Msg_Node_2 := Task_Scope;
Error_Msg_NE
("activation of an instance of task type&" &
- " requires pragma Elaborate_All on &??", N, Ent);
+ " requires pragma Elaborate_All on &?l?", N, Ent);
end if;
Activate_Elaborate_All_Desirable (N, Task_Scope);
Index: exp_ch4.adb
===================================================================
--- exp_ch4.adb (revision 194786)
+++ exp_ch4.adb (working copy)
@@ -5685,8 +5685,8 @@
if Lcheck = LT or else Ucheck = GT then
if Warn1 then
- Error_Msg_N ("??range test optimized away", N);
- Error_Msg_N ("\??value is known to be out of range", N);
+ Error_Msg_N ("?c?range test optimized away", N);
+ Error_Msg_N ("\?c?value is known to be out of range", N);
end if;
Rewrite (N, New_Reference_To (Standard_False, Loc));
@@ -5699,8 +5699,8 @@
elsif Lcheck in Compare_GE and then Ucheck in Compare_LE then
if Warn1 then
- Error_Msg_N ("??range test optimized away", N);
- Error_Msg_N ("\??value is known to be in range", N);
+ Error_Msg_N ("?c?range test optimized away", N);
+ Error_Msg_N ("\?c?value is known to be in range", N);
end if;
Rewrite (N, New_Reference_To (Standard_True, Loc));
@@ -5756,25 +5756,25 @@
if Lcheck = LT or else Ucheck = GT then
Error_Msg_N
- ("??value can only be in range if it is invalid", N);
+ ("?c?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
- ("??value can only be out of range if it is invalid", N);
+ ("?c?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
- ("??lower bound check only fails if it is invalid", Lo);
+ ("?c?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
- ("??upper bound check only fails for invalid values", Hi);
+ ("?c?upper bound check only fails for invalid values", Hi);
end if;
end if;
end;
Index: exp_ch6.adb
===================================================================
--- exp_ch6.adb (revision 194776)
+++ exp_ch6.adb (working copy)
@@ -1450,7 +1450,7 @@
and then Is_Valued_Procedure (Scope (Formal))
then
Error_Msg_N
- ("by_reference actual may be misaligned?", Actual);
+ ("by_reference actual may be misaligned??", Actual);
return False;
else
@@ -1527,8 +1527,9 @@
and then In_Open_Scopes (Entity (Actual))
then
if Scope (Subp) /= Entity (Actual) then
- Error_Msg_N ("operation outside protected type may not "
- & "call back its protected operations?", Actual);
+ Error_Msg_N
+ ("operation outside protected type may not "
+ & "call back its protected operations??", Actual);
end if;
Rewrite (Actual,
@@ -2002,8 +2003,7 @@
(Loc, Sloc (Body_To_Inline (Spec)))
then
Error_Msg_NE
- ("cannot inline& (body not seen yet)?",
- Call_Node, Subp);
+ ("cannot inline& (body not seen yet)??", Call_Node, Subp);
else
declare
@@ -2122,7 +2122,7 @@
if not In_Same_Extended_Unit (Call_Node, Subp) then
Cannot_Inline
- ("cannot inline& (body not seen yet)", Call_Node, Subp,
+ ("cannot inline& (body not seen yet)?", Call_Node, Subp,
Is_Serious => True);
elsif In_Open_Scopes (Subp) then
@@ -2136,7 +2136,7 @@
and then Optimization_Level = 0
then
Error_Msg_N
- ("call to recursive subprogram cannot be inlined?",
+ ("call to recursive subprogram cannot be inlined?p?",
N);
-- Do not emit error compiling runtime packages
@@ -2145,7 +2145,7 @@
(Unit_File_Name (Get_Source_Unit (Subp)))
then
Error_Msg_N
- ("call to recursive subprogram cannot be inlined?",
+ ("call to recursive subprogram cannot be inlined??",
N);
else
@@ -3790,7 +3790,8 @@
and then In_Same_Extended_Unit (Sloc (Spec), Loc)
then
Cannot_Inline
- ("cannot inline& (body not seen yet)?", Call_Node, Subp);
+ ("cannot inline& (body not seen yet)?",
+ Call_Node, Subp);
end if;
end if;
end Inlined_Subprogram;
@@ -4644,7 +4645,7 @@
-- subprograms this must be done explicitly.
if In_Open_Scopes (Subp) then
- Error_Msg_N ("call to recursive subprogram cannot be inlined?", N);
+ Error_Msg_N ("call to recursive subprogram cannot be inlined??", N);
Set_Is_Inlined (Subp, False);
return;
Index: sem_ch4.adb
===================================================================
--- sem_ch4.adb (revision 194786)
+++ sem_ch4.adb (working copy)
@@ -635,10 +635,9 @@
Insert_Action (N, Not_Null_Check);
Analyze (Not_Null_Check);
- else
- -- Seems weird for the following to be a warning ???
-
- Error_Msg_N ("null value not allowed here??", E);
+ elsif Warn_On_Ada_2012_Compatibility then
+ Error_Msg_N
+ ("null value not allowed here in Ada 2012?y?", E);
end if;
end;
end if;
Index: restrict.adb
===================================================================
--- restrict.adb (revision 194782)
+++ restrict.adb (working copy)
@@ -582,7 +582,7 @@
if No_Dependences.Table (J).Warn then
Error_Msg
- ("?violation of restriction `No_Dependence '='> &`#",
+ ("??violation of restriction `No_Dependence '='> &`#",
Sloc (Err));
else
Error_Msg
@@ -798,9 +798,9 @@
if Warn_On_Obsolescent_Feature then
Error_Msg_Name_1 := Old_Name;
- Error_Msg_N ("restriction identifier % is obsolescent?", N);
+ Error_Msg_N ("restriction identifier % is obsolescent?j?", N);
Error_Msg_Name_1 := New_Name;
- Error_Msg_N ("|use restriction identifier % instead", N);
+ Error_Msg_N ("|use restriction identifier % instead?j?", N);
end if;
return New_Name;
@@ -951,7 +951,7 @@
-- Set warning message if warning
if Restriction_Warnings (R) then
- Add_Char ('?');
+ Add_Str ("??");
-- If real violation (not warning), then mark it as non-serious unless
-- it is a violation of No_Finalization in which case we leave it as a
@@ -1012,7 +1012,7 @@
-- Set as warning if warning case
if Restriction_Warnings (R) then
- Add_Char ('?');
+ Add_Str ("??");
end if;
-- Set main message
Index: par-ch10.adb
===================================================================
--- par-ch10.adb (revision 194776)
+++ par-ch10.adb (working copy)
@@ -314,8 +314,9 @@
-- Do not complain if there is a pragma No_Body
if not No_Body then
- Error_Msg_SC ("?file contains no compilation units");
+ Error_Msg_SC ("??file contains no compilation units");
end if;
+
else
Error_Msg_SC ("compilation unit expected");
Cunit_Error_Flag := True;
Index: sem_ch6.adb
===================================================================
--- sem_ch6.adb (revision 194785)
+++ sem_ch6.adb (working copy)
@@ -3788,6 +3788,7 @@
if Has_Excluded_Statement (Then_Statements (E)) then
return True;
end if;
+
Next (E);
end loop;
end if;
@@ -3975,7 +3976,7 @@
then
Cannot_Inline
("cannot inline & (call returns unconstrained type)?",
- N, Subp);
+ N, Subp);
return Abandon;
else
return OK;
@@ -7287,17 +7288,18 @@
then
if Present (Last_Postcondition) then
if Present (Last_Contract_Case) then
- Error_Msg_N ("neither function postcondition nor "
- & "contract cases mention result??",
- Last_Postcondition);
+ Error_Msg_N
+ ("neither function postcondition nor "
+ & "contract cases mention result?T?", Last_Postcondition);
else
- Error_Msg_N ("function postcondition does not mention result??",
- Last_Postcondition);
+ Error_Msg_N
+ ("function postcondition does not mention result?T?",
+ Last_Postcondition);
end if;
else
- Error_Msg_N ("contract cases do not mention result??",
- Last_Contract_Case);
+ Error_Msg_N
+ ("contract cases do not mention result?T?", Last_Contract_Case);
end if;
end if;
end Check_Subprogram_Contract;
@@ -9364,10 +9366,12 @@
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 #?L?",
+ E);
else
Error_Msg_N
- ("info: & inherits `Post''Class` aspect from #?", E);
+ ("info: & inherits `Post''Class` aspect from #?L?",
+ E);
end if;
end if;
Index: sem_ch6.ads
===================================================================
--- sem_ch6.ads (revision 194785)
+++ sem_ch6.ads (working copy)
@@ -58,29 +58,30 @@
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,
- -- 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:
+ -- which ends with ? (it does not end with ?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.
+ -- is set, adding ?p to the msg, 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.
+ -- Ineffective_Inline_Warnings is set (adding p?), 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
+ -- flag Ineffective_Inline_Warnings is set (adding p?); otherwise
-- no effect since inlining may be performed by the backend.
procedure Check_Conventions (Typ : Entity_Id);
Index: exp_disp.adb
===================================================================
--- exp_disp.adb (revision 194776)
+++ exp_disp.adb (working copy)
@@ -8431,11 +8431,11 @@
if Is_Controlled (Typ) then
if not Finalized then
Error_Msg_N
- ("controlled type has no explicit Finalize method?", Typ);
+ ("controlled type has no explicit Finalize method??", Typ);
elsif not Adjusted then
Error_Msg_N
- ("controlled type has no explicit Adjust method?", Typ);
+ ("controlled type has no explicit Adjust method??", Typ);
end if;
end if;
@@ -8754,7 +8754,7 @@
if Has_CPP_Constructors (Typ)
and then No (Init_Proc (Typ))
then
- Error_Msg_N ("?default constructor must be imported from C++", Typ);
+ Error_Msg_N ("??default constructor must be imported from C++", Typ);
end if;
end Set_CPP_Constructors;
Index: sem_warn.adb
===================================================================
--- sem_warn.adb (revision 194786)
+++ sem_warn.adb (working copy)
@@ -1083,7 +1083,7 @@
and then not Is_Imported (E1)
then
Error_Msg_N
- ("??& is not modified, volatile has no effect!", E1);
+ ("?k?& is not modified, volatile has no effect!", E1);
-- Another special case, Exception_Occurrence, this catches
-- the case of exception choice (and a bit more too, but not
@@ -1105,7 +1105,7 @@
then
if not Warnings_Off_E1 then
Error_Msg_N -- CODEFIX
- ("??& is not modified, "
+ ("?k?& is not modified, "
& "could be declared constant!",
E1);
end if;
@@ -1237,7 +1237,7 @@
and then not Warnings_Off_E1
then
Output_Reference_Error
- ("?v?formal parameter& is read but "
+ ("?f?formal parameter& is read but "
& "never assigned!");
end if;
@@ -1245,7 +1245,7 @@
and then not Warnings_Off_E1
then
Output_Reference_Error
- ("?v?formal parameter& is not referenced!");
+ ("?f?formal parameter& is not referenced!");
end if;
end if;
@@ -2112,7 +2112,7 @@
if Entity (Nam) = Pack then
Error_Msg_Qual_Level := 1;
Error_Msg_NE -- CODEFIX
- ("?no entities of package& are referenced!",
+ ("?u?no entities of package& are referenced!",
Nam, Pack);
Error_Msg_Qual_Level := 0;
end if;
@@ -2309,7 +2309,7 @@
elsif Has_Visible_Entities (Entity (Name (Item))) then
Error_Msg_N -- CODEFIX
- ("?unit& is not referenced!", Name (Item));
+ ("?u?unit& is not referenced!", Name (Item));
end if;
end if;
@@ -2386,7 +2386,7 @@
Has_Unreferenced (Entity (Name (Item)))
then
Error_Msg_N -- CODEFIX
- ("?no entities of & are referenced!",
+ ("?u?no entities of & are referenced!",
Name (Item));
end if;
@@ -2402,7 +2402,7 @@
and then not Has_Unreferenced (Pack)
then
Error_Msg_NE -- CODEFIX
- ("?no entities of & are referenced!",
+ ("?u?no entities of & are referenced!",
Unit_Declaration_Node (Pack),
Pack);
end if;
@@ -2452,12 +2452,12 @@
elsif Unreferenced_In_Spec (Item) then
Error_Msg_N -- CODEFIX
- ("?unit& is not referenced in spec!",
+ ("?u?unit& is not referenced in spec!",
Name (Item));
elsif No_Entities_Ref_In_Spec (Item) then
Error_Msg_N -- CODEFIX
- ("?no entities of & are referenced in spec!",
+ ("?u?no entities of & are referenced in spec!",
Name (Item));
else
@@ -2470,7 +2470,7 @@
if not Is_Visible_Renaming then
Error_Msg_N -- CODEFIX
- ("\?with clause might be moved to body!",
+ ("\?u?with clause might be moved to body!",
Name (Item));
end if;
@@ -2498,7 +2498,7 @@
Set_Unreferenced_In_Spec (Item);
else
Error_Msg_N -- CODEFIX
- ("?unit& is never instantiated!", Name (Item));
+ ("?u?unit& is never instantiated!", Name (Item));
end if;
-- If unit was indeed instantiated, make sure that flag is
@@ -2507,9 +2507,9 @@
elsif Unreferenced_In_Spec (Item) then
Error_Msg_N
- ("?unit& is not instantiated in spec!", Name (Item));
+ ("?u?unit& is not instantiated in spec!", Name (Item));
Error_Msg_N -- CODEFIX
- ("\?with clause can be moved to body!", Name (Item));
+ ("\?u?with clause can be moved to body!", Name (Item));
end if;
end if;
end if;
@@ -2521,9 +2521,7 @@
-- Start of processing for Check_Unused_Withs
begin
- if not Opt.Check_Withs
- or else Operating_Mode = Check_Syntax
- then
+ if not Opt.Check_Withs or else Operating_Mode = Check_Syntax then
return;
end if;
@@ -2794,9 +2792,9 @@
if not Is_Trivial_Subprogram (Scope (E1)) then
if Warn_On_Constant then
Error_Msg_N
- ("?formal parameter & is not modified!", E1);
+ ("?u?formal parameter & is not modified!", E1);
Error_Msg_N
- ("\?mode could be IN instead of `IN OUT`!", E1);
+ ("\?u?mode could be IN instead of `IN OUT`!", E1);
-- We do not generate warnings for IN OUT parameters
-- unless we have at least -gnatwu. This is deliberately
@@ -2806,7 +2804,7 @@
elsif Check_Unreferenced then
Error_Msg_N
- ("?formal parameter& is read but "
+ ("?u?formal parameter& is read but "
& "never assigned!", E1);
end if;
end if;
@@ -2865,13 +2863,13 @@
if Nkind (P) = N_With_Clause then
if Ekind (E) = E_Package then
Error_Msg_NE
- ("?with of obsolescent package& declared#", N, E);
+ ("??with of obsolescent package& declared#", N, E);
elsif Ekind (E) = E_Procedure then
Error_Msg_NE
- ("?with of obsolescent procedure& declared#", N, E);
+ ("??with of obsolescent procedure& declared#", N, E);
else
Error_Msg_NE
- ("?with of obsolescent function& declared#", N, E);
+ ("??with of obsolescent function& declared#", N, E);
end if;
-- If we do not have a with clause, then ignore any reference to an
@@ -2885,51 +2883,49 @@
elsif Nkind (P) = N_Procedure_Call_Statement then
Error_Msg_NE
- ("?call to obsolescent procedure& declared#", N, E);
+ ("??call to obsolescent procedure& declared#", N, E);
-- Function call
elsif Nkind (P) = N_Function_Call then
Error_Msg_NE
- ("?call to obsolescent function& declared#", N, E);
+ ("??call to obsolescent function& declared#", N, E);
-- Reference to obsolescent type
elsif Is_Type (E) then
Error_Msg_NE
- ("?reference to obsolescent type& declared#", N, E);
+ ("??reference to obsolescent type& declared#", N, E);
-- Reference to obsolescent component
elsif Ekind_In (E, E_Component, E_Discriminant) then
Error_Msg_NE
- ("?reference to obsolescent component& declared#", N, E);
+ ("??reference to obsolescent component& declared#", N, E);
-- Reference to obsolescent variable
elsif Ekind (E) = E_Variable then
Error_Msg_NE
- ("?reference to obsolescent variable& declared#", N, E);
+ ("??reference to obsolescent variable& declared#", N, E);
-- Reference to obsolescent constant
- elsif Ekind (E) = E_Constant
- or else Ekind (E) in Named_Kind
- then
+ elsif Ekind (E) = E_Constant or else Ekind (E) in Named_Kind then
Error_Msg_NE
- ("?reference to obsolescent constant& declared#", N, E);
+ ("??reference to obsolescent constant& declared#", N, E);
-- Reference to obsolescent enumeration literal
elsif Ekind (E) = E_Enumeration_Literal then
Error_Msg_NE
- ("?reference to obsolescent enumeration literal& declared#", N, E);
+ ("??reference to obsolescent enumeration literal& declared#", N, E);
-- Generic message for any other case we missed
else
Error_Msg_NE
- ("?reference to obsolescent entity& declared#", N, E);
+ ("??reference to obsolescent entity& declared#", N, E);
end if;
-- Output additional warning if present
@@ -2939,7 +2935,7 @@
String_To_Name_Buffer (Obsolescent_Warnings.Table (J).Msg);
Error_Msg_Strlen := Name_Len;
Error_Msg_String (1 .. Name_Len) := Name_Buffer (1 .. Name_Len);
- Error_Msg_N ("\\?~", N);
+ Error_Msg_N ("\\??~", N);
exit;
end if;
end loop;
@@ -2993,21 +2989,21 @@
elsif Warnings_Off_Used_Unmodified (E) then
Error_Msg_NE
- ("?could use Unmodified instead of "
+ ("?W?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
- ("?could use Unreferenced instead of "
+ ("?W?could use Unreferenced instead of "
& "Warnings Off for &", Pragma_Identifier (N), E);
-- Not used at all
else
Error_Msg_NE
- ("?pragma Warnings Off for & unused, "
+ ("?W?pragma Warnings Off for & unused, "
& "could be omitted", N, E);
end if;
end;
@@ -3249,16 +3245,16 @@
and then Nkind (Cond) /= N_Op_Not
then
Error_Msg_NE
- ("object & is always True?", Cond, Original_Node (C));
+ ("object & is always True?c?", Cond, Original_Node (C));
Track (Original_Node (C), Cond);
else
- Error_Msg_N ("condition is always True?", Cond);
+ Error_Msg_N ("condition is always True?c?", Cond);
Track (Cond, Cond);
end if;
else
- Error_Msg_N ("condition is always False?", Cond);
+ Error_Msg_N ("condition is always False?c?", Cond);
Track (Cond, Cond);
end if;
end;
@@ -3388,23 +3384,23 @@
then
if Act1 = First_Actual (N) then
Error_Msg_FE
- ("`IN OUT` prefix overlaps with actual for&?",
- Act1, Form);
+ ("`IN OUT` prefix overlaps with "
+ & "actual for&?I?", Act1, Form);
else
-- For greater clarity, give name of formal.
Error_Msg_Node_2 := Form;
Error_Msg_FE
- ("writable actual for & overlaps with"
- & " actual for&?", Act1, Form);
+ ("writable actual for & overlaps with "
+ & "actual for&?I?", Act1, Form);
end if;
else
Error_Msg_Node_2 := Form;
Error_Msg_FE
("writable actual for & overlaps with"
- & " actual for&?", Act1, Form1);
+ & " actual for&?I?", Act1, Form1);
end if;
end;
end if;
@@ -3514,7 +3510,7 @@
begin
Error_Msg_Uint_1 := Low_Bound;
Error_Msg_FE -- CODEFIX
- ("?index for& may assume lower bound of^", X, Ent);
+ ("?w?index for& may assume lower bound of^", X, Ent);
end Warn1;
-- Start of processing for Test_Suspicious_Index
@@ -3539,11 +3535,11 @@
if Nkind (Original_Node (X)) = N_Integer_Literal then
if Intval (X) = Low_Bound then
Error_Msg_FE -- CODEFIX
- ("\suggested replacement: `&''First`", X, Ent);
+ ("\?w?suggested replacement: `&''First`", X, Ent);
else
Error_Msg_Uint_1 := Intval (X) - Low_Bound;
Error_Msg_FE -- CODEFIX
- ("\suggested replacement: `&''First + ^`", X, Ent);
+ ("\?w?suggested replacement: `&''First + ^`", X, Ent);
end if;
@@ -3649,7 +3645,7 @@
-- Replacement subscript is now in string buffer
Error_Msg_FE -- CODEFIX
- ("\suggested replacement: `&~`", Original_Node (X), Ent);
+ ("\?w?suggested replacement: `&~`", Original_Node (X), Ent);
end if;
-- Case where subscript is of the form X'Length
@@ -3658,7 +3654,7 @@
Warn1;
Error_Msg_Node_2 := Ent;
Error_Msg_FE
- ("\suggest replacement of `&''Length` by `&''Last`",
+ ("\?w?suggest replacement of `&''Length` by `&''Last`",
X, Ent);
-- Case where subscript is of the form X'Length - expression
@@ -3669,7 +3665,7 @@
Warn1;
Error_Msg_Node_2 := Ent;
Error_Msg_FE
- ("\suggest replacement of `&''Length` by `&''Last`",
+ ("\?w?suggest replacement of `&''Length` by `&''Last`",
Left_Opnd (X), Ent);
end if;
end Test_Suspicious_Index;
@@ -3797,7 +3793,7 @@
then
if not Has_Pragma_Unmodified_Check_Spec (E) then
Error_Msg_N -- CODEFIX
- ("?variable & is assigned but never read!", E);
+ ("?u?variable & is assigned but never read!", E);
end if;
Set_Last_Assignment (E, Empty);
@@ -3821,10 +3817,10 @@
and then Comes_From_Source (Renamed_Object (E))
then
Error_Msg_N -- CODEFIX
- ("?renamed variable & is not referenced!", E);
+ ("?u?renamed variable & is not referenced!", E);
else
Error_Msg_N -- CODEFIX
- ("?variable & is not referenced!", E);
+ ("?u?variable & is not referenced!", E);
end if;
end if;
end if;
@@ -3834,10 +3830,10 @@
and then Comes_From_Source (Renamed_Object (E))
then
Error_Msg_N -- CODEFIX
- ("?renamed constant & is not referenced!", E);
+ ("?u?renamed constant & is not referenced!", E);
else
Error_Msg_N -- CODEFIX
- ("?constant & is not referenced!", E);
+ ("?u?constant & is not referenced!", E);
end if;
when E_In_Parameter |
@@ -3846,8 +3842,8 @@
-- Do not emit message for formals of a renaming, because
-- they are never referenced explicitly.
- if Nkind (Original_Node (Unit_Declaration_Node (Scope (E))))
- /= N_Subprogram_Renaming_Declaration
+ if Nkind (Original_Node (Unit_Declaration_Node (Scope (E)))) /=
+ N_Subprogram_Renaming_Declaration
then
-- Suppress this message for an IN OUT parameter of a
-- non-scalar type, since it is normal to have only an
@@ -3863,7 +3859,7 @@
if not Is_Trivial_Subprogram (Scope (E)) then
Error_Msg_NE -- CODEFIX
- ("?formal parameter & is not referenced!",
+ ("?u?formal parameter & is not referenced!",
E, Spec_E);
end if;
end if;
@@ -3873,56 +3869,56 @@
null;
when E_Discriminant =>
- Error_Msg_N ("?discriminant & is not referenced!", E);
+ Error_Msg_N ("?u?discriminant & is not referenced!", E);
when E_Named_Integer |
E_Named_Real =>
Error_Msg_N -- CODEFIX
- ("?named number & is not referenced!", E);
+ ("?u?named number & is not referenced!", E);
when Formal_Object_Kind =>
Error_Msg_N -- CODEFIX
- ("?formal object & is not referenced!", E);
+ ("?u?formal object & is not referenced!", E);
when E_Enumeration_Literal =>
Error_Msg_N -- CODEFIX
- ("?literal & is not referenced!", E);
+ ("?u?literal & is not referenced!", E);
when E_Function =>
Error_Msg_N -- CODEFIX
- ("?function & is not referenced!", E);
+ ("?u?function & is not referenced!", E);
when E_Procedure =>
Error_Msg_N -- CODEFIX
- ("?procedure & is not referenced!", E);
+ ("?u?procedure & is not referenced!", E);
when E_Package =>
Error_Msg_N -- CODEFIX
- ("?package & is not referenced!", E);
+ ("?u?package & is not referenced!", E);
when E_Exception =>
Error_Msg_N -- CODEFIX
- ("?exception & is not referenced!", E);
+ ("?u?exception & is not referenced!", E);
when E_Label =>
Error_Msg_N -- CODEFIX
- ("?label & is not referenced!", E);
+ ("?u?label & is not referenced!", E);
when E_Generic_Procedure =>
Error_Msg_N -- CODEFIX
- ("?generic procedure & is never instantiated!", E);
+ ("?u?generic procedure & is never instantiated!", E);
when E_Generic_Function =>
Error_Msg_N -- CODEFIX
- ("?generic function & is never instantiated!", E);
+ ("?u?generic function & is never instantiated!", E);
when Type_Kind =>
Error_Msg_N -- CODEFIX
- ("?type & is not referenced!", E);
+ ("?u?type & is not referenced!", E);
when others =>
Error_Msg_N -- CODEFIX
- ("?& is not referenced!", E);
+ ("?u?& is not referenced!", E);
end case;
-- Kill warnings on the entity on which the message has been posted
@@ -4024,12 +4020,12 @@
N_Parameter_Association)
then
Error_Msg_NE
- ("?& modified by call, but value never "
+ ("?m?& modified by call, but value never "
& "referenced", LA, Ent);
else
Error_Msg_NE -- CODEFIX
- ("?useless assignment to&, value never "
+ ("?m?useless assignment to&, value never "
& "referenced!", LA, Ent);
end if;
end if;
@@ -4051,11 +4047,11 @@
N_Parameter_Association)
then
Error_Msg_NE
- ("?& modified by call, but value overwritten #!",
+ ("?m?& modified by call, but value overwritten #!",
LA, Ent);
else
Error_Msg_NE -- CODEFIX
- ("?useless assignment to&, value overwritten #!",
+ ("?m?useless assignment to&, value overwritten #!",
LA, Ent);
end if;
end;
Index: opt.ads
===================================================================
--- opt.ads (revision 194786)
+++ opt.ads (working copy)
@@ -174,7 +174,8 @@
Address_Clause_Overlay_Warnings : Boolean := True;
-- GNAT
- -- Set False to disable address clause warnings
+ -- Set False to disable address clause warnings. Modified by use of
+ -- -gnatwo/O.
Address_Is_Private : Boolean := False;
-- GNAT, GNATBIND
@@ -317,6 +318,7 @@
-- GNAT
-- Set to True to enable checking for unreferenced entities other
-- than formal parameters (for which see Check_Unreferenced_Formals)
+ -- Modified by use of -gnatwu/U.
Check_Unreferenced_Formals : Boolean := False;
-- GNAT
@@ -332,6 +334,7 @@
-- GNAT
-- Set to True to enable checking for unused withs, and also the case
-- of withing a package and using none of the entities in the package.
+ -- Modified by use of -gnatwu/U.
CodePeer_Mode : Boolean := False;
-- GNAT, GNATBIND
@@ -714,7 +717,7 @@
Implementation_Unit_Warnings : Boolean := True;
-- GNAT
-- Set True to active warnings for use of implementation internal units.
- -- Can be controlled by use of -gnatwi/-gnatwI.
+ -- Modified by use of -gnatwi/-gnatwI.
Implicit_Packing : Boolean := False;
-- GNAT
@@ -824,8 +827,7 @@
-- GNAT
-- List inherited invariants, preconditions, and postconditions from
-- Invariant'Class, Pre'Class, and Post'Class aspects. Also list inherited
- -- subtype predicates. Set True by use of -gnatw.l and False by use of
- -- -gnatw.L.
+ -- subtype predicates. Modified by use of -gnatw.l/.L.
List_Restrictions : Boolean := False;
-- GNATBIND
@@ -1467,31 +1469,31 @@
-- GNAT
-- Set to True to generate all warnings on Ada 2005 compatibility issues,
-- including warnings on Ada 2005 obsolescent features used in Ada 2005
- -- mode. Set by default, set False by -gnatwY.
+ -- mode. Set by default, modified by use of -gnatwy/Y.
Warn_On_Ada_2012_Compatibility : Boolean := True;
-- GNAT
-- Set to True to generate all warnings on Ada 2012 compatibility issues,
-- including warnings on Ada 2012 obsolescent features used in Ada 2012
- -- mode. Set False by -gnatwY.
+ -- mode. Modified by use of -gnatwy/Y.
Warn_On_All_Unread_Out_Parameters : Boolean := False;
-- GNAT
-- Set to True to generate warnings in all cases where a variable is
-- modified by being passed as to an OUT formal, but the resulting value is
- -- never read. The default is that this warning is suppressed, except in
- -- the case of
+ -- never read. The default is that this warning is suppressed. Modified
+ -- by use of gnatw.o/.O.
Warn_On_Assertion_Failure : Boolean := True;
-- GNAT
-- Set to True to activate warnings on assertions that can be determined
- -- at compile time will always fail. Set false by -gnatw.A.
+ -- at compile time will always fail. Modified by use of -gnatw.a/.A.
Warn_On_Assumed_Low_Bound : Boolean := True;
-- GNAT
-- Set to True to activate warnings for string parameters that are indexed
- -- with literals or S'Length, presumably assuming a lower bound of one. Set
- -- False by -gnatwW.
+ -- with literals or S'Length, presumably assuming a lower bound of one.
+ -- Modified by use of -gnatww/W.
Warn_On_Atomic_Synchronization : Boolean := False;
-- GNAT
@@ -1542,7 +1544,8 @@
-- Set to True to generate warnings if a variable is assigned but is never
-- read. Also controls warnings for similar cases involving out parameters,
-- but only if there is only one out parameter for the procedure involved.
- -- The default is that this warning is suppressed.
+ -- The default is that this warning is suppressed, modified by use of
+ -- -gnatwm/M.
Warn_On_No_Value_Assigned : Boolean := True;
-- GNAT
@@ -1583,6 +1586,7 @@
-- GNAT
-- Set to True to generate warnings when a writable actual which is not
-- a by-copy type overlaps with another actual in a subprogram call.
+ -- Modified by use of -gnatw.i/.I.
Warn_On_Questionable_Missing_Parens : Boolean := True;
-- GNAT
@@ -1612,7 +1616,7 @@
-- GNAT
-- Set to True to generate warnings for suspicious contracts expressed as
-- pragmas or aspects precondition and postcondition. The default is that
- -- this warning is disabled.
+ -- this warning is disabled. Modified by use of -gnatw.t/.T.
Warn_On_Suspicious_Modulus_Value : Boolean := True;
-- GNAT
@@ -1623,7 +1627,7 @@
-- GNAT
-- Set to True to generate warnings for unchecked conversions that may have
-- non-portable semantics (e.g. because sizes of types differ). Modified
- -- by use of -gnatw.z/.Z.
+ -- by use of -gnatwz/Z.
Warn_On_Unordered_Enumeration_Type : Boolean := False;
-- GNAT
@@ -1647,7 +1651,7 @@
-- GNAT
-- Set to True to generate warnings for use of Pragma Warnings (Off, ent),
-- where either the pragma is never used, or it could be replaced by a
- -- pragma Unmodified or Unreferenced.
+ -- pragma Unmodified or Unreferenced. Modified by use of -gnatw.w/.W.
type Warning_Mode_Type is (Suppress, Normal, Treat_As_Error);
Warning_Mode : Warning_Mode_Type := Normal;
Index: par-util.adb
===================================================================
--- par-util.adb (revision 194776)
+++ par-util.adb (working copy)
@@ -186,7 +186,7 @@
or else (Token_Name = Name_Interface
and then Prev_Token /= Tok_Pragma)
then
- Error_Msg_N ("& is a reserved word in Ada 2005?", Token_Node);
+ Error_Msg_N ("& is a reserved word in Ada 2005?y?", Token_Node);
end if;
end if;
@@ -196,7 +196,7 @@
and then Warn_On_Ada_2012_Compatibility
then
if Token_Name = Name_Some then
- Error_Msg_N ("& is a reserved word in Ada 2012?", Token_Node);
+ Error_Msg_N ("& is a reserved word in Ada 2012?y?", Token_Node);
end if;
end if;
@@ -761,7 +761,7 @@
C : constant Entity_Id := Current_Entity (N);
begin
if Present (C) and then Sloc (C) = Standard_Location then
- Error_Msg_N ("redefinition of entity& in Standard?", N);
+ Error_Msg_N ("redefinition of entity& in Standard?K?", N);
end if;
end;
end if;
Index: exp_intr.adb
===================================================================
--- exp_intr.adb (revision 194776)
+++ exp_intr.adb (working copy)
@@ -1045,9 +1045,9 @@
and then Is_Entity_Name (Nam2)
and then Entity (Prefix (Nam1)) = Entity (Nam2)
then
- Error_Msg_N ("abort may take time to complete?", N);
- Error_Msg_N ("\deallocation might have no effect?", N);
- Error_Msg_N ("\safer to wait for termination.?", N);
+ Error_Msg_N ("abort may take time to complete??", N);
+ Error_Msg_N ("\deallocation might have no effect??", N);
+ Error_Msg_N ("\safer to wait for termination??", N);
end if;
end if;
end;
Index: exp_dist.adb
===================================================================
--- exp_dist.adb (revision 194776)
+++ exp_dist.adb (working copy)
@@ -7417,6 +7417,7 @@
-- If the current parameter has a dynamic constrained status, then
-- this status is transmitted as well.
+
-- This should be done for accessibility as well ???
if Nkind (Parameter_Type (Current_Parameter)) /=
Index: sem_ch13.adb
===================================================================
--- sem_ch13.adb (revision 194785)
+++ sem_ch13.adb (working copy)
@@ -5339,7 +5339,7 @@
if Inherit and Opt.List_Inherited_Aspects then
Error_Msg_Sloc := Sloc (Ritem);
Error_Msg_N
- ("?info: & inherits `Invariant''Class` aspect from #",
+ ("?L?info: & inherits `Invariant''Class` aspect from #",
Typ);
end if;
end if;
@@ -5563,7 +5563,7 @@
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 & #?L?", Typ);
end if;
end if;
end Add_Call;
@@ -9797,7 +9797,7 @@
or else OpenVMS_On_Target
then
Error_Msg_N
- ("?Z?conversion between pointers with different conventions!",
+ ("?z?conversion between pointers with different conventions!",
N);
end if;
end if;
@@ -9824,7 +9824,7 @@
if Source = Calendar_Time or else Target = Calendar_Time then
Error_Msg_N
- ("?Z?representation of 'Time values may change between " &
+ ("?z?representation of 'Time values may change between " &
"'G'N'A'T versions", N);
end if;
end;
@@ -9925,7 +9925,7 @@
if Source_Siz /= Target_Siz then
Error_Msg
- ("?Z?types for unchecked conversion have different sizes!",
+ ("?z?types for unchecked conversion have different sizes!",
Eloc);
if All_Errors_Mode then
@@ -9933,7 +9933,7 @@
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 ^?Z?", Eloc);
+ Error_Msg ("\size of % is ^, size of % is ^?z?", Eloc);
Error_Msg_Uint_1 := UI_Abs (Source_Siz - Target_Siz);
@@ -9943,17 +9943,17 @@
then
if Source_Siz > Target_Siz then
Error_Msg
- ("\?Z?^ high order bits of source will "
+ ("\?z?^ high order bits of source will "
& "be ignored!", Eloc);
elsif Is_Unsigned_Type (Source) then
Error_Msg
- ("\?Z?source will be extended with ^ high order "
+ ("\?z?source will be extended with ^ high order "
& "zero bits?!", Eloc);
else
Error_Msg
- ("\?Z?source will be extended with ^ high order "
+ ("\?z?source will be extended with ^ high order "
& "sign bits!", Eloc);
end if;
@@ -9961,23 +9961,23 @@
if Is_Discrete_Type (Target) then
if Bytes_Big_Endian then
Error_Msg
- ("\?Z?target value will include ^ undefined "
+ ("\?z?target value will include ^ undefined "
& "low order bits!", Eloc);
else
Error_Msg
- ("\?Z?target value will include ^ undefined "
+ ("\?z?target value will include ^ undefined "
& "high order bits!", Eloc);
end if;
else
Error_Msg
- ("\?Z?^ trailing bits of target value will be "
+ ("\?z?^ trailing bits of target value will be "
& "undefined!", Eloc);
end if;
else pragma Assert (Source_Siz > Target_Siz);
Error_Msg
- ("\?Z?^ trailing bits of source will be ignored!",
+ ("\?z?^ trailing bits of source will be ignored!",
Eloc);
end if;
end if;
@@ -10030,10 +10030,10 @@
Error_Msg_Node_1 := D_Target;
Error_Msg_Node_2 := D_Source;
Error_Msg
- ("?Z?alignment of & (^) is stricter than "
+ ("?z?alignment of & (^) is stricter than "
& "alignment of & (^)!", Eloc);
Error_Msg
- ("\?Z?resulting access value may have invalid "
+ ("\?z?resulting access value may have invalid "
& "alignment!", Eloc);
end if;
end;
Index: lib-xref.adb
===================================================================
--- lib-xref.adb (revision 194776)
+++ lib-xref.adb (working copy)
@@ -597,7 +597,7 @@
and then Warn_On_Ada_2005_Compatibility
and then (Typ = 'm' or else Typ = 'r' or else Typ = 's')
then
- Error_Msg_NE ("& is only defined in Ada 2005?", N, E);
+ Error_Msg_NE ("& is only defined in Ada 2005?y?", N, E);
end if;
-- Warn if reference to Ada 2012 entity not in Ada 2012 mode. We only
@@ -609,7 +609,7 @@
and then Warn_On_Ada_2012_Compatibility
and then (Typ = 'm' or else Typ = 'r')
then
- Error_Msg_NE ("& is only defined in Ada 2012?", N, E);
+ Error_Msg_NE ("& is only defined in Ada 2012?y?", N, E);
end if;
-- Never collect references if not in main source unit. However, we omit
@@ -841,7 +841,7 @@
while Present (BE) loop
if Chars (BE) = Chars (E) then
Error_Msg_NE -- CODEFIX
- ("?pragma Unreferenced given for&!", N, BE);
+ ("??pragma Unreferenced given for&!", N, BE);
exit;
end if;
^ permalink raw reply [flat|nested] 2+ messages in thread
* [Ada] Further work on tags for warning messages
@ 2013-01-02 9:52 Arnaud Charlet
0 siblings, 0 replies; 2+ messages in thread
From: Arnaud Charlet @ 2013-01-02 9:52 UTC (permalink / raw)
To: gcc-patches; +Cc: Robert Dewar
[-- Attachment #1: Type: text/plain, Size: 596 bytes --]
This patch adds additional tags for warning messages.
Tested on x86_64-pc-linux-gnu, committed on trunk
2013-01-02 Robert Dewar <dewar@adacore.com>
* errout.ads: Minor comment fixes.
* opt.ads: Minor comment additions.
* exp_aggr.adb: Add tags to warning messages
* exp_ch11.adb, exp_ch3.adb, exp_ch4.adb, exp_util.adb, sem_aggr.adb,
sem_attr.adb, sem_case.adb, sem_cat.adb, sem_ch3.adb, sem_ch4.adb,
sem_ch5.adb, sem_disp.adb, sem_dist.adb, sem_elab.adb, sem_eval.adb,
sem_intr.adb, sem_mech.adb, sem_prag.adb, sem_res.adb, sem_util.adb,
sem_warn.adb: Add tags to warning messages
[-- Attachment #2: difs --]
[-- Type: text/plain, Size: 105856 bytes --]
Index: sem_aggr.adb
===================================================================
--- sem_aggr.adb (revision 194776)
+++ sem_aggr.adb (working copy)
@@ -468,13 +468,13 @@
then
if Is_Out_Of_Range (Exp, Base_Type (Check_Typ)) then
Apply_Compile_Time_Constraint_Error
- (Exp, "value not in range of}?", CE_Range_Check_Failed,
+ (Exp, "value not in range of}??", CE_Range_Check_Failed,
Ent => Base_Type (Check_Typ),
Typ => Base_Type (Check_Typ));
elsif Is_Out_Of_Range (Exp, Check_Typ) then
Apply_Compile_Time_Constraint_Error
- (Exp, "value not in range of}?", CE_Range_Check_Failed,
+ (Exp, "value not in range of}??", CE_Range_Check_Failed,
Ent => Check_Typ,
Typ => Check_Typ);
@@ -583,9 +583,9 @@
elsif Expr_Value (This_Low) /= Expr_Value (Aggr_Low (Dim)) then
Set_Raises_Constraint_Error (N);
- Error_Msg_N ("sub-aggregate low bound mismatch?", N);
+ Error_Msg_N ("sub-aggregate low bound mismatch??", N);
Error_Msg_N
- ("\Constraint_Error will be raised at run time?", N);
+ ("\Constraint_Error will be raised at run time??", N);
end if;
end if;
@@ -597,9 +597,9 @@
Expr_Value (This_High) /= Expr_Value (Aggr_High (Dim))
then
Set_Raises_Constraint_Error (N);
- Error_Msg_N ("sub-aggregate high bound mismatch?", N);
+ Error_Msg_N ("sub-aggregate high bound mismatch??", N);
Error_Msg_N
- ("\Constraint_Error will be raised at run time?", N);
+ ("\Constraint_Error will be raised at run time??", N);
end if;
end if;
end if;
@@ -1440,8 +1440,8 @@
if OK_BH and then OK_AH and then Val_BH < Val_AH then
Set_Raises_Constraint_Error (N);
- Error_Msg_N ("upper bound out of range?", AH);
- Error_Msg_N ("\Constraint_Error will be raised at run time?", AH);
+ Error_Msg_N ("upper bound out of range??", AH);
+ Error_Msg_N ("\Constraint_Error will be raised at run time??", AH);
-- You need to set AH to BH or else in the case of enumerations
-- indexes we will not be able to resolve the aggregate bounds.
@@ -1483,14 +1483,14 @@
if OK_L and then Val_L > Val_AL then
Set_Raises_Constraint_Error (N);
- Error_Msg_N ("lower bound of aggregate out of range?", N);
- Error_Msg_N ("\Constraint_Error will be raised at run time?", N);
+ Error_Msg_N ("lower bound of aggregate out of range??", N);
+ Error_Msg_N ("\Constraint_Error will be raised at run time??", N);
end if;
if OK_H and then Val_H < Val_AH then
Set_Raises_Constraint_Error (N);
- Error_Msg_N ("upper bound of aggregate out of range?", N);
- Error_Msg_N ("\Constraint_Error will be raised at run time?", N);
+ Error_Msg_N ("upper bound of aggregate out of range??", N);
+ Error_Msg_N ("\Constraint_Error will be raised at run time??", N);
end if;
end Check_Bounds;
@@ -1529,8 +1529,8 @@
if Range_Len < Len then
Set_Raises_Constraint_Error (N);
- Error_Msg_N ("too many elements?", N);
- Error_Msg_N ("\Constraint_Error will be raised at run time?", N);
+ Error_Msg_N ("too many elements??", N);
+ Error_Msg_N ("\Constraint_Error will be raised at run time??", N);
end if;
end Check_Length;
@@ -1980,7 +1980,7 @@
elsif Nkind (Choice) = N_Subtype_Indication then
Resolve_Discrete_Subtype_Indication (Choice, Index_Base);
- -- Does the subtype indication evaluation raise CE ?
+ -- Does the subtype indication evaluation raise CE?
Get_Index_Bounds (Subtype_Mark (Choice), S_Low, S_High);
Get_Index_Bounds (Choice, Low, High);
@@ -2310,7 +2310,8 @@
(Enumeration_Pos (AHi) - Enumeration_Pos (ALo))
then
Error_Msg_N
- ("missing index value(s) in array aggregate?", N);
+ ("missing index value(s) in array aggregate??",
+ N);
-- Output missing value(s) at start
@@ -2319,11 +2320,11 @@
if Chars (ALo) = Chars (Ent) then
Error_Msg_Name_1 := Chars (ALo);
- Error_Msg_N ("\ %?", N);
+ Error_Msg_N ("\ %??", N);
else
Error_Msg_Name_1 := Chars (ALo);
Error_Msg_Name_2 := Chars (Ent);
- Error_Msg_N ("\ % .. %?", N);
+ Error_Msg_N ("\ % .. %??", N);
end if;
end if;
@@ -2334,11 +2335,11 @@
if Chars (AHi) = Chars (Ent) then
Error_Msg_Name_1 := Chars (Ent);
- Error_Msg_N ("\ %?", N);
+ Error_Msg_N ("\ %??", N);
else
Error_Msg_Name_1 := Chars (Ent);
Error_Msg_Name_2 := Chars (AHi);
- Error_Msg_N ("\ % .. %?", N);
+ Error_Msg_N ("\ % .. %??", N);
end if;
end if;
@@ -2356,7 +2357,7 @@
not Is_Constrained (First_Subtype (Etype (N)))
then
Error_Msg_N
- ("bounds of aggregate do not match target?", N);
+ ("bounds of aggregate do not match target??", N);
end if;
end;
end if;
@@ -2810,7 +2811,7 @@
and then Enclosing_CPP_Parent (Typ) /= A_Type
then
Error_Msg_NE
- ("?must use 'C'P'P constructor for type &", A,
+ ("??must use 'C'P'P constructor for type &", A,
Enclosing_CPP_Parent (Typ));
-- The following call is not needed if the previous warning
@@ -4576,9 +4577,9 @@
Insert_Action
(Compile_Time_Constraint_Error
(Expr,
- "(Ada 2005) null not allowed in null-excluding component?"),
- Make_Raise_Constraint_Error (Sloc (Expr),
- Reason => CE_Access_Check_Failed));
+ "(Ada 2005) null not allowed in null-excluding component??"),
+ Make_Raise_Constraint_Error
+ (Sloc (Expr), Reason => CE_Access_Check_Failed));
-- Set proper type for bogus component (why is this needed???)
Index: sem_ch3.adb
===================================================================
--- sem_ch3.adb (revision 194781)
+++ sem_ch3.adb (working copy)
@@ -3643,9 +3643,9 @@
(E, Attribute_Address))
then
Error_Msg_N
- ("?more than one task with same entry address", N);
+ ("??more than one task with same entry address", N);
Error_Msg_N
- ("\?Program_Error will be raised at run time", N);
+ ("\??Program_Error will be raised at run time", N);
Insert_Action (N,
Make_Raise_Program_Error (Loc,
Reason => PE_Duplicated_Entry_Address));
@@ -10866,7 +10866,7 @@
if Ada_Version < Ada_2005 then
Error_Msg_N
("access subtype of general access type would not " &
- "be allowed in Ada 2005?", S);
+ "be allowed in Ada 2005?y?", S);
else
Error_Msg_N
("access subtype of general access type not allowed", S);
@@ -10882,7 +10882,7 @@
if Ada_Version < Ada_2005 then
Error_Msg_N
("access subtype would not be allowed in generic body " &
- "in Ada 2005?", S);
+ "in Ada 2005?y?", S);
else
Error_Msg_N
("access subtype not allowed in generic body", S);
@@ -11320,6 +11320,7 @@
-- to one: one new discriminant can constrain several old ones. In
-- that case, scan sequentially the stored_constraint, the list of
-- discriminants of the parents, and the constraints.
+
-- Previous code checked for the present of the Stored_Constraint
-- list for the derived type, but did not use it at all. Should it
-- be present when the component is a discriminated task type?
@@ -11780,7 +11781,7 @@
if Warn_On_Obsolescent_Feature then
Error_Msg_N
("subtype digits constraint is an " &
- "obsolescent feature (RM J.3(8))?", C);
+ "obsolescent feature (RM J.3(8))?j?", C);
end if;
D := Digits_Expression (C);
@@ -11794,7 +11795,7 @@
if Digits_Value (Def_Id) > Digits_Value (T) then
Error_Msg_Uint_1 := Digits_Value (T);
- Error_Msg_N ("?digits value is too large, maximum is ^", D);
+ Error_Msg_N ("??digits value is too large, maximum is ^", D);
Rais :=
Make_Raise_Constraint_Error (Sloc (D),
Reason => CE_Range_Check_Failed);
@@ -12007,7 +12008,7 @@
if Warn_On_Obsolescent_Feature then
Error_Msg_S
("subtype delta constraint is an " &
- "obsolescent feature (RM J.3(7))?");
+ "obsolescent feature (RM J.3(7))?j?");
end if;
D := Delta_Expression (C);
@@ -12020,7 +12021,7 @@
-- course there is an ACVC test that checks this!
if Delta_Value (Def_Id) < Delta_Value (T) then
- Error_Msg_N ("?delta value is too small", D);
+ Error_Msg_N ("??delta value is too small", D);
Rais :=
Make_Raise_Constraint_Error (Sloc (D),
Reason => CE_Range_Check_Failed);
@@ -16797,10 +16798,6 @@
Set_Must_Not_Freeze (I);
Set_Must_Not_Freeze (Prefix (I));
-
- -- Is order critical??? if so, document why, if not
- -- use Analyze_And_Resolve
-
Analyze_And_Resolve (I);
T := Etype (I);
R := I;
@@ -16928,7 +16925,8 @@
and then Nkind (Right_Opnd (Mod_Expr)) = N_Integer_Literal
and then Intval (Right_Opnd (Mod_Expr)) <= Uint_64
then
- Error_Msg_N ("suspicious MOD value, was '*'* intended'??", Mod_Expr);
+ Error_Msg_N
+ ("suspicious MOD value, was '*'* intended'??M?", Mod_Expr);
end if;
-- Proceed with analysis of mod expression
@@ -17273,7 +17271,7 @@
High_Val := Expr_Value_R (High);
if Low_Val > High_Val then
- Error_Msg_NE ("?fixed point type& has null range", Def, T);
+ Error_Msg_NE ("??fixed point type& has null range", Def, T);
end if;
end;
end if;
@@ -19141,7 +19139,7 @@
then
Make_Class_Wide_Type (Typ);
Error_Msg_N
- ("incomplete view of tagged type should be declared tagged?",
+ ("incomplete view of tagged type should be declared tagged??",
Parent (Current_Entity (Typ)));
end if;
return;
Index: sem_intr.adb
===================================================================
--- sem_intr.adb (revision 194776)
+++ sem_intr.adb (working copy)
@@ -163,7 +163,7 @@
and then Can_Never_Be_Null (Etype (Arg1))
then
Error_Msg_N
- ("freeing `NOT NULL` object will raise Constraint_Error?", N);
+ ("freeing `NOT NULL` object will raise Constraint_Error??", N);
-- For unchecked deallocation, error to deallocate from empty pool.
-- Note: this test used to be in Exp_Intr as a warning, but AI 157
Index: sem_dist.adb
===================================================================
--- sem_dist.adb (revision 194776)
+++ sem_dist.adb (working copy)
@@ -522,8 +522,9 @@
Parameter := First (Parameter_Specifications (Type_Def));
while Present (Parameter) loop
if Nkind (Parameter_Type (Parameter)) = N_Access_Definition then
- Error_Msg_N ("formal parameter& has anonymous access type?",
- Defining_Identifier (Parameter));
+ Error_Msg_N
+ ("formal parameter& has anonymous access type??",
+ Defining_Identifier (Parameter));
Is_Degenerate := True;
exit;
end if;
@@ -533,7 +534,7 @@
if Is_Degenerate then
Error_Msg_NE
- ("remote access-to-subprogram type& can only be null?",
+ ("remote access-to-subprogram type& can only be null??",
Defining_Identifier (Parameter), User_Type);
-- The only legal value for a RAS with a formal parameter of an
Index: sem_ch5.adb
===================================================================
--- sem_ch5.adb (revision 194776)
+++ sem_ch5.adb (working copy)
@@ -430,9 +430,9 @@
if Locking_Policy /= 'C' then
Error_Msg_N ("assignment to the attribute PRIORITY has " &
- "no effect?", Lhs);
+ "no effect??", Lhs);
Error_Msg_N ("\since no Locking_Policy has been " &
- "specified", Lhs);
+ "specified??", Lhs);
end if;
return;
@@ -636,8 +636,9 @@
if Known_Null (Rhs) then
Apply_Compile_Time_Constraint_Error
- (N => Rhs,
- Msg => "(Ada 2005) null not allowed in null-excluding objects?",
+ (N => Rhs,
+ Msg =>
+ "(Ada 2005) null not allowed in null-excluding objects??",
Reason => CE_Null_Not_Allowed);
-- We still mark this as a possible modification, that's necessary
@@ -717,10 +718,10 @@
then
if Nkind (Lhs) in N_Has_Entity then
Error_Msg_NE -- CODEFIX
- ("?useless assignment of & to itself!", N, Entity (Lhs));
+ ("?r?useless assignment of & to itself!", N, Entity (Lhs));
else
Error_Msg_N -- CODEFIX
- ("?useless assignment of object to itself!", N);
+ ("?r?useless assignment of object to itself!", N);
end if;
end if;
@@ -2405,7 +2406,7 @@
(L, H, Assume_Valid => False) = GT
then
Error_Msg_N
- ("?loop range is null, loop will not execute", DS);
+ ("??loop range is null, loop will not execute", DS);
-- Since we know the range of the loop is null, set the
-- appropriate flag to remove the loop entirely during
@@ -2420,9 +2421,11 @@
else
Error_Msg_N
- ("?loop range may be null, loop may not execute", DS);
+ ("??loop range may be null, loop may not execute",
+ DS);
Error_Msg_N
- ("?can only execute if invalid values are present", DS);
+ ("??can only execute if invalid values are present",
+ DS);
end if;
end if;
@@ -2449,8 +2452,8 @@
(Intval (Original_Node (H)) = Uint_0
or else Intval (Original_Node (H)) = Uint_1)
then
- Error_Msg_N ("?loop range may be null", DS);
- Error_Msg_N ("\?bounds may be wrong way round", DS);
+ Error_Msg_N ("??loop range may be null", DS);
+ Error_Msg_N ("\??bounds may be wrong way round", DS);
end if;
end;
end if;
@@ -2666,7 +2669,7 @@
then
Error_Msg_Sloc := Sloc (ODSD);
Error_Msg_N
- ("inner range same as outer range#?", DSD);
+ ("inner range same as outer range#??", DSD);
end if;
end;
end if;
@@ -2918,7 +2921,7 @@
Check_SPARK_Restriction
("unreachable code is not allowed", Error_Node);
else
- Error_Msg ("?unreachable code!", Sloc (Error_Node));
+ Error_Msg ("??unreachable code!", Sloc (Error_Node));
end if;
end if;
Index: exp_util.adb
===================================================================
--- exp_util.adb (revision 194776)
+++ exp_util.adb (working copy)
@@ -224,9 +224,11 @@
end case;
if Present (Msg_Node) then
- Error_Msg_N ("?info: atomic synchronization set for &", Msg_Node);
+ Error_Msg_N
+ ("?n?info: atomic synchronization set for &", Msg_Node);
else
- Error_Msg_N ("?info: atomic synchronization set", N);
+ Error_Msg_N
+ ("?n?info: atomic synchronization set", N);
end if;
end if;
end Activate_Atomic_Synchronization;
@@ -5125,7 +5127,8 @@
if W then
Error_Msg_F
- ("?this code can never be executed and has been deleted!", N);
+ ("??this code can never be executed and has been deleted!",
+ N);
end if;
end if;
Index: sem_prag.adb
===================================================================
--- sem_prag.adb (revision 194778)
+++ sem_prag.adb (working copy)
@@ -980,7 +980,7 @@
procedure Check_Ada_83_Warning is
begin
if Ada_Version = Ada_83 and then Comes_From_Source (N) then
- Error_Msg_N ("(Ada 83) pragma& is non-standard?", N);
+ Error_Msg_N ("(Ada 83) pragma& is non-standard??", N);
end if;
end Check_Ada_83_Warning;
@@ -1853,7 +1853,7 @@
then
Error_Msg_Name_1 := Pname;
Error_Msg_N
- ("?pragma% is only effective in main program", N);
+ ("??pragma% is only effective in main program", N);
end if;
end Check_In_Main_Program;
@@ -3551,7 +3551,7 @@
else
if Warn_On_Export_Import and not OpenVMS_On_Target then
Error_Msg_N
- ("?unrecognized convention name, C assumed",
+ ("??unrecognized convention name, C assumed",
Get_Pragma_Arg (Arg1));
end if;
@@ -3860,7 +3860,7 @@
begin
if not OpenVMS_On_Target then
Error_Pragma
- ("?pragma% ignored (applies only to Open'V'M'S)");
+ ("??pragma% ignored (applies only to Open'V'M'S)");
end if;
Process_Extended_Import_Export_Internal_Arg (Arg_Internal);
@@ -3996,7 +3996,7 @@
end if;
if Warn_On_Export_Import and then Is_Exported (Def_Id) then
- Error_Msg_N ("?duplicate Export_Object pragma", N);
+ Error_Msg_N ("??duplicate Export_Object pragma", N);
else
Set_Exported (Def_Id, Arg_Internal);
end if;
@@ -4019,21 +4019,20 @@
and then Has_Discriminants (Etype (Def_Id))
then
Error_Msg_N
- ("imported value must be initialized?", Arg_Internal);
+ ("imported value must be initialized??", Arg_Internal);
end if;
if Warn_On_Export_Import
and then Is_Access_Type (Etype (Def_Id))
then
Error_Pragma_Arg
- ("cannot import object of an access type?", Arg_Internal);
+ ("cannot import object of an access type??", Arg_Internal);
end if;
if Warn_On_Export_Import
and then Is_Imported (Def_Id)
then
- Error_Msg_N
- ("?duplicate Import_Object pragma", N);
+ Error_Msg_N ("??duplicate Import_Object pragma", N);
-- Check for explicit initialization present. Note that an
-- initialization generated by the code generator, e.g. for an
@@ -4957,7 +4956,7 @@
if Front_End_Inlining
and then Analyzed (Corresponding_Body (Decl))
then
- Error_Msg_N ("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
@@ -5209,10 +5208,12 @@
then
if Inlining_Not_Possible (Subp) then
Error_Msg_NE
- ("pragma Inline for& is ignored?", N, Entity (Subp_Id));
+ ("pragma Inline for& is ignored?r?",
+ N, Entity (Subp_Id));
else
Error_Msg_NE
- ("pragma Inline for& is redundant?", N, Entity (Subp_Id));
+ ("pragma Inline for& is redundant?r?",
+ N, Entity (Subp_Id));
end if;
end if;
@@ -5284,7 +5285,7 @@
Get_Character (C) = '/'))
then
Error_Msg
- ("?interface name contains illegal character",
+ ("??interface name contains illegal character",
Sloc (SN) + Source_Ptr (J));
end if;
end loop;
@@ -5704,7 +5705,7 @@
if not UI_Is_In_Int_Range (Val) then
Error_Pragma_Arg
- ("pragma ignored, value too large?", Arg);
+ ("pragma ignored, value too large??", Arg);
end if;
-- Warning case. If the real restriction is active, then we
@@ -5981,20 +5982,23 @@
and then Comes_From_Source (Arg)
then
Error_Msg_NE
- ("?& has been made static as a result of Export", Arg, E);
+ ("?x?& has been made static as a result of Export",
+ Arg, E);
Error_Msg_N
- ("\this usage is non-standard and non-portable", Arg);
+ ("\?x?this usage is non-standard and non-portable",
+ Arg);
end if;
end if;
end if;
if Warn_On_Export_Import and then Is_Type (E) then
- Error_Msg_NE ("exporting a type has no effect?", Arg, E);
+ Error_Msg_NE ("exporting a type has no effect?x?", Arg, E);
end if;
if Warn_On_Export_Import and Inside_A_Generic then
Error_Msg_NE
- ("all instances of& will have the same external name?", Arg, E);
+ ("all instances of& will have the same external name?x?",
+ Arg, E);
end if;
end Set_Exported;
@@ -6562,13 +6566,13 @@
if not Is_Pragma_Name (Pname) then
if Warn_On_Unrecognized_Pragma then
Error_Msg_Name_1 := Pname;
- Error_Msg_N ("?unrecognized pragma%!", Pragma_Identifier (N));
+ Error_Msg_N ("?g?unrecognized pragma%!", Pragma_Identifier (N));
for PN in First_Pragma_Name .. Last_Pragma_Name loop
if Is_Bad_Spelling_Of (Pname, PN) then
Error_Msg_Name_1 := PN;
Error_Msg_N -- CODEFIX
- ("\?possible misspelling of %!", Pragma_Identifier (N));
+ ("\?g?possible misspelling of %!", Pragma_Identifier (N));
exit;
end if;
end loop;
@@ -8119,7 +8123,7 @@
-- Following message is obsolete ???
Error_Msg_N
("'G'N'A'T pragma cpp'_class is now obsolete and has no " &
- "effect; replace it by pragma import?", N);
+ "effect; replace it by pragma import?j?", N);
end if;
Check_Arg_Count (1);
@@ -8171,7 +8175,7 @@
if Is_Constructor (Def_Id) then
Error_Msg_N
- ("?duplicate argument for pragma 'C'P'P_Constructor", Arg1);
+ ("??duplicate argument for pragma 'C'P'P_Constructor", Arg1);
return;
end if;
@@ -8245,7 +8249,7 @@
if Warn_On_Obsolescent_Feature then
Error_Msg_N
("'G'N'A'T pragma cpp'_virtual is now obsolete and has " &
- "no effect?", N);
+ "no effect?j?", N);
end if;
end CPP_Virtual;
@@ -8260,7 +8264,7 @@
if Warn_On_Obsolescent_Feature then
Error_Msg_N
("'G'N'A'T pragma cpp'_vtable is now obsolete and has " &
- "no effect?", N);
+ "no effect?j?", N);
end if;
end CPP_Vtable;
@@ -8745,9 +8749,9 @@
if Elab_Warnings and not Dynamic_Elaboration_Checks then
Error_Msg_N
- ("?use of pragma Elaborate may not be safe", N);
+ ("?l?use of pragma Elaborate may not be safe", N);
Error_Msg_N
- ("?use pragma Elaborate_All instead if possible", N);
+ ("?l?use pragma Elaborate_All instead if possible", N);
end if;
end Elaborate;
@@ -9586,7 +9590,7 @@
if not OpenVMS_On_Target then
if Chars (Get_Pragma_Arg (Arg1)) = Name_VAX_Float then
Error_Pragma
- ("?pragma% ignored (applies only to Open'V'M'S)");
+ ("??pragma% ignored (applies only to Open'V'M'S)");
end if;
return;
@@ -11564,7 +11568,7 @@
Check_Arg_Is_One_Of (Arg1, Name_D_Float, Name_G_Float);
if not OpenVMS_On_Target then
- Error_Pragma ("?pragma% ignored (applies only to Open'V'M'S)");
+ Error_Pragma ("??pragma% ignored (applies only to Open'V'M'S)");
end if;
-- D_Float case
@@ -12468,7 +12472,7 @@
elsif VM_Target /= No_VM then
if not GNAT_Mode then
Error_Pragma
- ("?pragma% ignored in this configuration");
+ ("??pragma% ignored in this configuration");
end if;
-- Normal case where we do the pack action
@@ -12494,7 +12498,7 @@
if VM_Target /= No_VM then
if not GNAT_Mode then
Error_Pragma
- ("?pragma% ignored in this configuration");
+ ("??pragma% ignored in this configuration");
end if;
-- Normal case of pack request active
@@ -12639,7 +12643,7 @@
if Has_Pragma_Preelab_Init (Ent)
and then Warn_On_Redundant_Constructs
then
- Error_Pragma ("?duplicate pragma%!");
+ Error_Pragma ("?r?duplicate pragma%!");
else
Set_Has_Pragma_Preelab_Init (Ent);
end if;
@@ -13314,7 +13318,7 @@
or else
Has_Rep_Pragma (Def_Id, Name_Psect_Object)
then
- Error_Msg_N ("?duplicate Common/Psect_Object pragma", N);
+ Error_Msg_N ("??duplicate Common/Psect_Object pragma", N);
end if;
if Ekind (Def_Id) = E_Constant then
@@ -13338,7 +13342,7 @@
and then Warn_On_Export_Import
then
Error_Msg_N
- ("?object for pragma % has defaults", Internal);
+ ("?x?object for pragma % has defaults", Internal);
exit;
else
@@ -13522,7 +13526,7 @@
and then Warn_On_Redundant_Constructs
then
Error_Msg_NE
- ("pragma Pure_Function on& is redundant?",
+ ("pragma Pure_Function on& is redundant?r?",
N, Entity (E_Id));
end if;
end if;
@@ -13728,8 +13732,10 @@
Set_Ravenscar_Profile (N);
if Warn_On_Obsolescent_Feature then
- Error_Msg_N ("pragma Ravenscar is an obsolescent feature?", N);
- Error_Msg_N ("|use pragma Profile (Ravenscar) instead", N);
+ Error_Msg_N
+ ("pragma Ravenscar is an obsolescent feature?j?", N);
+ Error_Msg_N
+ ("|use pragma Profile (Ravenscar) instead?j?", N);
end if;
-------------------------
@@ -13747,8 +13753,10 @@
if Warn_On_Obsolescent_Feature then
Error_Msg_N
- ("pragma Restricted_Run_Time is an obsolescent feature?", N);
- Error_Msg_N ("|use pragma Profile (Restricted) instead", N);
+ ("pragma Restricted_Run_Time is an obsolescent feature?j?",
+ N);
+ Error_Msg_N
+ ("|use pragma Profile (Restricted) instead?j?", N);
end if;
------------------
@@ -14939,7 +14947,7 @@
end if;
if not AAMP_On_Target then
- Error_Pragma ("?pragma% ignored (applies only to AAMP)");
+ Error_Pragma ("??pragma% ignored (applies only to AAMP)");
end if;
----------------
@@ -15432,7 +15440,7 @@
if Err then
Error_Msg
- ("?pragma Warnings On with no " &
+ ("??pragma Warnings On with no " &
"matching Warnings Off",
Loc);
end if;
Index: sem_util.adb
===================================================================
--- sem_util.adb (revision 194776)
+++ sem_util.adb (working copy)
@@ -444,8 +444,8 @@
begin
if Has_Predicates (Typ) then
if Is_Generic_Actual_Type (Typ) then
- Error_Msg_FE (Msg & '?', N, Typ);
- Error_Msg_F ("\Program_Error will be raised at run time?", N);
+ Error_Msg_FE (Msg & "??", N, Typ);
+ Error_Msg_F ("\Program_Error will be raised at run time??", N);
Insert_Action (N,
Make_Raise_Program_Error (Sloc (N),
Reason => PE_Bad_Predicated_Generic_Type));
@@ -1576,7 +1576,7 @@
then
Error_Msg_N
("result may differ if evaluated "
- & "after other actual in expression?", Act1);
+ & "after other actual in expression??", Act1);
end if;
end if;
end loop;
@@ -1610,7 +1610,7 @@
while Present (S) and then S /= Standard_Standard loop
if Is_Protected_Type (S) then
Error_Msg_N
- ("potentially blocking operation in protected operation?", N);
+ ("potentially blocking operation in protected operation??", N);
return;
end if;
@@ -1724,7 +1724,7 @@
Object_Access_Level (Context)
then
Error_Msg_N
- ("?possible unprotected access to protected data", Expr);
+ ("??possible unprotected access to protected data", Expr);
end if;
end if;
end Check_Unprotected_Access;
@@ -2249,8 +2249,8 @@
Loc : Source_Ptr := No_Location;
Warn : Boolean := False) return Node_Id
is
- Msgc : String (1 .. Msg'Length + 2);
- -- Copy of message, with room for possible ? and ! at end
+ Msgc : String (1 .. Msg'Length + 3);
+ -- Copy of message, with room for possible ?? and ! at end
Msgl : Natural;
Wmsg : Boolean;
@@ -2291,11 +2291,15 @@
then
Msgl := Msgl + 1;
Msgc (Msgl) := '?';
+ Msgl := Msgl + 1;
+ Msgc (Msgl) := '?';
Wmsg := True;
elsif In_Instance_Not_Visible then
Msgl := Msgl + 1;
Msgc (Msgl) := '?';
+ Msgl := Msgl + 1;
+ Msgc (Msgl) := '?';
Wmsg := True;
-- Otherwise we have a real error message (Ada 95 static case)
@@ -2413,19 +2417,19 @@
and then not Comes_From_Source (Conc_Typ)
then
Error_Msg_NEL
- ("\?& will be raised at run time",
+ ("\??& will be raised at run time",
N, Standard_Constraint_Error, Eloc);
else
Error_Msg_NEL
- ("\?& will be raised for objects of this type",
+ ("\??& will be raised for objects of this type",
N, Standard_Constraint_Error, Eloc);
end if;
end;
else
Error_Msg_NEL
- ("\?& will be raised at run time",
+ ("\??& will be raised at run time",
N, Standard_Constraint_Error, Eloc);
end if;
@@ -3863,7 +3867,7 @@
Is_Potentially_Use_Visible (C))
then
Error_Msg_Sloc := Sloc (C);
- Error_Msg_N ("declaration hides &#?", Def_Id);
+ Error_Msg_N ("declaration hides &#?h?", Def_Id);
end if;
end Enter_Name;
@@ -11258,7 +11262,8 @@
-- sure this is a modification.
if Has_Pragma_Unmodified (Ent) and then Sure then
- Error_Msg_NE ("?pragma Unmodified given for &!", N, Ent);
+ Error_Msg_NE
+ ("??pragma Unmodified given for &!", N, Ent);
end if;
Set_Never_Set_In_Source (Ent, False);
@@ -11348,8 +11353,8 @@
then
Error_Msg_Sloc := Sloc (A);
Error_Msg_NE
- ("constant& may be modified via address clause#?",
- N, Entity (Prefix (Exp)));
+ ("constant& may be modified via address "
+ & "clause#??", N, Entity (Prefix (Exp)));
end if;
end;
end if;
@@ -11600,16 +11605,15 @@
end Return_Master_Scope_Depth_Of_Call;
end if;
- -- For convenience we handle qualified expressions, even though
- -- they aren't technically object names.
+ -- For convenience we handle qualified expressions, even though they
+ -- aren't technically object names.
elsif Nkind (Obj) = N_Qualified_Expression then
return Object_Access_Level (Expression (Obj));
- -- Otherwise return the scope level of Standard.
- -- (If there are cases that fall through
- -- to this point they will be treated as
- -- having global accessibility for now. ???)
+ -- Otherwise return the scope level of Standard. (If there are cases
+ -- that fall through to this point they will be treated as having
+ -- global accessibility for now. ???)
else
return Scope_Depth (Standard_Standard);
Index: sem_res.adb
===================================================================
--- sem_res.adb (revision 194784)
+++ sem_res.adb (working copy)
@@ -577,7 +577,7 @@
-- Warn about the danger
Error_Msg_N
- ("?creation of & object may raise Storage_Error!",
+ ("??creation of & object may raise Storage_Error!",
Scope (Disc));
<<No_Danger>>
@@ -769,8 +769,8 @@
and then Nkind (Parent (P)) = N_Subprogram_Body
and then Is_Empty_List (Declarations (Parent (P)))
then
- Error_Msg_N ("!?infinite recursion", N);
- Error_Msg_N ("\!?Storage_Error will be raised at run time", N);
+ Error_Msg_N ("!??infinite recursion", N);
+ Error_Msg_N ("\!??Storage_Error will be raised at run time", N);
Insert_Action (N,
Make_Raise_Storage_Error (Sloc (N),
Reason => SE_Infinite_Recursion));
@@ -867,8 +867,8 @@
end if;
end loop;
- Error_Msg_N ("!?possible infinite recursion", N);
- Error_Msg_N ("\!?Storage_Error may be raised at run time", N);
+ Error_Msg_N ("!??possible infinite recursion", N);
+ Error_Msg_N ("\!??Storage_Error may be raised at run time", N);
return True;
end Check_Infinite_Recursion;
@@ -3963,14 +3963,14 @@
if Is_Controlling_Formal (F) then
Apply_Compile_Time_Constraint_Error
(N => A,
- Msg => "null value not allowed here?",
+ Msg => "null value not allowed here??",
Reason => CE_Access_Check_Failed);
elsif Ada_Version >= Ada_2005 then
Apply_Compile_Time_Constraint_Error
(N => A,
Msg => "(Ada 2005) null not allowed in "
- & "null-excluding formal?",
+ & "null-excluding formal??",
Reason => CE_Null_Not_Allowed);
end if;
end if;
@@ -4448,9 +4448,9 @@
Deepest_Type_Access_Level (Typ)
then
if In_Instance_Body then
- Error_Msg_N ("?type in allocator has deeper level than" &
+ Error_Msg_N ("??type in allocator has deeper level than" &
" designated class-wide type", E);
- Error_Msg_N ("\?Program_Error will be raised at run time",
+ Error_Msg_N ("\??Program_Error will be raised at run time",
E);
Rewrite (N,
Make_Raise_Program_Error (Sloc (N),
@@ -4556,8 +4556,8 @@
and then Ekind (Current_Scope) = E_Package
and then not In_Package_Body (Current_Scope)
then
- Error_Msg_N ("?cannot activate task before body seen", N);
- Error_Msg_N ("\?Program_Error will be raised at run time", N);
+ Error_Msg_N ("??cannot activate task before body seen", N);
+ Error_Msg_N ("\??Program_Error will be raised at run time", N);
end if;
-- Ada 2012 (AI05-0111-3): Detect an attempt to allocate a task or a
@@ -4569,8 +4569,8 @@
and then Present (Subpool_Handle_Name (N))
and then Has_Task (Desig_T)
then
- Error_Msg_N ("?cannot allocate task on subpool", N);
- Error_Msg_N ("\?Program_Error will be raised at run time", N);
+ Error_Msg_N ("??cannot allocate task on subpool", N);
+ Error_Msg_N ("\??Program_Error will be raised at run time", N);
Rewrite (N,
Make_Raise_Program_Error (Sloc (N),
@@ -5026,24 +5026,24 @@
then
Error_Msg_N
("float division by zero, " &
- "may generate '+'/'- infinity?", Right_Opnd (N));
+ "may generate '+'/'- infinity??", Right_Opnd (N));
-- For all other cases, we get a Constraint_Error
else
Apply_Compile_Time_Constraint_Error
- (N, "division by zero?", CE_Divide_By_Zero,
+ (N, "division by zero??", CE_Divide_By_Zero,
Loc => Sloc (Right_Opnd (N)));
end if;
when N_Op_Rem =>
Apply_Compile_Time_Constraint_Error
- (N, "rem with zero divisor?", CE_Divide_By_Zero,
+ (N, "rem with zero divisor??", CE_Divide_By_Zero,
Loc => Sloc (Right_Opnd (N)));
when N_Op_Mod =>
Apply_Compile_Time_Constraint_Error
- (N, "mod with zero divisor?", CE_Divide_By_Zero,
+ (N, "mod with zero divisor??", CE_Divide_By_Zero,
Loc => Sloc (Right_Opnd (N)));
-- Division by zero can only happen with division, rem,
@@ -5285,10 +5285,10 @@
then
Rtype := Etype (N);
Error_Msg_NE
- ("?& should not be used in entry body (RM C.7(17))",
+ ("??& should not be used in entry body (RM C.7(17))",
N, Nam);
Error_Msg_NE
- ("\Program_Error will be raised at run time?", N, Nam);
+ ("\Program_Error will be raised at run time??", N, Nam);
Rewrite (N,
Make_Raise_Program_Error (Loc,
Reason => PE_Current_Task_In_Entry_Body));
@@ -5578,9 +5578,9 @@
Set_Has_Recursive_Call (Nam);
Error_Msg_N
- ("?possible infinite recursion!", N);
+ ("??possible infinite recursion!", N);
Error_Msg_N
- ("\?Storage_Error may be raised at run time!", N);
+ ("\??Storage_Error may be raised at run time!", N);
end if;
exit Scope_Loop;
@@ -5898,8 +5898,8 @@
end loop;
if not Call_OK then
- Error_Msg_N ("!? cannot determine tag of result", N);
- Error_Msg_N ("!? Program_Error will be raised", N);
+ Error_Msg_N ("!?? cannot determine tag of result", N);
+ Error_Msg_N ("!?? Program_Error will be raised", N);
Insert_Action (N,
Make_Raise_Program_Error (Sloc (N),
Reason => PE_Explicit_Raise));
@@ -6100,7 +6100,7 @@
-- Check comparison on unordered enumeration
if Bad_Unordered_Enumeration_Reference (N, Etype (L)) then
- Error_Msg_N ("comparison on unordered enumeration type?", N);
+ Error_Msg_N ("comparison on unordered enumeration type?U?", N);
end if;
-- Evaluate the relation (note we do this after the above check since
@@ -6939,7 +6939,7 @@
and then Comes_From_Source (R)
then
Error_Msg_N -- CODEFIX
- ("?comparison with True is redundant!", R);
+ ("?r?comparison with True is redundant!", R);
end if;
Check_Unset_Reference (L);
@@ -7322,9 +7322,9 @@
and then Is_Bit_Packed_Array (Array_Type)
and then Is_LHS (N)
then
- Error_Msg_N ("?assignment to component of packed atomic array",
+ Error_Msg_N ("??assignment to component of packed atomic array",
Prefix (N));
- Error_Msg_N ("?\may cause unexpected accesses to atomic object",
+ Error_Msg_N ("??\may cause unexpected accesses to atomic object",
Prefix (N));
end if;
end Resolve_Indexed_Component;
@@ -7700,7 +7700,7 @@
while Present (Alt) loop
if Is_Static_Expression (Alt)
and then (Nkind_In (Alt, N_Integer_Literal,
- N_Character_Literal)
+ N_Character_Literal)
or else Nkind (Alt) in N_Has_Entity)
then
Nalts := Nalts + 1;
@@ -7709,7 +7709,7 @@
for J in 1 .. Nalts - 1 loop
if Alts (J).Val = Alts (Nalts).Val then
Error_Msg_Sloc := Sloc (Alts (J).Alt);
- Error_Msg_N ("duplicate of value given#?", Alt);
+ Error_Msg_N ("duplicate of value given#??", Alt);
end if;
end loop;
end if;
@@ -7838,7 +7838,7 @@
if not Inside_Init_Proc then
Insert_Action
(Compile_Time_Constraint_Error (N,
- "(Ada 2005) null not allowed in null-excluding objects?"),
+ "(Ada 2005) null not allowed in null-excluding objects??"),
Make_Raise_Constraint_Error (Loc,
Reason => CE_Access_Check_Failed));
else
@@ -8308,7 +8308,7 @@
and then not Is_Boolean_Type (Typ)
and then Parent_Is_Boolean
then
- Error_Msg_N ("?not expression should be parenthesized here!", N);
+ Error_Msg_N ("?q?not expression should be parenthesized here!", N);
end if;
-- Warn on double negation if checking redundant constructs
@@ -8319,7 +8319,7 @@
and then Root_Type (Typ) = Standard_Boolean
and then Nkind (Right_Opnd (N)) = N_Op_Not
then
- Error_Msg_N ("redundant double negation?", N);
+ Error_Msg_N ("redundant double negation?r?", N);
end if;
-- Complete resolution and evaluation of NOT
@@ -8459,7 +8459,7 @@
and then not First_Last_Ref
then
- Error_Msg ("subrange of unordered enumeration type?", Sloc (N));
+ Error_Msg ("subrange of unordered enumeration type?U?", Sloc (N));
end if;
Check_Unset_Reference (L);
@@ -8546,7 +8546,7 @@
and then Warn_On_Bad_Fixed_Value
then
Error_Msg_N
- ("?static fixed-point value is not a multiple of Small!",
+ ("?b?static fixed-point value is not a multiple of Small!",
N);
end if;
@@ -8796,9 +8796,9 @@
and then Is_LHS (N)
then
Error_Msg_N
- ("?assignment to component of packed atomic record", Prefix (N));
+ ("??assignment to component of packed atomic record", Prefix (N));
Error_Msg_N
- ("?\may cause unexpected accesses to atomic object", Prefix (N));
+ ("\??may cause unexpected accesses to atomic object", Prefix (N));
end if;
Analyze_Dimension (N);
@@ -8891,7 +8891,7 @@
-- of the First_Node call here.
Error_Msg_F
- ("?assertion would fail at run time!",
+ ("??assertion would fail at run time!",
Expression
(First (Pragma_Argument_Associations (Orig))));
end if;
@@ -8906,10 +8906,9 @@
declare
Expr : constant Node_Id :=
- Original_Node
- (Expression
- (Next (First
- (Pragma_Argument_Associations (Orig)))));
+ Original_Node
+ (Expression
+ (Next (First (Pragma_Argument_Associations (Orig)))));
begin
if Is_Entity_Name (Expr)
and then Entity (Expr) = Standard_False
@@ -8923,7 +8922,7 @@
-- comment above for an explanation of why we do this.
Error_Msg_F
- ("?check would fail at run time!",
+ ("??check would fail at run time!",
Expression
(Last (Pragma_Argument_Associations (Orig))));
end if;
@@ -9329,7 +9328,8 @@
or else Char_Val > Expr_Value (Comp_Typ_Hi)
then
Apply_Compile_Time_Constraint_Error
- (N, "character out of range?", CE_Range_Check_Failed,
+ (N, "character out of range??",
+ CE_Range_Check_Failed,
Loc => Source_Ptr (Int (Loc) + J));
end if;
end loop;
@@ -9474,11 +9474,10 @@
and then abs (Realval (Rop)) < Delta_Value (Standard_Duration)
then
Error_Msg_N
- ("?universal real operand can only " &
- "be interpreted as Duration!",
- Rop);
+ ("??universal real operand can only " &
+ "be interpreted as Duration!", Rop);
Error_Msg_N
- ("\?precision will be lost in the conversion!", Rop);
+ ("\??precision will be lost in the conversion!", Rop);
end if;
elsif Is_Numeric_Type (Typ)
@@ -9654,15 +9653,17 @@
-- entity, give the name of the entity in the message. If not,
-- just mention the expression.
+ -- Shoudn't we test Warn_On_Redundant_Constructs here ???
+
else
if Is_Entity_Name (Orig_N) then
Error_Msg_Node_2 := Orig_T;
Error_Msg_NE -- CODEFIX
- ("?redundant conversion, & is of type &!",
+ ("??redundant conversion, & is of type &!",
N, Entity (Orig_N));
else
Error_Msg_NE
- ("?redundant conversion, expression is of type&!",
+ ("??redundant conversion, expression is of type&!",
N, Orig_T);
end if;
end if;
@@ -9830,7 +9831,7 @@
if OK and then Hi >= Lo and then Lo >= 0 then
Error_Msg_N -- CODEFIX
- ("?abs applied to known non-negative value has no effect", N);
+ ("?r?abs applied to known non-negative value has no effect", N);
end if;
end if;
@@ -9968,8 +9969,10 @@
-- If we fall through warning should be issued
+ -- Shouldn't we test Warn_On_Questionable_Missing_Parens ???
+
Error_Msg_N
- ("?unary minus expression should be parenthesized here!", N);
+ ("??unary minus expression should be parenthesized here!", N);
end if;
end if;
end;
@@ -10443,9 +10446,11 @@
end loop;
if Nkind (N) = N_Real_Literal then
- Error_Msg_NE ("?real literal interpreted as }!", N, T1);
+ Error_Msg_NE
+ ("??real literal interpreted as }!", N, T1);
else
- Error_Msg_NE ("?universal_fixed expression interpreted as }!", N, T1);
+ Error_Msg_NE
+ ("??universal_fixed expression interpreted as }!", N, T1);
end if;
return T1;
@@ -10628,10 +10633,10 @@
then
if In_Instance_Body then
Error_Msg_N
- ("?source array type has " &
+ ("??source array type has " &
"deeper accessibility level than target", Operand);
Error_Msg_N
- ("\?Program_Error will be raised at run time",
+ ("\??Program_Error will be raised at run time",
Operand);
Rewrite (N,
Make_Raise_Program_Error (Sloc (N),
@@ -10915,10 +10920,10 @@
if In_Instance_Body then
Error_Msg_N
- ("?cannot convert local pointer to non-local access type",
+ ("??cannot convert local pointer to non-local access type",
Operand);
Error_Msg_N
- ("\?Program_Error will be raised at run time", Operand);
+ ("\??Program_Error will be raised at run time", Operand);
else
Error_Msg_N
@@ -10948,10 +10953,11 @@
if In_Instance_Body then
Error_Msg_N
- ("?cannot convert access discriminant to non-local" &
+ ("??cannot convert access discriminant to non-local" &
" access type", Operand);
Error_Msg_N
- ("\?Program_Error will be raised at run time", Operand);
+ ("\??Program_Error will be raised at run time",
+ Operand);
else
Error_Msg_N
("cannot convert access discriminant to non-local" &
@@ -11092,10 +11098,10 @@
if In_Instance_Body then
Error_Msg_N
- ("?cannot convert local pointer to non-local access type",
+ ("??cannot convert local pointer to non-local access type",
Operand);
Error_Msg_N
- ("\?Program_Error will be raised at run time", Operand);
+ ("\??Program_Error will be raised at run time", Operand);
else
-- Avoid generation of spurious error message
@@ -11130,10 +11136,10 @@
if In_Instance_Body then
Error_Msg_N
- ("?cannot convert access discriminant to non-local" &
- " access type", Operand);
+ ("??cannot convert access discriminant to non-local"
+ & " access type", Operand);
Error_Msg_N
- ("\?Program_Error will be raised at run time",
+ ("\??Program_Error will be raised at run time",
Operand);
else
Index: sem_attr.adb
===================================================================
--- sem_attr.adb (revision 194780)
+++ sem_attr.adb (working copy)
@@ -739,7 +739,7 @@
if Is_CPP_Class (Root_Type (Typ)) then
Error_Msg_N
- ("?current instance unsupported for derivations of "
+ ("??current instance unsupported for derivations of "
& "'C'P'P types", N);
end if;
@@ -2019,7 +2019,7 @@
if not Attribute_83 (Attr_Id) then
if Ada_Version = Ada_83 and then Comes_From_Source (N) then
Error_Msg_Name_1 := Aname;
- Error_Msg_N ("(Ada 83) attribute% is not standard?", N);
+ Error_Msg_N ("(Ada 83) attribute% is not standard??", N);
end if;
if Attribute_Impl_Def (Attr_Id) then
@@ -2640,7 +2640,7 @@
and then Warn_On_Redundant_Constructs
then
Error_Msg_NE -- CODEFIX
- ("?redundant attribute, & is its own base type", N, Typ);
+ ("?r?redundant attribute, & is its own base type", N, Typ);
end if;
if Nkind (Parent (N)) /= N_Attribute_Reference then
@@ -2896,7 +2896,7 @@
if Warn_On_Obsolescent_Feature then
Error_Msg_N
("constrained for private type is an " &
- "obsolescent feature (RM J.4)?", N);
+ "obsolescent feature (RM J.4)?j?", N);
end if;
-- If we are within an instance, the attribute must be legal
@@ -4346,7 +4346,7 @@
and then Is_Constant_Object (Entity (P))
then
Error_Msg_N
- ("?attribute Old applied to constant has no effect", P);
+ ("??attribute Old applied to constant has no effect", P);
end if;
-- The attribute appears within a pre/postcondition, but refers to
@@ -4603,7 +4603,7 @@
and then Warn_On_Redundant_Constructs
then
Error_Msg_N
- ("postconditions on inlined functions not enforced?", N);
+ ("postconditions on inlined functions not enforced?r?", N);
end if;
-- If we are in the scope of a function and in Spec_Expression mode,
@@ -5032,10 +5032,10 @@
Name_Simple_Storage_Pool_Type))
then
Error_Msg_Name_1 := Aname;
- Error_Msg_N ("cannot use % attribute for type with simple " &
- "storage pool?", N);
+ Error_Msg_N ("cannot use % attribute for type with simple "
+ & "storage pool??", N);
Error_Msg_N
- ("\Program_Error will be raised at run time?", N);
+ ("\Program_Error will be raised at run time??", N);
Rewrite
(N, Make_Raise_Program_Error
@@ -5228,8 +5228,8 @@
if not Is_Tagged_Type (P_Type) then
Error_Attr_P ("prefix of % attribute must be tagged");
- -- Next test does not apply to generated code
- -- why not, and what does the illegal reference mean???
+ -- Next test does not apply to generated code why not, and what does
+ -- the illegal reference mean???
elsif Is_Object_Reference (P)
and then not Is_Class_Wide_Type (P_Type)
@@ -5240,9 +5240,9 @@
"of class - wide type");
end if;
- -- The prefix cannot be an incomplete type. However, references
- -- to 'Tag can be generated when expanding interface conversions,
- -- and this is legal.
+ -- The prefix cannot be an incomplete type. However, references to
+ -- 'Tag can be generated when expanding interface conversions, and
+ -- this is legal.
if Comes_From_Source (N) then
Check_Not_Incomplete_Type;
@@ -5728,8 +5728,8 @@
begin
if Present (Pred_Func) and then Current_Scope = Pred_Func then
Error_Msg_N
- ("attribute Valid requires a predicate check?", N);
- Error_Msg_N ("\and will result in infinite recursion?", N);
+ ("attribute Valid requires a predicate check??", N);
+ Error_Msg_N ("\and will result in infinite recursion??", N);
end if;
end;
@@ -5744,7 +5744,7 @@
Check_Object_Reference (P);
if No_Scalar_Parts (P_Type) then
- Error_Attr_P ("?attribute % always True, no scalars to check");
+ Error_Attr_P ("??attribute % always True, no scalars to check");
end if;
Set_Etype (N, Standard_Boolean);
@@ -6095,7 +6095,7 @@
elsif Is_Out_Of_Range (N, T) then
Apply_Compile_Time_Constraint_Error
- (N, "value not in range of}?", CE_Range_Check_Failed);
+ (N, "value not in range of}??", CE_Range_Check_Failed);
elsif not Range_Checks_Suppressed (T) then
Enable_Range_Check (N);
@@ -8894,9 +8894,10 @@
-- 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
- ("\?Program_Error will be raised at run time", P);
+ ("??non-local pointer cannot point to local object", P);
+ Error_Msg_F
+ ("\??Program_Error will be raised at run time", P);
Rewrite (N,
Make_Raise_Program_Error (Loc,
Reason => PE_Accessibility_Check_Failed));
@@ -9368,9 +9369,9 @@
if In_Instance_Body then
Error_Msg_F
- ("?non-local pointer cannot point to local object", P);
+ ("??non-local pointer cannot point to local object", P);
Error_Msg_F
- ("\?Program_Error will be raised at run time", P);
+ ("\??Program_Error will be raised at run time", P);
Rewrite (N,
Make_Raise_Program_Error (Loc,
Reason => PE_Accessibility_Check_Failed));
@@ -9484,11 +9485,13 @@
declare
D : constant Node_Id := Declaration_Node (Entity (P));
begin
- Error_Msg_N ("aliased object has explicit bounds?",
- D);
- Error_Msg_N ("\declare without bounds"
- & " (and with explicit initialization)?", D);
- Error_Msg_N ("\for use with unconstrained access?", D);
+ Error_Msg_N
+ ("aliased object has explicit bounds??", D);
+ Error_Msg_N
+ ("\declare without bounds (and with explicit "
+ & "initialization)??", D);
+ Error_Msg_N
+ ("\for use with unconstrained access??", D);
end;
end if;
end if;
Index: sem_case.adb
===================================================================
--- sem_case.adb (revision 194776)
+++ sem_case.adb (working copy)
@@ -601,8 +601,8 @@
and then Comes_From_Source (Others_Choice)
and then Is_Empty_List (Choice_List)
then
- Error_Msg_N ("?OTHERS choice is redundant", Others_Choice);
- Error_Msg_N ("\previous choices cover all values", Others_Choice);
+ Error_Msg_N ("?r?OTHERS choice is redundant", Others_Choice);
+ Error_Msg_N ("\?r?previous choices cover all values", Others_Choice);
end if;
end Expand_Others_Choice;
Index: sem_elab.adb
===================================================================
--- sem_elab.adb (revision 194776)
+++ sem_elab.adb (working copy)
@@ -908,8 +908,8 @@
if Inst_Case then
Elab_Warning
- ("instantiation of& may raise Program_Error?",
- "info: instantiation of& during elaboration?", Ent);
+ ("instantiation of& may raise Program_Error?l?",
+ "info: instantiation of& during elaboration?l?", Ent);
-- Indirect call case, warning only in static elaboration
-- case, because the attribute reference itself cannot raise
@@ -917,7 +917,7 @@
elsif Access_Case then
Elab_Warning
- ("", "info: access to& during elaboration?", Ent);
+ ("", "info: access to& during elaboration?l?", Ent);
-- Subprogram call case
@@ -927,14 +927,14 @@
and then Comes_From_Source (Ent)
then
Elab_Warning
- ("implicit call to & may raise Program_Error?",
- "info: implicit call to & during elaboration?",
+ ("implicit call to & may raise Program_Error?l?",
+ "info: implicit call to & during elaboration?l?",
Ent);
else
Elab_Warning
- ("call to & may raise Program_Error?",
- "info: call to & during elaboration?",
+ ("call to & may raise Program_Error?l?",
+ "info: call to & during elaboration?l?",
Ent);
end if;
end if;
@@ -943,14 +943,14 @@
if Nkind (N) in N_Subprogram_Instantiation then
Elab_Warning
- ("\missing pragma Elaborate for&?",
- "\info: implicit pragma Elaborate for& generated?",
+ ("\missing pragma Elaborate for&?l?",
+ "\info: implicit pragma Elaborate for& generated?l?",
W_Scope);
else
Elab_Warning
- ("\missing pragma Elaborate_All for&?",
- "\info: implicit pragma Elaborate_All for & generated?",
+ ("\missing pragma Elaborate_All for&?l?",
+ "\info: implicit pragma Elaborate_All for & generated?l?",
W_Scope);
end if;
end Generate_Elab_Warnings;
@@ -1030,7 +1030,7 @@
Error_Msg_Node_2 := W_Scope;
Error_Msg_NE
("call to& in elaboration code " &
- "requires pragma Elaborate_All on&?", N, E);
+ "requires pragma Elaborate_All on&??", N, E);
end if;
-- Set indication for binder to generate Elaborate_All
@@ -1138,13 +1138,13 @@
-- Here we definitely have a bad instantiation
- Error_Msg_NE ("?cannot instantiate& before body seen", N, Ent);
+ Error_Msg_NE ("??cannot instantiate& before body seen", N, Ent);
if Present (Instance_Spec (N)) then
Supply_Bodies (Instance_Spec (N));
end if;
- Error_Msg_N ("\?Program_Error will be raised at run time", N);
+ Error_Msg_N ("\??Program_Error will be raised at run time", N);
Insert_Elab_Check (N);
Set_ABE_Is_Certain (N);
end Check_Bad_Instantiation;
@@ -1720,13 +1720,13 @@
Error_Msg_Sloc := Sloc (Ent);
Error_Msg_NE
- ("?elaboration code may access& before it is initialized",
+ ("??elaboration code may access& before it is initialized",
N, Ent);
Error_Msg_NE
- ("\?suggest adding pragma Elaborate_Body to spec of &",
+ ("\??suggest adding pragma Elaborate_Body to spec of &",
N, Scop);
Error_Msg_N
- ("\?or an explicit initialization could be added #", N);
+ ("\??or an explicit initialization could be added #", N);
end if;
if not All_Errors_Mode then
@@ -2181,12 +2181,12 @@
if Elab_Call.Last = 0 then
if Inst_Case then
Error_Msg_NE
- ("?cannot instantiate& before body seen", N, Orig_Ent);
+ ("??cannot instantiate& before body seen", N, Orig_Ent);
else
- Error_Msg_NE ("?cannot call& before body seen", N, Orig_Ent);
+ Error_Msg_NE ("??cannot call& before body seen", N, Orig_Ent);
end if;
- Error_Msg_N ("\?Program_Error will be raised at run time", N);
+ Error_Msg_N ("\??Program_Error will be raised at run time", N);
Insert_Elab_Check (N);
-- Call is not at outer level
@@ -2255,15 +2255,15 @@
then
if Inst_Case then
Error_Msg_NE
- ("instantiation of& may occur before body is seen?",
+ ("instantiation of& may occur before body is seen??",
N, Orig_Ent);
else
Error_Msg_NE
- ("call to& may occur before body is seen?", N, Orig_Ent);
+ ("call to& may occur before body is seen??", N, Orig_Ent);
end if;
Error_Msg_N
- ("\Program_Error may be raised at run time?", N);
+ ("\Program_Error may be raised at run time??", N);
Output_Calls (N);
end if;
@@ -2359,10 +2359,10 @@
Scope (Proc) = Scope (Defining_Identifier (Decl)))
then
Error_Msg_N
- ("task will be activated before elaboration of its body?",
+ ("task will be activated before elaboration of its body??",
Decl);
Error_Msg_N
- ("\Program_Error will be raised at run time?", Decl);
+ ("\Program_Error will be raised at run time??", Decl);
elsif
Present (Corresponding_Body (Unit_Declaration_Node (Proc)))
@@ -2506,7 +2506,7 @@
Error_Msg_Node_2 := Task_Scope;
Error_Msg_NE
("activation of an instance of task type&" &
- " requires pragma Elaborate_All on &?", N, Ent);
+ " requires pragma Elaborate_All on &??", N, Ent);
end if;
Activate_Elaborate_All_Desirable (N, Task_Scope);
@@ -3082,16 +3082,16 @@
Ent := Elab_Call.Table (J).Ent;
if Is_Generic_Unit (Ent) then
- Error_Msg_NE ("\?& instantiated #", N, Ent);
+ Error_Msg_NE ("\??& instantiated #", N, Ent);
elsif Is_Init_Proc (Ent) then
- Error_Msg_N ("\?initialization procedure called #", N);
+ Error_Msg_N ("\??initialization procedure called #", N);
elsif Is_Printable_Error_Name (Chars (Ent)) then
- Error_Msg_NE ("\?& called #", N, Ent);
+ Error_Msg_NE ("\??& called #", N, Ent);
else
- Error_Msg_N ("\? called #", N);
+ Error_Msg_N ("\?? called #", N);
end if;
end loop;
end Output_Calls;
Index: exp_ch4.adb
===================================================================
--- exp_ch4.adb (revision 194776)
+++ exp_ch4.adb (working copy)
@@ -3686,7 +3686,7 @@
Kill_Dead_Code (Declaration_Node (Entity (High_Bound)));
Apply_Compile_Time_Constraint_Error
(N => Cnode,
- Msg => "concatenation result upper bound out of range?",
+ Msg => "concatenation result upper bound out of range??",
Reason => CE_Range_Check_Failed);
end Expand_Concatenate;
@@ -5501,9 +5501,10 @@
-- actually eliminated the danger of optimization above.
if Overflow_Check_Mode not in Minimized_Or_Eliminated then
- Error_Msg_N ("?explicit membership test may be optimized away", N);
+ Error_Msg_N
+ ("??explicit membership test may be optimized away", N);
Error_Msg_N -- CODEFIX
- ("\?use ''Valid attribute instead", N);
+ ("\??use ''Valid attribute instead", N);
end if;
return;
@@ -5684,8 +5685,8 @@
if Lcheck = LT or else Ucheck = GT then
if Warn1 then
- Error_Msg_N ("?range test optimized away", N);
- Error_Msg_N ("\?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, New_Reference_To (Standard_False, Loc));
@@ -5698,8 +5699,8 @@
elsif Lcheck in Compare_GE and then Ucheck in Compare_LE then
if Warn1 then
- Error_Msg_N ("?range test optimized away", N);
- Error_Msg_N ("\?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, New_Reference_To (Standard_True, Loc));
@@ -5713,8 +5714,8 @@
elsif Lcheck in Compare_GE then
if Warn2 and then not In_Instance then
- Error_Msg_N ("?lower bound test optimized away", Lo);
- Error_Msg_N ("\?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,
@@ -5730,8 +5731,8 @@
elsif Ucheck in Compare_LE then
if Warn2 and then not In_Instance then
- Error_Msg_N ("?upper bound test optimized away", Hi);
- Error_Msg_N ("\?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,
@@ -5755,25 +5756,25 @@
if Lcheck = LT or else Ucheck = GT then
Error_Msg_N
- ("?value can only be in range if it is invalid", 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
- ("?value can only be out of range if it is invalid", 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
- ("?lower bound check only fails if it is invalid", Lo);
+ ("??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
- ("?upper bound check only fails for invalid values", Hi);
+ ("??upper bound check only fails for invalid values", Hi);
end if;
end if;
end;
@@ -9665,9 +9666,10 @@
Reason => PE_Accessibility_Check_Failed));
Set_Etype (N, Target_Type);
- Error_Msg_N ("?accessibility check failure", N);
+ Error_Msg_N
+ ("??accessibility check failure", N);
Error_Msg_NE
- ("\?& will be raised at run time", N, Standard_Program_Error);
+ ("\??& will be raised at run time", N, Standard_Program_Error);
end Raise_Accessibility_Error;
----------------------
@@ -10632,7 +10634,7 @@
end if;
-- Otherwise force evaluation unless Assignment_OK flag is set (this
- -- flag indicates ??? -- more comments needed here)
+ -- flag indicates ??? More comments needed here)
if Assignment_OK (N) then
null;
@@ -12061,7 +12063,7 @@
if Constant_Condition_Warnings
and then Comes_From_Source (Original_Node (N))
then
- Error_Msg_N ("could replace by ""'=""?", N);
+ Error_Msg_N ("could replace by ""'=""?c?", N);
end if;
Op := N_Op_Eq;
@@ -12254,7 +12256,8 @@
and then not Has_Warnings_Off (Etype (Left_Opnd (N)))
then
Error_Msg_N
- ("can never be greater than, could replace by ""'=""?", N);
+ ("can never be greater than, could replace by ""'=""?c?",
+ N);
Warning_Generated := True;
end if;
@@ -12279,7 +12282,7 @@
and then not Has_Warnings_Off (Etype (Left_Opnd (N)))
then
Error_Msg_N
- ("can never be less than, could replace by ""'=""?", N);
+ ("can never be less than, could replace by ""'=""?c?", N);
Warning_Generated := True;
end if;
@@ -12312,11 +12315,11 @@
then
if True_Result then
Error_Msg_N
- ("condition can only be False if invalid values present?",
+ ("condition can only be False if invalid values present??",
N);
elsif False_Result then
Error_Msg_N
- ("condition can only be True if invalid values present?",
+ ("condition can only be True if invalid values present??",
N);
end if;
end if;
Index: errout.ads
===================================================================
--- errout.ads (revision 194784)
+++ errout.ads (working copy)
@@ -60,7 +60,7 @@
-- Exception raised if Raise_Exception_On_Error is true
Warning_Doc_Switch : Boolean renames Err_Vars.Warning_Doc_Switch;
- -- If this is set True, then the ??/?x?/?.x? sequences in error messages
+ -- If this is set True, then the ??/?x?/?X? sequences in error messages
-- are active (see errout.ads for details). If this switch is False, then
-- these sequences are ignored (i.e. simply equivalent to a single ?). The
-- -gnatw.d switch sets this flag True, -gnatw.D sets this flag False.
Index: exp_ch11.adb
===================================================================
--- exp_ch11.adb (revision 194776)
+++ exp_ch11.adb (working copy)
@@ -1005,8 +1005,8 @@
then
Warn_No_Exception_Propagation_Active (Handler);
Error_Msg_N
- ("\?this handler can never be entered, and has been removed",
- Handler);
+ ("\?X?this handler can never be entered, "
+ & "and has been removed", Handler);
end if;
if No_Exception_Propagation_Active then
@@ -1808,10 +1808,10 @@
if Configurable_Run_Time_Mode then
Error_Msg_NE
- ("\?& may call Last_Chance_Handler", N, E);
+ ("\?X?& may call Last_Chance_Handler", N, E);
else
Error_Msg_NE
- ("\?& may result in unhandled exception", N, E);
+ ("\?X?& may result in unhandled exception", N, E);
end if;
end if;
end;
@@ -2147,10 +2147,10 @@
if Configurable_Run_Time_Mode then
Error_Msg_N
- ("\?Last_Chance_Handler will be called on exception", N);
+ ("\?X?Last_Chance_Handler will be called on exception", N);
else
Error_Msg_N
- ("\?execution may raise unhandled exception", N);
+ ("\?X?execution may raise unhandled exception", N);
end if;
end if;
end Warn_If_No_Propagation;
@@ -2162,7 +2162,7 @@
procedure Warn_No_Exception_Propagation_Active (N : Node_Id) is
begin
Error_Msg_N
- ("?pragma Restrictions (No_Exception_Propagation) in effect", N);
+ ("?X?pragma Restrictions (No_Exception_Propagation) in effect", N);
end Warn_No_Exception_Propagation_Active;
end Exp_Ch11;
Index: sem_ch4.adb
===================================================================
--- sem_ch4.adb (revision 194776)
+++ sem_ch4.adb (working copy)
@@ -636,7 +636,9 @@
Analyze (Not_Null_Check);
else
- Error_Msg_N ("null value not allowed here?", E);
+ -- Seems weird for the following to be a warning ???
+
+ Error_Msg_N ("null value not allowed here??", E);
end if;
end;
end if;
@@ -2082,7 +2084,8 @@
-- account a possible implicit dereference.
if Is_Access_Type (Array_Type) then
- Error_Msg_NW (Warn_On_Dereference, "?implicit dereference", N);
+ Error_Msg_NW
+ (Warn_On_Dereference, "?d?implicit dereference", N);
Array_Type := Process_Implicit_Dereference_Prefix (Pent, P);
end if;
@@ -2241,7 +2244,8 @@
if Is_Access_Type (Typ) then
Typ := Designated_Type (Typ);
- Error_Msg_NW (Warn_On_Dereference, "?implicit dereference", N);
+ Error_Msg_NW
+ (Warn_On_Dereference, "?d?implicit dereference", N);
end if;
if Is_Array_Type (Typ) then
@@ -2670,7 +2674,7 @@
and then Intval (Right_Opnd (Parent (N))) <= Uint_64
then
Error_Msg_N
- ("suspicious MOD value, was '*'* intended'??", Parent (N));
+ ("suspicious MOD value, was '*'* intended'??M?", Parent (N));
end if;
-- Remaining processing is same as for other arithmetic operators
@@ -3235,7 +3239,7 @@
while Present (It.Typ) loop
if Is_Access_Type (It.Typ) then
T := Designated_Type (It.Typ);
- Error_Msg_NW (Warn_On_Dereference, "?implicit dereference", N);
+ Error_Msg_NW (Warn_On_Dereference, "?d?implicit dereference", N);
else
T := It.Typ;
end if;
@@ -3318,7 +3322,7 @@
then
Insert_Explicit_Dereference (Nam);
Error_Msg_NW
- (Warn_On_Dereference, "?implicit dereference", N);
+ (Warn_On_Dereference, "?d?implicit dereference", N);
end if;
end if;
@@ -3427,13 +3431,13 @@
if All_Present (N) then
Error_Msg_N
- ("?quantified expression with ALL "
+ ("??quantified expression with ALL "
& "over a null range has value True", N);
Rewrite (N, New_Occurrence_Of (Standard_True, Loc));
else
Error_Msg_N
- ("?quantified expression with SOME "
+ ("??quantified expression with SOME "
& "over a null range has value False", N);
Rewrite (N, New_Occurrence_Of (Standard_False, Loc));
end if;
@@ -3810,7 +3814,7 @@
-- Normal case of selected component applied to access type
else
- Error_Msg_NW (Warn_On_Dereference, "?implicit dereference", N);
+ Error_Msg_NW (Warn_On_Dereference, "?d?implicit dereference", N);
if Is_Entity_Name (Name) then
Pent := Entity (Name);
@@ -3922,7 +3926,7 @@
if Is_Access_Type (Etype (Name)) then
Insert_Explicit_Dereference (Name);
- Error_Msg_NW (Warn_On_Dereference, "?implicit dereference", N);
+ Error_Msg_NW (Warn_On_Dereference, "?d?implicit dereference", N);
end if;
elsif Is_Record_Type (Prefix_Type) then
@@ -4220,7 +4224,7 @@
if Is_Access_Type (Etype (Name)) then
Insert_Explicit_Dereference (Name);
Error_Msg_NW
- (Warn_On_Dereference, "?implicit dereference", N);
+ (Warn_On_Dereference, "?d?implicit dereference", N);
end if;
end if;
@@ -4403,7 +4407,7 @@
Ent => Prefix_Type, Rep => False);
else
Apply_Compile_Time_Constraint_Error
- (N, "component not present in }?",
+ (N, "component not present in }??",
CE_Discriminant_Check_Failed,
Ent => Prefix_Type, Rep => False);
end if;
@@ -4537,7 +4541,8 @@
if Is_Access_Type (Typ) then
Typ := Designated_Type (Typ);
- Error_Msg_NW (Warn_On_Dereference, "?implicit dereference", N);
+ Error_Msg_NW
+ (Warn_On_Dereference, "?d?implicit dereference", N);
end if;
if Is_Array_Type (Typ)
@@ -4574,7 +4579,7 @@
if Is_Access_Type (Array_Type) then
Array_Type := Designated_Type (Array_Type);
- Error_Msg_NW (Warn_On_Dereference, "?implicit dereference", N);
+ Error_Msg_NW (Warn_On_Dereference, "?d?implicit dereference", N);
end if;
if not Is_Array_Type (Array_Type) then
Index: sem_mech.adb
===================================================================
--- sem_mech.adb (revision 194776)
+++ sem_mech.adb (working copy)
@@ -245,7 +245,7 @@
if Mech in Descriptor_Codes and then not Is_Formal (Ent) then
if Is_Record_Type (Etype (Ent)) then
- Error_Msg_N ("?records cannot be returned by Descriptor", Enod);
+ Error_Msg_N ("??records cannot be returned by Descriptor", Enod);
return;
end if;
end if;
Index: sem_warn.adb
===================================================================
--- sem_warn.adb (revision 194776)
+++ sem_warn.adb (working copy)
@@ -200,7 +200,7 @@
if No (Asm_Input_Value) then
Error_Msg_F
- ("?code statement with no inputs should usually be Volatile!", N);
+ ("??code statement with no inputs should usually be Volatile!", N);
return;
end if;
@@ -208,7 +208,7 @@
if No (Asm_Output_Variable) then
Error_Msg_F
- ("?code statement with no outputs should usually be Volatile!", N);
+ ("??code statement with no outputs should usually be Volatile!", N);
return;
end if;
end Check_Code_Statement;
@@ -707,9 +707,9 @@
if No_Ref_Found (Loop_Statement) = OK then
Error_Msg_NE
- ("?variable& is not modified in loop body!", Ref, Var);
+ ("??variable& is not modified in loop body!", Ref, Var);
Error_Msg_N
- ("\?possible infinite loop!", Ref);
+ ("\??possible infinite loop!", Ref);
end if;
end Check_Infinite_Loop_Warning;
@@ -1057,7 +1057,7 @@
-- the designated object).
if not Warnings_Off_E1 then
- Error_Msg_NE ("?& may be null!", UR, E1);
+ Error_Msg_NE ("??& may be null!", UR, E1);
end if;
goto Continue;
@@ -1083,7 +1083,7 @@
and then not Is_Imported (E1)
then
Error_Msg_N
- ("?& is not modified, volatile has no effect!", E1);
+ ("??& is not modified, volatile has no effect!", E1);
-- Another special case, Exception_Occurrence, this catches
-- the case of exception choice (and a bit more too, but not
@@ -1105,7 +1105,7 @@
then
if not Warnings_Off_E1 then
Error_Msg_N -- CODEFIX
- ("?& is not modified, "
+ ("??& is not modified, "
& "could be declared constant!",
E1);
end if;
@@ -1237,7 +1237,7 @@
and then not Warnings_Off_E1
then
Output_Reference_Error
- ("?formal parameter& is read but "
+ ("?v?formal parameter& is read but "
& "never assigned!");
end if;
@@ -1245,7 +1245,7 @@
and then not Warnings_Off_E1
then
Output_Reference_Error
- ("?formal parameter& is not referenced!");
+ ("?v?formal parameter& is not referenced!");
end if;
end if;
@@ -1257,14 +1257,14 @@
and then not Warnings_Off_E1
then
Output_Reference_Error
- ("?variable& is read but never assigned!");
+ ("?v?variable& is read but never assigned!");
end if;
elsif not Has_Unreferenced (E1)
and then not Warnings_Off_E1
then
Output_Reference_Error -- CODEFIX
- ("?variable& is never read and never assigned!");
+ ("?v?variable& is never read and never assigned!");
end if;
-- Deal with special case where this variable is hidden
@@ -1275,12 +1275,12 @@
and then not Warnings_Off_E1
then
Error_Msg_N
- ("?for loop implicitly declares loop variable!",
+ ("?v?for loop implicitly declares loop variable!",
Hiding_Loop_Variable (E1));
Error_Msg_Sloc := Sloc (E1);
Error_Msg_N
- ("\?declaration hides & declared#!",
+ ("\?v?declaration hides & declared#!",
Hiding_Loop_Variable (E1));
end if;
end if;
@@ -1321,7 +1321,8 @@
then
if not Warnings_Off_E1 then
Error_Msg_NE
- ("?OUT parameter& not set before return", UR, E1);
+ ("?v?OUT parameter& not set before return",
+ UR, E1);
end if;
-- If the unset reference is a selected component
Index: opt.ads
===================================================================
--- opt.ads (revision 194785)
+++ opt.ads (working copy)
@@ -211,10 +211,9 @@
-- Enable assertions made using pragma Assert
Assume_No_Invalid_Values : Boolean := False;
- -- GNAT
- -- Normally, in accordance with (RM 13.9.1 (9-11)) the front end assumes
- -- that values could have invalid representations, unless it can clearly
- -- prove that the values are valid. If this switch is set (by -gnatB or by
+ -- GNAT Normally, in accordance with (RM 13.9.1 (9-11)) the front end
+ -- assumes that values could have invalid representations, unless it can
+ -- clearly prove that the values are valid. If this switch is set (by
-- pragma Assume_No_Invalid_Values (Off)), then the compiler assumes values
-- are valid and in range of their representations. This feature is now
-- fully enabled in the compiler.
@@ -374,7 +373,8 @@
Constant_Condition_Warnings : Boolean := False;
-- GNAT
- -- Set to True to activate warnings on constant conditions
+ -- Set to True to activate warnings on constant conditions. Modified by
+ -- use of -gnatwc/C.
Create_Mapping_File : Boolean := False;
-- GNATMAKE, GPRMAKE
@@ -1467,7 +1467,7 @@
-- GNAT
-- Set to True to generate all warnings on Ada 2005 compatibility issues,
-- including warnings on Ada 2005 obsolescent features used in Ada 2005
- -- mode. Set False by -gnatwY.
+ -- mode. Set by default, set False by -gnatwY.
Warn_On_Ada_2012_Compatibility : Boolean := True;
-- GNAT
@@ -1496,12 +1496,13 @@
Warn_On_Atomic_Synchronization : Boolean := False;
-- GNAT
-- Set to True to generate information messages for atomic synchronization.
- -- Set True by use of -gnatw.n.
+ -- Modified by use of -gnatw.n/.N.
Warn_On_Bad_Fixed_Value : Boolean := False;
-- GNAT
-- Set to True to generate warnings for static fixed-point expression
-- values that are not an exact multiple of the small value of the type.
+ -- Odd by default, modified by use of -gnatwb/B.
Warn_On_Biased_Representation : Boolean := True;
-- GNAT
@@ -1548,6 +1549,7 @@
-- Set to True to generate warnings if no value is ever assigned to a
-- variable that is at least partially uninitialized. Set to false to
-- suppress such warnings. The default is that such warnings are enabled.
+ -- Modified by use of -gnatwv/V.
Warn_On_Non_Local_Exception : Boolean := False;
-- GNAT
@@ -1557,6 +1559,7 @@
-- default is not to generate the warnings except that if the source has
-- at least one exception handler, and this restriction is set, and the
-- warning was not explicitly turned off, then it is turned on by default.
+ -- Modified by use of -gnatw.x/.X.
No_Warn_On_Non_Local_Exception : Boolean := False;
-- GNAT
@@ -1584,7 +1587,8 @@
Warn_On_Questionable_Missing_Parens : Boolean := True;
-- GNAT
-- Set to True to generate warnings for cases where parentheses are missing
- -- and the usage is questionable, because the intent is unclear.
+ -- and the usage is questionable, because the intent is unclear. On by
+ -- default, modified by use of -gnatwq/Q.
Warn_On_Parameter_Order : Boolean := False;
-- GNAT
@@ -1613,7 +1617,7 @@
Warn_On_Suspicious_Modulus_Value : Boolean := True;
-- GNAT
-- Set to True to generate warnings for suspicious modulus values. The
- -- default is that this warning is enabled.
+ -- default is that this warning is enabled. Modified by -gnatw.m/.M.
Warn_On_Unchecked_Conversion : Boolean := True;
-- GNAT
@@ -1626,12 +1630,12 @@
-- Set to True to generate warnings for inappropriate uses (comparisons
-- and explicit ranges) on unordered enumeration types (which includes
-- all enumeration types for which pragma Ordered is not given). The
- -- default is that this warning is disabled.
+ -- default is that this warning is disabled. Modified by -gnat.u/.U.
Warn_On_Unrecognized_Pragma : Boolean := True;
-- GNAT
-- Set to True to generate warnings for unrecognized pragmas. The default
- -- is that this warning is enabled.
+ -- is that this warning is enabled. Modified by use of -gnatwg/G.
Warn_On_Unrepped_Components : Boolean := False;
-- GNAT
Index: exp_aggr.adb
===================================================================
--- exp_aggr.adb (revision 194776)
+++ exp_aggr.adb (working copy)
@@ -431,13 +431,14 @@
if Present (Component_Associations (N)) then
Indx :=
First (Choices (First (Component_Associations (N))));
+
if Is_Entity_Name (Indx)
and then not Is_Type (Entity (Indx))
then
Error_Msg_N
- ("single component aggregate in non-static context?",
- Indx);
- Error_Msg_N ("\maybe subtype name was meant?", Indx);
+ ("single component aggregate in "
+ & "non-static context??", Indx);
+ Error_Msg_N ("\maybe subtype name was meant??", Indx);
end if;
end if;
@@ -3057,7 +3058,7 @@
elsif Expr_Value (Val1) /= Expr_Value (Val2) then
Apply_Compile_Time_Constraint_Error (Aggr,
- Msg => "incorrect value for discriminant&?",
+ Msg => "incorrect value for discriminant&??",
Reason => CE_Discriminant_Check_Failed,
Ent => D);
return False;
@@ -3767,7 +3768,7 @@
else
Error_Msg_N
- ("non-static object requires elaboration code?", N);
+ ("non-static object requires elaboration code??", N);
exit;
end if;
@@ -3775,7 +3776,7 @@
end loop;
if Present (Component_Associations (N)) then
- Error_Msg_N ("object requires elaboration code?", N);
+ Error_Msg_N ("object requires elaboration code??", N);
end if;
end if;
end;
Index: sem_eval.adb
===================================================================
--- sem_eval.adb (revision 194779)
+++ sem_eval.adb (working copy)
@@ -293,7 +293,7 @@
and then Is_Out_Of_Range (N, Base_Type (T), Assume_Valid => True)
then
Error_Msg_N
- ("?float value out of range, infinity will be generated", N);
+ ("??float value out of range, infinity will be generated", N);
end if;
return;
@@ -369,7 +369,7 @@
Intval (N) > Expr_Value (Type_High_Bound (Universal_Integer)))
then
Apply_Compile_Time_Constraint_Error
- (N, "non-static universal integer value out of range?",
+ (N, "non-static universal integer value out of range??",
CE_Range_Check_Failed);
-- Check out of range of base type
@@ -390,7 +390,7 @@
elsif Is_Out_Of_Range (N, T, Assume_Valid => True) then
Apply_Compile_Time_Constraint_Error
- (N, "value not in range of}?", CE_Range_Check_Failed);
+ (N, "value not in range of}??", CE_Range_Check_Failed);
elsif Checks_On then
Enable_Range_Check (N);
@@ -407,14 +407,12 @@
procedure Check_String_Literal_Length (N : Node_Id; Ttype : Entity_Id) is
begin
- if not Raises_Constraint_Error (N)
- and then Is_Constrained (Ttype)
- then
+ if not Raises_Constraint_Error (N) and then Is_Constrained (Ttype) then
if
UI_From_Int (String_Length (Strval (N))) /= String_Type_Len (Ttype)
then
Apply_Compile_Time_Constraint_Error
- (N, "string length wrong for}?",
+ (N, "string length wrong for}??",
CE_Length_Check_Failed,
Ent => Ttype,
Typ => Ttype);
@@ -1655,7 +1653,7 @@
begin
if Result < Lo or else Result > Hi then
Apply_Compile_Time_Constraint_Error
- (N, "value not in range of }?",
+ (N, "value not in range of }??",
CE_Overflow_Check_Failed,
Ent => BT);
return;
@@ -3316,10 +3314,10 @@
= Entity (Drange)
then
if Warn_On_Redundant_Constructs then
- Error_Msg_N ("redundant slice denotes whole array?", N);
+ Error_Msg_N ("redundant slice denotes whole array?r?", N);
end if;
- -- The following might be a useful optimization????
+ -- The following might be a useful optimization???
-- Rewrite (N, New_Occurrence_Of (E, Sloc (N)));
end if;
@@ -4656,7 +4654,7 @@
else
Apply_Compile_Time_Constraint_Error
- (N, "value not in range of}?", CE_Range_Check_Failed);
+ (N, "value not in range of}??", CE_Range_Check_Failed);
end if;
end Out_Of_Range;
Index: sem_cat.adb
===================================================================
--- sem_cat.adb (revision 194776)
+++ sem_cat.adb (working copy)
@@ -923,6 +923,7 @@
then
-- If the type is private, it must have the Ada 2005 pragma
-- Has_Preelaborable_Initialization.
+
-- The check is omitted within predefined units. This is probably
-- obsolete code to fix the Ada 95 weakness in this area ???
@@ -1728,8 +1729,7 @@
Direct_Designated_Type := Designated_Type (T);
Desig_Type := Etype (Direct_Designated_Type);
- -- Why is the check below not in
- -- Validate_Remote_Access_To_Class_Wide_Type???
+ -- Why is this check not in Validate_Remote_Access_To_Class_Wide_Type???
if not Is_Valid_Remote_Object_Type (Desig_Type) then
Error_Msg_N
@@ -2047,6 +2047,7 @@
function Is_Primary (N : Node_Id) return Boolean;
-- Determine whether node is syntactically a primary in an expression
-- This function should probably be somewhere else ???
+ --
-- Also it does not do what it says, e.g if N is a binary operator
-- whose parent is a binary operator, Is_Primary returns True ???
@@ -2170,7 +2171,7 @@
if GNAT_Mode then
Error_Msg_N
- ("?non-static constant in preelaborated unit", N);
+ ("??non-static constant in preelaborated unit", N);
else
Flag_Non_Static_Expr
("non-static constant in preelaborated unit", N);
Index: sem_disp.adb
===================================================================
--- sem_disp.adb (revision 194776)
+++ sem_disp.adb (working copy)
@@ -904,10 +904,10 @@
and then not Is_Generic_Type (Typ)
and then not In_Instance
then
- Error_Msg_N ("?declaration of& is too late!", Subp);
+ Error_Msg_N ("??declaration of& is too late!", Subp);
Error_Msg_NE -- CODEFIX??
- ("\spec should appear immediately after declaration of &!",
- Subp, Typ);
+ ("\??spec should appear immediately after declaration "
+ & "of & !", Subp, Typ);
exit;
end if;
@@ -933,10 +933,10 @@
and then not Is_Generic_Type (Typ)
and then not In_Instance
then
- Error_Msg_N ("?declaration of& is too late!", Subp);
+ Error_Msg_N ("??declaration of& is too late!", Subp);
Error_Msg_NE
- ("\spec should appear immediately after declaration of &!",
- Subp, Typ);
+ ("\??spec should appear immediately after declaration "
+ & "of & !", Subp, Typ);
end if;
end if;
end;
@@ -1153,7 +1153,7 @@
and then In_Same_List (Parent (Tagged_Type), Parent (Parent (Subp)))
then
Error_Msg_N
- ("?not dispatching (must be defined in a package spec)", Subp);
+ ("??not dispatching (must be defined in a package spec)", Subp);
return;
-- When the type is frozen, it is legitimate to define a new
@@ -1169,7 +1169,7 @@
elsif Is_Frozen (Tagged_Type) and then not Has_Dispatching_Parent then
Error_Msg_N ("this primitive operation is declared too late", Subp);
Error_Msg_NE
- ("?no primitive operations for& after this line",
+ ("??no primitive operations for& after this line",
Freeze_Node (Tagged_Type),
Tagged_Type);
return;
@@ -1220,7 +1220,7 @@
else
Error_Msg_NE
- ("operation does not override inherited&?", Subp, Subp);
+ ("operation does not override inherited&??", Subp, Subp);
end if;
else
Index: exp_ch3.adb
===================================================================
--- exp_ch3.adb (revision 194776)
+++ exp_ch3.adb (working copy)
@@ -7132,7 +7132,7 @@
if Is_Ancestor (RSPWS, Etype (Pool)) then
Error_Msg_N
- ("?subpool access type has deeper accessibility " &
+ ("??subpool access type has deeper accessibility " &
"level than pool", Def_Id);
Append_Freeze_Action (Def_Id,
@@ -7744,14 +7744,13 @@
if Warning_Needed then
Error_Msg_N
- ("Objects of the type cannot be initialized " &
- "statically by default?",
- Parent (E));
+ ("Objects of the type cannot be initialized "
+ & "statically by default??", Parent (E));
end if;
end if;
else
- Error_Msg_N ("Object cannot be initialized statically?", E);
+ Error_Msg_N ("Object cannot be initialized statically??", E);
end if;
end if;
end Initialization_Warning;
^ permalink raw reply [flat|nested] 2+ messages in thread
end of thread, other threads:[~2013-01-02 9:57 UTC | newest]
Thread overview: 2+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2013-01-02 9:57 [Ada] Further work on tags for warning messages Arnaud Charlet
-- strict thread matches above, loose matches on Subject: below --
2013-01-02 9:52 Arnaud Charlet
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).