diff options
| author | Arnaud Charlet <charlet@gcc.gnu.org> | 2013-01-02 10:56:53 +0100 |
|---|---|---|
| committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2013-01-02 10:56:53 +0100 |
| commit | 685bc70fd8dfd17fa62266c2ad05567b37540119 (patch) | |
| tree | 879be21173429efea2e6377f4341e24c29907f6e | |
| parent | 324ac54054c45c6641e601f02b74568c277f903d (diff) | |
| download | gcc-685bc70fd8dfd17fa62266c2ad05567b37540119.zip gcc-685bc70fd8dfd17fa62266c2ad05567b37540119.tar.gz gcc-685bc70fd8dfd17fa62266c2ad05567b37540119.tar.bz2 | |
[multiple changes]
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.
2013-01-02 Robert Dewar <dewar@adacore.com>
* err_vars.ads: Minor comment fix.
2013-01-02 Ed Schonberg <schonberg@adacore.com>
* sem_ch12.adb: Refine predicate.
From-SVN: r194787
34 files changed, 326 insertions, 278 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 6a85428..a8f5bf8 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,23 @@ 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. + +2013-01-02 Robert Dewar <dewar@adacore.com> + + * err_vars.ads: Minor comment fix. + +2013-01-02 Ed Schonberg <schonberg@adacore.com> + + * sem_ch12.adb: Refine predicate. + +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 diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index 8a73e25..d01db36 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -599,10 +599,10 @@ package body Checks is 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 @@ package body Checks is 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 @@ package body Checks is 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 @@ package body Checks is 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 @@ package body Checks is 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 @@ package body Checks is 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 @@ package body Checks is 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 @@ package body Checks is 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 @@ package body Checks is 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 @@ package body Checks is 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 @@ package body Checks is 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 @@ package body Checks is 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 @@ package body Checks is 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 @@ package body Checks is 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 @@ package body Checks is 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 @@ package body Checks is 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 @@ package body Checks is 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 diff --git a/gcc/ada/err_vars.ads b/gcc/ada/err_vars.ads index 0791a35..ecfbc54 100644 --- a/gcc/ada/err_vars.ads +++ b/gcc/ada/err_vars.ads @@ -89,7 +89,7 @@ package Err_Vars is -- to force an initial reference to the real source file name. Warning_Doc_Switch : Boolean := False; - -- 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. diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 2e318e3..446a310 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -5685,8 +5685,8 @@ package body Exp_Ch4 is 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 @@ package body Exp_Ch4 is 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 @@ package body Exp_Ch4 is 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; diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index c3cf8c8..cd83d45bd 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -1450,7 +1450,7 @@ package body Exp_Ch6 is 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 @@ package body Exp_Ch6 is 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 @@ package body Exp_Ch6 is (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 @@ package body Exp_Ch6 is 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 @@ package body Exp_Ch6 is 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 @@ package body Exp_Ch6 is (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 @@ package body Exp_Ch6 is 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 @@ package body Exp_Ch6 is -- 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; diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index 78ad5d2..7289282 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -148,6 +148,7 @@ package body Exp_Ch7 is -- 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 @@ package body Exp_Ch7 is -- 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; diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index 781de869..49e7efe 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -8812,9 +8812,7 @@ package body Exp_Ch9 is 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 @@ package body Exp_Ch9 is 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; diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb index 23235d8..c0872ad 100644 --- a/gcc/ada/exp_disp.adb +++ b/gcc/ada/exp_disp.adb @@ -8431,11 +8431,11 @@ package body Exp_Disp is 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 @@ package body Exp_Disp is 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; diff --git a/gcc/ada/exp_dist.adb b/gcc/ada/exp_dist.adb index 7c7fbd0..8649faf 100644 --- a/gcc/ada/exp_dist.adb +++ b/gcc/ada/exp_dist.adb @@ -7417,6 +7417,7 @@ package body Exp_Dist is -- 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)) /= diff --git a/gcc/ada/exp_intr.adb b/gcc/ada/exp_intr.adb index bc43a4b..c3389dd 100644 --- a/gcc/ada/exp_intr.adb +++ b/gcc/ada/exp_intr.adb @@ -1045,9 +1045,9 @@ package body Exp_Intr is 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; diff --git a/gcc/ada/exp_prag.adb b/gcc/ada/exp_prag.adb index f607b37..537fa01 100644 --- a/gcc/ada/exp_prag.adb +++ b/gcc/ada/exp_prag.adb @@ -448,10 +448,12 @@ package body Exp_Prag is 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; diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index a7478a1..29d8182 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -225,10 +225,10 @@ package body Exp_Util is 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 @@ package body Exp_Util is 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; diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 6c64711..de49b86 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -1817,6 +1817,10 @@ package body Freeze is 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 @@ package body Freeze is declare Modulus : constant Node_Id := Original_Node (Expression (Tdef)); + begin if Nkind (Modulus) = N_Integer_Literal then declare @@ -1870,7 +1875,7 @@ package body Freeze is 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 @@ package body Freeze is 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 @@ package body Freeze is 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 @@ package body Freeze is 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 @@ package body Freeze is 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 @@ package body Freeze is -- 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 @@ package body Freeze is 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 @@ package body Freeze is and then not Has_Size_Clause (F_Type) and then VM_Target = No_VM then - Error_Msg_N ("& is an 8-bit Ada Boolean?", Formal); + Error_Msg_N + ("& is an 8-bit Ada Boolean?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 @@ package body Freeze is 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 @@ package body Freeze is 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 @@ package body Freeze is 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 @@ package body Freeze is 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 @@ package body Freeze is 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 @@ package body Freeze is 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 @@ package body Freeze is 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 @@ package body Freeze is 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 @@ package body Freeze is 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 @@ package body Freeze is 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 @@ package body Freeze is 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 @@ package body Freeze is 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 @@ package body Freeze is 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 @@ package body Freeze is (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 @@ package body Freeze is 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 @@ package body Freeze is 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 @@ package body Freeze is 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 @@ package body Freeze is 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 @@ package body Freeze is 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 @@ package body Freeze is 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 @@ package body Freeze is 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 @@ package body Freeze is 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; diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb index 4948e1b..6e90c2b 100644 --- a/gcc/ada/gnat1drv.adb +++ b/gcc/ada/gnat1drv.adb @@ -677,9 +677,9 @@ procedure Gnat1drv is 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. diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb index c3947ed..cba4175 100644 --- a/gcc/ada/inline.adb +++ b/gcc/ada/inline.adb @@ -699,11 +699,11 @@ package body Inline is 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 @@ package body Inline is 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 @@ package body Inline is 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; diff --git a/gcc/ada/layout.adb b/gcc/ada/layout.adb index 651107f..3ac620c 100644 --- a/gcc/ada/layout.adb +++ b/gcc/ada/layout.adb @@ -2435,7 +2435,7 @@ package body Layout is 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 @@ package body Layout is 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 @@ package body Layout is 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; diff --git a/gcc/ada/lib-xref.adb b/gcc/ada/lib-xref.adb index aa9031f..2f01dd4 100644 --- a/gcc/ada/lib-xref.adb +++ b/gcc/ada/lib-xref.adb @@ -597,7 +597,7 @@ package body Lib.Xref is 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 @@ package body Lib.Xref is 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 @@ package body Lib.Xref is 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; diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads index 55e186b..aa7d2ba 100644 --- a/gcc/ada/opt.ads +++ b/gcc/ada/opt.ads @@ -174,7 +174,8 @@ package Opt is 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 @@ package Opt is -- 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 @@ package Opt is -- 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 @@ package Opt is 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 @@ package Opt is -- 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 @@ package Opt is -- 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 @@ package Opt is -- 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 @@ package Opt is -- 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 @@ package Opt is -- 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 @@ package Opt is -- 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 @@ package Opt is -- 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; diff --git a/gcc/ada/par-ch10.adb b/gcc/ada/par-ch10.adb index 08553dd..ddd88b3 100644 --- a/gcc/ada/par-ch10.adb +++ b/gcc/ada/par-ch10.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2010, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -314,8 +314,9 @@ package body Ch10 is -- 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; diff --git a/gcc/ada/par-labl.adb b/gcc/ada/par-labl.adb index 9bafb07..f709dd0 100644 --- a/gcc/ada/par-labl.adb +++ b/gcc/ada/par-labl.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -81,6 +81,7 @@ procedure Labl is -- 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 @@ procedure Labl is 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; diff --git a/gcc/ada/par-load.adb b/gcc/ada/par-load.adb index e30ffc0..f5bf99d 100644 --- a/gcc/ada/par-load.adb +++ b/gcc/ada/par-load.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2010, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -172,7 +172,7 @@ begin 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 diff --git a/gcc/ada/par-util.adb b/gcc/ada/par-util.adb index 3baf9f5..fa592a7 100644 --- a/gcc/ada/par-util.adb +++ b/gcc/ada/par-util.adb @@ -186,7 +186,7 @@ package body Util is 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 @@ package body Util is 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 @@ package body Util is 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; diff --git a/gcc/ada/restrict.adb b/gcc/ada/restrict.adb index 84e576b..d4acf1d 100644 --- a/gcc/ada/restrict.adb +++ b/gcc/ada/restrict.adb @@ -582,7 +582,7 @@ package body Restrict is 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 @@ package body Restrict is 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 @@ package body Restrict is -- 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 @@ package body Restrict is -- Set as warning if warning case if Restriction_Warnings (R) then - Add_Char ('?'); + Add_Str ("??"); end if; -- Set main message diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 89dcb2f..d3c735b 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -13008,11 +13008,21 @@ package body Sem_Ch12 is and then Present (Original_Node (N2)) and then Present (Entity (Original_Node (N2))) then - N2 := Original_Node (N2); - Set_Associated_Node (N, N2); - end if; + if Is_Global (Entity (Original_Node (N2))) then + N2 := Original_Node (N2); + Set_Associated_Node (N, N2); + Set_Global_Type (N, N2); + + else + -- Renaming is local, and will be resolved in instance + + Set_Associated_Node (N, Empty); + Set_Etype (N, Empty); + end if; - Set_Global_Type (N, N2); + else + Set_Global_Type (N, N2); + end if; elsif Nkind (N) = N_Op_Concat and then Is_Generic_Type (Etype (N2)) diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index c342a8b..37e521c 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -5339,7 +5339,7 @@ package body Sem_Ch13 is 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 @@ package body Sem_Ch13 is then Error_Msg_Sloc := Sloc (Predicate_Function (T)); Error_Msg_Node_2 := T; - Error_Msg_N ("info: & inherits predicate from & #??", Typ); + Error_Msg_N ("info: & inherits predicate from & #?L?", Typ); end if; end if; end Add_Call; @@ -9797,7 +9797,7 @@ package body Sem_Ch13 is 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 @@ package body Sem_Ch13 is 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 @@ package body Sem_Ch13 is 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 @@ package body Sem_Ch13 is Error_Msg_Uint_1 := Source_Siz; Error_Msg_Name_2 := Chars (Target); Error_Msg_Uint_2 := Target_Siz; - Error_Msg ("\size of % is ^, size of % is ^?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 @@ package body Sem_Ch13 is 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 @@ package body Sem_Ch13 is 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 @@ package body Sem_Ch13 is 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; diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 414b240..14e7f93 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -635,10 +635,9 @@ package body Sem_Ch4 is 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; diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 36c139b7..eae2df3 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -3788,6 +3788,7 @@ package body Sem_Ch6 is if Has_Excluded_Statement (Then_Statements (E)) then return True; end if; + Next (E); end loop; end if; @@ -3975,7 +3976,7 @@ package body Sem_Ch6 is then Cannot_Inline ("cannot inline & (call returns unconstrained type)?", - N, Subp); + N, Subp); return Abandon; else return OK; @@ -7287,17 +7288,18 @@ package body Sem_Ch6 is then if Present (Last_Postcondition) then if Present (Last_Contract_Case) then - Error_Msg_N ("neither function postcondition nor " - & "contract cases 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 @@ package body Sem_Ch6 is 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; diff --git a/gcc/ada/sem_ch6.ads b/gcc/ada/sem_ch6.ads index 5aa18f7..a0df51e 100644 --- a/gcc/ada/sem_ch6.ads +++ b/gcc/ada/sem_ch6.ads @@ -58,29 +58,30 @@ package Sem_Ch6 is Is_Serious : Boolean := False); -- This procedure is called if the node N, an instance of a call to -- subprogram Subp, cannot be inlined. Msg is the message to be issued, - -- 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); diff --git a/gcc/ada/sem_dim.adb b/gcc/ada/sem_dim.adb index 0e46efa..be14d47 100644 --- a/gcc/ada/sem_dim.adb +++ b/gcc/ada/sem_dim.adb @@ -2451,7 +2451,7 @@ package body Sem_Dim is 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; ---------------------------------------- diff --git a/gcc/ada/sem_elab.adb b/gcc/ada/sem_elab.adb index 2b7c7a1..125caef 100644 --- a/gcc/ada/sem_elab.adb +++ b/gcc/ada/sem_elab.adb @@ -1030,7 +1030,7 @@ package body Sem_Elab is 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 @@ package body Sem_Elab is 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); diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index fff5295..5559f17 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -8891,7 +8891,7 @@ package body Sem_Res is -- 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 @@ package body Sem_Res is -- 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; diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb index f683b2a..e794039 100644 --- a/gcc/ada/sem_warn.adb +++ b/gcc/ada/sem_warn.adb @@ -1083,7 +1083,7 @@ package body Sem_Warn is 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 @@ package body Sem_Warn is 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 @@ package body Sem_Warn is 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 @@ package body Sem_Warn is 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 @@ package body Sem_Warn is 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 @@ package body Sem_Warn is 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 @@ package body Sem_Warn is 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 @@ package body Sem_Warn is 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 @@ package body Sem_Warn is 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 @@ package body Sem_Warn is 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 @@ package body Sem_Warn is 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 @@ package body Sem_Warn is 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 @@ package body Sem_Warn is -- 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 @@ package body Sem_Warn is 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 @@ package body Sem_Warn is 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 @@ package body Sem_Warn is 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 @@ package body Sem_Warn is 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 @@ package body Sem_Warn is 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 @@ package body Sem_Warn is 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 @@ package body Sem_Warn is 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 @@ package body Sem_Warn is 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 @@ package body Sem_Warn is 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 @@ package body Sem_Warn is 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 @@ package body Sem_Warn is -- 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 @@ package body Sem_Warn is 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 @@ package body Sem_Warn is 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 @@ package body Sem_Warn is 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 @@ package body Sem_Warn is 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 @@ package body Sem_Warn is 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 @@ package body Sem_Warn is -- 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 @@ package body Sem_Warn is 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 @@ package body Sem_Warn is 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 @@ package body Sem_Warn is 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 @@ package body Sem_Warn is 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; diff --git a/gcc/ada/sinput-l.adb b/gcc/ada/sinput-l.adb index 59d2aed..64a7cdb 100644 --- a/gcc/ada/sinput-l.adb +++ b/gcc/ada/sinput-l.adb @@ -668,7 +668,7 @@ package body Sinput.L is 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; diff --git a/gcc/ada/warnsw.ads b/gcc/ada/warnsw.ads index f802bb7..45983e9 100644 --- a/gcc/ada/warnsw.ads +++ b/gcc/ada/warnsw.ads @@ -44,12 +44,13 @@ package Warnsw is 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 -- |