From: Arnaud Charlet <charlet@adacore.com>
To: gcc-patches@gcc.gnu.org
Cc: Robert Dewar <dewar@adacore.com>
Subject: [Ada] Further work on tags for warning messages
Date: Wed, 02 Jan 2013 09:57:00 -0000 [thread overview]
Message-ID: <20130102095727.GA5776@adacore.com> (raw)
[-- 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;
next reply other threads:[~2013-01-02 9:57 UTC|newest]
Thread overview: 2+ messages / expand[flat|nested] mbox.gz Atom feed top
2013-01-02 9:57 Arnaud Charlet [this message]
-- strict thread matches above, loose matches on Subject: below --
2013-01-02 9:52 Arnaud Charlet
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20130102095727.GA5776@adacore.com \
--to=charlet@adacore.com \
--cc=dewar@adacore.com \
--cc=gcc-patches@gcc.gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
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).