diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 8cbeb924088..6a8542851cd 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,22 @@ +2013-01-02 Robert Dewar + + * errout.ads: Minor comment fixes. + * opt.ads: Minor comment additions. + * exp_aggr.adb: Add tags to warning messages + * exp_ch11.adb, exp_ch3.adb, exp_ch4.adb, exp_util.adb, sem_aggr.adb, + sem_attr.adb, sem_case.adb, sem_cat.adb, sem_ch3.adb, sem_ch4.adb, + sem_ch5.adb, sem_disp.adb, sem_dist.adb, sem_elab.adb, sem_eval.adb, + sem_intr.adb, sem_mech.adb, sem_prag.adb, sem_res.adb, sem_util.adb, + sem_warn.adb: Add tags to warning messages + +2013-01-02 Doug Rupp + + * init.c [VMS] Remove subtest on reason mask for ACCVIO that is a C_E. + +2013-01-02 Ed Schonberg + + * sem_ch12.adb: Recover source name for renamed packagea. + 2013-01-02 Robert Dewar * errout.adb (Set_Msg_Insertion_Warning): Correct typo causing diff --git a/gcc/ada/errout.ads b/gcc/ada/errout.ads index 7dc67a0602d..f8d1fdadb26 100644 --- a/gcc/ada/errout.ads +++ b/gcc/ada/errout.ads @@ -60,7 +60,7 @@ package Errout is -- Exception raised if Raise_Exception_On_Error is true Warning_Doc_Switch : Boolean renames Err_Vars.Warning_Doc_Switch; - -- If this is set True, then the ??/?x?/?.x? sequences in error messages + -- If this is set True, then the ??/?x?/?X? sequences in error messages -- are active (see errout.ads for details). If this switch is False, then -- these sequences are ignored (i.e. simply equivalent to a single ?). The -- -gnatw.d switch sets this flag True, -gnatw.D sets this flag False. diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 1d42bf89948..10a4a560984 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -431,13 +431,14 @@ package body Exp_Aggr is if Present (Component_Associations (N)) then Indx := First (Choices (First (Component_Associations (N)))); + if Is_Entity_Name (Indx) and then not Is_Type (Entity (Indx)) then Error_Msg_N - ("single component aggregate in non-static context?", - Indx); - Error_Msg_N ("\maybe subtype name was meant?", Indx); + ("single component aggregate in " + & "non-static context??", Indx); + Error_Msg_N ("\maybe subtype name was meant??", Indx); end if; end if; @@ -3057,7 +3058,7 @@ package body Exp_Aggr is elsif Expr_Value (Val1) /= Expr_Value (Val2) then Apply_Compile_Time_Constraint_Error (Aggr, - Msg => "incorrect value for discriminant&?", + Msg => "incorrect value for discriminant&??", Reason => CE_Discriminant_Check_Failed, Ent => D); return False; @@ -3767,7 +3768,7 @@ package body Exp_Aggr is else Error_Msg_N - ("non-static object requires elaboration code?", N); + ("non-static object requires elaboration code??", N); exit; end if; @@ -3775,7 +3776,7 @@ package body Exp_Aggr is end loop; if Present (Component_Associations (N)) then - Error_Msg_N ("object requires elaboration code?", N); + Error_Msg_N ("object requires elaboration code??", N); end if; end if; end; diff --git a/gcc/ada/exp_ch11.adb b/gcc/ada/exp_ch11.adb index 56cf190e2a8..07b631de6eb 100644 --- a/gcc/ada/exp_ch11.adb +++ b/gcc/ada/exp_ch11.adb @@ -1005,8 +1005,8 @@ package body Exp_Ch11 is then Warn_No_Exception_Propagation_Active (Handler); Error_Msg_N - ("\?this handler can never be entered, and has been removed", - Handler); + ("\?X?this handler can never be entered, " + & "and has been removed", Handler); end if; if No_Exception_Propagation_Active then @@ -1808,10 +1808,10 @@ package body Exp_Ch11 is if Configurable_Run_Time_Mode then Error_Msg_NE - ("\?& may call Last_Chance_Handler", N, E); + ("\?X?& may call Last_Chance_Handler", N, E); else Error_Msg_NE - ("\?& may result in unhandled exception", N, E); + ("\?X?& may result in unhandled exception", N, E); end if; end if; end; @@ -2147,10 +2147,10 @@ package body Exp_Ch11 is if Configurable_Run_Time_Mode then Error_Msg_N - ("\?Last_Chance_Handler will be called on exception", N); + ("\?X?Last_Chance_Handler will be called on exception", N); else Error_Msg_N - ("\?execution may raise unhandled exception", N); + ("\?X?execution may raise unhandled exception", N); end if; end if; end Warn_If_No_Propagation; @@ -2162,7 +2162,7 @@ package body Exp_Ch11 is procedure Warn_No_Exception_Propagation_Active (N : Node_Id) is begin Error_Msg_N - ("?pragma Restrictions (No_Exception_Propagation) in effect", N); + ("?X?pragma Restrictions (No_Exception_Propagation) in effect", N); end Warn_No_Exception_Propagation_Active; end Exp_Ch11; diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index 2434d5b7d95..096d14e7503 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -7132,7 +7132,7 @@ package body Exp_Ch3 is if Is_Ancestor (RSPWS, Etype (Pool)) then Error_Msg_N - ("?subpool access type has deeper accessibility " & + ("??subpool access type has deeper accessibility " & "level than pool", Def_Id); Append_Freeze_Action (Def_Id, @@ -7744,14 +7744,13 @@ package body Exp_Ch3 is if Warning_Needed then Error_Msg_N - ("Objects of the type cannot be initialized " & - "statically by default?", - Parent (E)); + ("Objects of the type cannot be initialized " + & "statically by default??", Parent (E)); end if; end if; else - Error_Msg_N ("Object cannot be initialized statically?", E); + Error_Msg_N ("Object cannot be initialized statically??", E); end if; end if; end Initialization_Warning; diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index b7ecd830048..2e318e3dc99 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -3686,7 +3686,7 @@ package body Exp_Ch4 is Kill_Dead_Code (Declaration_Node (Entity (High_Bound))); Apply_Compile_Time_Constraint_Error (N => Cnode, - Msg => "concatenation result upper bound out of range?", + Msg => "concatenation result upper bound out of range??", Reason => CE_Range_Check_Failed); end Expand_Concatenate; @@ -5501,9 +5501,10 @@ package body Exp_Ch4 is -- actually eliminated the danger of optimization above. if Overflow_Check_Mode not in Minimized_Or_Eliminated then - Error_Msg_N ("?explicit membership test may be optimized away", N); + Error_Msg_N + ("??explicit membership test may be optimized away", N); Error_Msg_N -- CODEFIX - ("\?use ''Valid attribute instead", N); + ("\??use ''Valid attribute instead", N); end if; return; @@ -5684,8 +5685,8 @@ 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 ("??range test optimized away", N); + Error_Msg_N ("\??value is known to be out of range", N); end if; Rewrite (N, New_Reference_To (Standard_False, Loc)); @@ -5698,8 +5699,8 @@ 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 ("??range test optimized away", N); + Error_Msg_N ("\??value is known to be in range", N); end if; Rewrite (N, New_Reference_To (Standard_True, Loc)); @@ -5713,8 +5714,8 @@ package body Exp_Ch4 is elsif Lcheck in Compare_GE then if Warn2 and then not In_Instance then - Error_Msg_N ("?lower bound test optimized away", Lo); - Error_Msg_N ("\?value is known to be in range", Lo); + Error_Msg_N ("??lower bound test optimized away", Lo); + Error_Msg_N ("\??value is known to be in range", Lo); end if; Rewrite (N, @@ -5730,8 +5731,8 @@ package body Exp_Ch4 is elsif Ucheck in Compare_LE then if Warn2 and then not In_Instance then - Error_Msg_N ("?upper bound test optimized away", Hi); - Error_Msg_N ("\?value is known to be in range", Hi); + Error_Msg_N ("??upper bound test optimized away", Hi); + Error_Msg_N ("\??value is known to be in range", Hi); end if; Rewrite (N, @@ -5755,25 +5756,25 @@ 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); + ("??value can only be in range if it is invalid", N); -- Result is in range for valid value elsif Lcheck in Compare_GE and then Ucheck in Compare_LE then Error_Msg_N - ("?value can only be out of range if it is invalid", N); + ("??value can only be out of range if it is invalid", N); -- Lower bound check succeeds if value is valid elsif Warn2 and then Lcheck in Compare_GE then Error_Msg_N - ("?lower bound check only fails if it is invalid", Lo); + ("??lower bound check only fails if it is invalid", Lo); -- Upper bound check succeeds if value is valid elsif Warn2 and then Ucheck in Compare_LE then Error_Msg_N - ("?upper bound check only fails for invalid values", Hi); + ("??upper bound check only fails for invalid values", Hi); end if; end if; end; @@ -9665,9 +9666,10 @@ package body Exp_Ch4 is Reason => PE_Accessibility_Check_Failed)); Set_Etype (N, Target_Type); - Error_Msg_N ("?accessibility check failure", N); + Error_Msg_N + ("??accessibility check failure", N); Error_Msg_NE - ("\?& will be raised at run time", N, Standard_Program_Error); + ("\??& will be raised at run time", N, Standard_Program_Error); end Raise_Accessibility_Error; ---------------------- @@ -10632,7 +10634,7 @@ package body Exp_Ch4 is end if; -- Otherwise force evaluation unless Assignment_OK flag is set (this - -- flag indicates ??? -- more comments needed here) + -- flag indicates ??? More comments needed here) if Assignment_OK (N) then null; @@ -12061,7 +12063,7 @@ package body Exp_Ch4 is if Constant_Condition_Warnings and then Comes_From_Source (Original_Node (N)) then - Error_Msg_N ("could replace by ""'=""?", N); + Error_Msg_N ("could replace by ""'=""?c?", N); end if; Op := N_Op_Eq; @@ -12254,7 +12256,8 @@ package body Exp_Ch4 is and then not Has_Warnings_Off (Etype (Left_Opnd (N))) then Error_Msg_N - ("can never be greater than, could replace by ""'=""?", N); + ("can never be greater than, could replace by ""'=""?c?", + N); Warning_Generated := True; end if; @@ -12279,7 +12282,7 @@ package body Exp_Ch4 is and then not Has_Warnings_Off (Etype (Left_Opnd (N))) then Error_Msg_N - ("can never be less than, could replace by ""'=""?", N); + ("can never be less than, could replace by ""'=""?c?", N); Warning_Generated := True; end if; @@ -12312,11 +12315,11 @@ package body Exp_Ch4 is then if True_Result then Error_Msg_N - ("condition can only be False if invalid values present?", + ("condition can only be False if invalid values present??", N); elsif False_Result then Error_Msg_N - ("condition can only be True if invalid values present?", + ("condition can only be True if invalid values present??", N); end if; end if; diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 3a9f81db0fc..a7478a1785c 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -224,9 +224,11 @@ package body Exp_Util is end case; if Present (Msg_Node) then - Error_Msg_N ("?info: atomic synchronization set for &", Msg_Node); + Error_Msg_N + ("?n?info: atomic synchronization set for &", Msg_Node); else - Error_Msg_N ("?info: atomic synchronization set", N); + Error_Msg_N + ("?n?info: atomic synchronization set", N); end if; end if; end Activate_Atomic_Synchronization; @@ -5125,7 +5127,8 @@ package body Exp_Util is if W then Error_Msg_F - ("?this code can never be executed and has been deleted!", N); + ("??this code can never be executed and has been deleted!", + N); end if; end if; diff --git a/gcc/ada/init.c b/gcc/ada/init.c index 158e203716e..37c403b803e 100644 --- a/gcc/ada/init.c +++ b/gcc/ada/init.c @@ -985,12 +985,10 @@ static const struct cond_except dec_ada_cond_except_table [] = { /* Subtest for ACCVIO Constraint_Error, kept for compatibility, in hindsight should have just made ACCVIO == Storage_Error. */ -#define ACCVIO_REASON_MASK 2 #define ACCVIO_VIRTUAL_ADDR 3 static const struct cond_subtests accvio_c_e = - {2, /* number of subtests below */ + {1, /* number of subtests below */ { - {ACCVIO_REASON_MASK, 0}, {ACCVIO_VIRTUAL_ADDR, 0} } }; diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads index 493f962c17a..55e186b4769 100644 --- a/gcc/ada/opt.ads +++ b/gcc/ada/opt.ads @@ -211,10 +211,9 @@ package Opt is -- Enable assertions made using pragma Assert Assume_No_Invalid_Values : Boolean := False; - -- GNAT - -- Normally, in accordance with (RM 13.9.1 (9-11)) the front end assumes - -- that values could have invalid representations, unless it can clearly - -- prove that the values are valid. If this switch is set (by -gnatB or by + -- GNAT Normally, in accordance with (RM 13.9.1 (9-11)) the front end + -- assumes that values could have invalid representations, unless it can + -- clearly prove that the values are valid. If this switch is set (by -- pragma Assume_No_Invalid_Values (Off)), then the compiler assumes values -- are valid and in range of their representations. This feature is now -- fully enabled in the compiler. @@ -374,7 +373,8 @@ package Opt is Constant_Condition_Warnings : Boolean := False; -- GNAT - -- Set to True to activate warnings on constant conditions + -- Set to True to activate warnings on constant conditions. Modified by + -- use of -gnatwc/C. Create_Mapping_File : Boolean := False; -- GNATMAKE, GPRMAKE @@ -1467,7 +1467,7 @@ 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 False by -gnatwY. + -- mode. Set by default, set False by -gnatwY. Warn_On_Ada_2012_Compatibility : Boolean := True; -- GNAT @@ -1496,12 +1496,13 @@ package Opt is Warn_On_Atomic_Synchronization : Boolean := False; -- GNAT -- Set to True to generate information messages for atomic synchronization. - -- Set True by use of -gnatw.n. + -- Modified by use of -gnatw.n/.N. Warn_On_Bad_Fixed_Value : Boolean := False; -- GNAT -- Set to True to generate warnings for static fixed-point expression -- values that are not an exact multiple of the small value of the type. + -- Odd by default, modified by use of -gnatwb/B. Warn_On_Biased_Representation : Boolean := True; -- GNAT @@ -1548,6 +1549,7 @@ package Opt is -- Set to True to generate warnings if no value is ever assigned to a -- variable that is at least partially uninitialized. Set to false to -- suppress such warnings. The default is that such warnings are enabled. + -- Modified by use of -gnatwv/V. Warn_On_Non_Local_Exception : Boolean := False; -- GNAT @@ -1557,6 +1559,7 @@ package Opt is -- default is not to generate the warnings except that if the source has -- at least one exception handler, and this restriction is set, and the -- warning was not explicitly turned off, then it is turned on by default. + -- Modified by use of -gnatw.x/.X. No_Warn_On_Non_Local_Exception : Boolean := False; -- GNAT @@ -1584,7 +1587,8 @@ package Opt is Warn_On_Questionable_Missing_Parens : Boolean := True; -- GNAT -- Set to True to generate warnings for cases where parentheses are missing - -- and the usage is questionable, because the intent is unclear. + -- and the usage is questionable, because the intent is unclear. On by + -- default, modified by use of -gnatwq/Q. Warn_On_Parameter_Order : Boolean := False; -- GNAT @@ -1613,7 +1617,7 @@ package Opt is Warn_On_Suspicious_Modulus_Value : Boolean := True; -- GNAT -- Set to True to generate warnings for suspicious modulus values. The - -- default is that this warning is enabled. + -- default is that this warning is enabled. Modified by -gnatw.m/.M. Warn_On_Unchecked_Conversion : Boolean := True; -- GNAT @@ -1626,12 +1630,12 @@ package Opt is -- Set to True to generate warnings for inappropriate uses (comparisons -- and explicit ranges) on unordered enumeration types (which includes -- all enumeration types for which pragma Ordered is not given). The - -- default is that this warning is disabled. + -- default is that this warning is disabled. Modified by -gnat.u/.U. Warn_On_Unrecognized_Pragma : Boolean := True; -- GNAT -- Set to True to generate warnings for unrecognized pragmas. The default - -- is that this warning is enabled. + -- is that this warning is enabled. Modified by use of -gnatwg/G. Warn_On_Unrepped_Components : Boolean := False; -- GNAT diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb index e73b8758386..007c3c76e55 100644 --- a/gcc/ada/sem_aggr.adb +++ b/gcc/ada/sem_aggr.adb @@ -468,13 +468,13 @@ package body Sem_Aggr is then if Is_Out_Of_Range (Exp, Base_Type (Check_Typ)) then Apply_Compile_Time_Constraint_Error - (Exp, "value not in range of}?", CE_Range_Check_Failed, + (Exp, "value not in range of}??", CE_Range_Check_Failed, Ent => Base_Type (Check_Typ), Typ => Base_Type (Check_Typ)); elsif Is_Out_Of_Range (Exp, Check_Typ) then Apply_Compile_Time_Constraint_Error - (Exp, "value not in range of}?", CE_Range_Check_Failed, + (Exp, "value not in range of}??", CE_Range_Check_Failed, Ent => Check_Typ, Typ => Check_Typ); @@ -583,9 +583,9 @@ package body Sem_Aggr is elsif Expr_Value (This_Low) /= Expr_Value (Aggr_Low (Dim)) then Set_Raises_Constraint_Error (N); - Error_Msg_N ("sub-aggregate low bound mismatch?", N); + Error_Msg_N ("sub-aggregate low bound mismatch??", N); Error_Msg_N - ("\Constraint_Error will be raised at run time?", N); + ("\Constraint_Error will be raised at run time??", N); end if; end if; @@ -597,9 +597,9 @@ package body Sem_Aggr is Expr_Value (This_High) /= Expr_Value (Aggr_High (Dim)) then Set_Raises_Constraint_Error (N); - Error_Msg_N ("sub-aggregate high bound mismatch?", N); + Error_Msg_N ("sub-aggregate high bound mismatch??", N); Error_Msg_N - ("\Constraint_Error will be raised at run time?", N); + ("\Constraint_Error will be raised at run time??", N); end if; end if; end if; @@ -1440,8 +1440,8 @@ package body Sem_Aggr is if OK_BH and then OK_AH and then Val_BH < Val_AH then Set_Raises_Constraint_Error (N); - Error_Msg_N ("upper bound out of range?", AH); - Error_Msg_N ("\Constraint_Error will be raised at run time?", AH); + Error_Msg_N ("upper bound out of range??", AH); + Error_Msg_N ("\Constraint_Error will be raised at run time??", AH); -- You need to set AH to BH or else in the case of enumerations -- indexes we will not be able to resolve the aggregate bounds. @@ -1483,14 +1483,14 @@ package body Sem_Aggr is if OK_L and then Val_L > Val_AL then Set_Raises_Constraint_Error (N); - Error_Msg_N ("lower bound of aggregate out of range?", N); - Error_Msg_N ("\Constraint_Error will be raised at run time?", N); + Error_Msg_N ("lower bound of aggregate out of range??", N); + Error_Msg_N ("\Constraint_Error will be raised at run time??", N); end if; if OK_H and then Val_H < Val_AH then Set_Raises_Constraint_Error (N); - Error_Msg_N ("upper bound of aggregate out of range?", N); - Error_Msg_N ("\Constraint_Error will be raised at run time?", N); + Error_Msg_N ("upper bound of aggregate out of range??", N); + Error_Msg_N ("\Constraint_Error will be raised at run time??", N); end if; end Check_Bounds; @@ -1529,8 +1529,8 @@ package body Sem_Aggr is if Range_Len < Len then Set_Raises_Constraint_Error (N); - Error_Msg_N ("too many elements?", N); - Error_Msg_N ("\Constraint_Error will be raised at run time?", N); + Error_Msg_N ("too many elements??", N); + Error_Msg_N ("\Constraint_Error will be raised at run time??", N); end if; end Check_Length; @@ -1980,7 +1980,7 @@ package body Sem_Aggr is elsif Nkind (Choice) = N_Subtype_Indication then Resolve_Discrete_Subtype_Indication (Choice, Index_Base); - -- Does the subtype indication evaluation raise CE ? + -- Does the subtype indication evaluation raise CE? Get_Index_Bounds (Subtype_Mark (Choice), S_Low, S_High); Get_Index_Bounds (Choice, Low, High); @@ -2310,7 +2310,8 @@ package body Sem_Aggr is (Enumeration_Pos (AHi) - Enumeration_Pos (ALo)) then Error_Msg_N - ("missing index value(s) in array aggregate?", N); + ("missing index value(s) in array aggregate??", + N); -- Output missing value(s) at start @@ -2319,11 +2320,11 @@ package body Sem_Aggr is if Chars (ALo) = Chars (Ent) then Error_Msg_Name_1 := Chars (ALo); - Error_Msg_N ("\ %?", N); + Error_Msg_N ("\ %??", N); else Error_Msg_Name_1 := Chars (ALo); Error_Msg_Name_2 := Chars (Ent); - Error_Msg_N ("\ % .. %?", N); + Error_Msg_N ("\ % .. %??", N); end if; end if; @@ -2334,11 +2335,11 @@ package body Sem_Aggr is if Chars (AHi) = Chars (Ent) then Error_Msg_Name_1 := Chars (Ent); - Error_Msg_N ("\ %?", N); + Error_Msg_N ("\ %??", N); else Error_Msg_Name_1 := Chars (Ent); Error_Msg_Name_2 := Chars (AHi); - Error_Msg_N ("\ % .. %?", N); + Error_Msg_N ("\ % .. %??", N); end if; end if; @@ -2356,7 +2357,7 @@ package body Sem_Aggr is not Is_Constrained (First_Subtype (Etype (N))) then Error_Msg_N - ("bounds of aggregate do not match target?", N); + ("bounds of aggregate do not match target??", N); end if; end; end if; @@ -2810,7 +2811,7 @@ package body Sem_Aggr is and then Enclosing_CPP_Parent (Typ) /= A_Type then Error_Msg_NE - ("?must use 'C'P'P constructor for type &", A, + ("??must use 'C'P'P constructor for type &", A, Enclosing_CPP_Parent (Typ)); -- The following call is not needed if the previous warning @@ -4576,9 +4577,9 @@ package body Sem_Aggr is Insert_Action (Compile_Time_Constraint_Error (Expr, - "(Ada 2005) null not allowed in null-excluding component?"), - Make_Raise_Constraint_Error (Sloc (Expr), - Reason => CE_Access_Check_Failed)); + "(Ada 2005) null not allowed in null-excluding component??"), + Make_Raise_Constraint_Error + (Sloc (Expr), Reason => CE_Access_Check_Failed)); -- Set proper type for bogus component (why is this needed???) diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 963a19f1db8..002f7272ba0 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -739,7 +739,7 @@ package body Sem_Attr is if Is_CPP_Class (Root_Type (Typ)) then Error_Msg_N - ("?current instance unsupported for derivations of " + ("??current instance unsupported for derivations of " & "'C'P'P types", N); end if; @@ -2019,7 +2019,7 @@ package body Sem_Attr is if not Attribute_83 (Attr_Id) then if Ada_Version = Ada_83 and then Comes_From_Source (N) then Error_Msg_Name_1 := Aname; - Error_Msg_N ("(Ada 83) attribute% is not standard?", N); + Error_Msg_N ("(Ada 83) attribute% is not standard??", N); end if; if Attribute_Impl_Def (Attr_Id) then @@ -2640,7 +2640,7 @@ package body Sem_Attr is and then Warn_On_Redundant_Constructs then Error_Msg_NE -- CODEFIX - ("?redundant attribute, & is its own base type", N, Typ); + ("?r?redundant attribute, & is its own base type", N, Typ); end if; if Nkind (Parent (N)) /= N_Attribute_Reference then @@ -2896,7 +2896,7 @@ package body Sem_Attr is if Warn_On_Obsolescent_Feature then Error_Msg_N ("constrained for private type is an " & - "obsolescent feature (RM J.4)?", N); + "obsolescent feature (RM J.4)?j?", N); end if; -- If we are within an instance, the attribute must be legal @@ -4346,7 +4346,7 @@ package body Sem_Attr is and then Is_Constant_Object (Entity (P)) then Error_Msg_N - ("?attribute Old applied to constant has no effect", P); + ("??attribute Old applied to constant has no effect", P); end if; -- The attribute appears within a pre/postcondition, but refers to @@ -4603,7 +4603,7 @@ package body Sem_Attr is and then Warn_On_Redundant_Constructs then Error_Msg_N - ("postconditions on inlined functions not enforced?", N); + ("postconditions on inlined functions not enforced?r?", N); end if; -- If we are in the scope of a function and in Spec_Expression mode, @@ -5032,10 +5032,10 @@ package body Sem_Attr is Name_Simple_Storage_Pool_Type)) then Error_Msg_Name_1 := Aname; - Error_Msg_N ("cannot use % attribute for type with simple " & - "storage pool?", N); + Error_Msg_N ("cannot use % attribute for type with simple " + & "storage pool??", N); Error_Msg_N - ("\Program_Error will be raised at run time?", N); + ("\Program_Error will be raised at run time??", N); Rewrite (N, Make_Raise_Program_Error @@ -5228,8 +5228,8 @@ package body Sem_Attr is if not Is_Tagged_Type (P_Type) then Error_Attr_P ("prefix of % attribute must be tagged"); - -- Next test does not apply to generated code - -- why not, and what does the illegal reference mean??? + -- Next test does not apply to generated code why not, and what does + -- the illegal reference mean??? elsif Is_Object_Reference (P) and then not Is_Class_Wide_Type (P_Type) @@ -5240,9 +5240,9 @@ package body Sem_Attr is "of class - wide type"); end if; - -- The prefix cannot be an incomplete type. However, references - -- to 'Tag can be generated when expanding interface conversions, - -- and this is legal. + -- The prefix cannot be an incomplete type. However, references to + -- 'Tag can be generated when expanding interface conversions, and + -- this is legal. if Comes_From_Source (N) then Check_Not_Incomplete_Type; @@ -5728,8 +5728,8 @@ package body Sem_Attr is begin if Present (Pred_Func) and then Current_Scope = Pred_Func then Error_Msg_N - ("attribute Valid requires a predicate check?", N); - Error_Msg_N ("\and will result in infinite recursion?", N); + ("attribute Valid requires a predicate check??", N); + Error_Msg_N ("\and will result in infinite recursion??", N); end if; end; @@ -5744,7 +5744,7 @@ package body Sem_Attr is Check_Object_Reference (P); if No_Scalar_Parts (P_Type) then - Error_Attr_P ("?attribute % always True, no scalars to check"); + Error_Attr_P ("??attribute % always True, no scalars to check"); end if; Set_Etype (N, Standard_Boolean); @@ -6095,7 +6095,7 @@ package body Sem_Attr is elsif Is_Out_Of_Range (N, T) then Apply_Compile_Time_Constraint_Error - (N, "value not in range of}?", CE_Range_Check_Failed); + (N, "value not in range of}??", CE_Range_Check_Failed); elsif not Range_Checks_Suppressed (T) then Enable_Range_Check (N); @@ -8894,9 +8894,10 @@ package body Sem_Attr is -- know will fail, so generate an appropriate warning. if In_Instance_Body then - Error_Msg_F ("?non-local pointer cannot point to local object", P); Error_Msg_F - ("\?Program_Error will be raised at run time", P); + ("??non-local pointer cannot point to local object", P); + Error_Msg_F + ("\??Program_Error will be raised at run time", P); Rewrite (N, Make_Raise_Program_Error (Loc, Reason => PE_Accessibility_Check_Failed)); @@ -9368,9 +9369,9 @@ package body Sem_Attr is if In_Instance_Body then Error_Msg_F - ("?non-local pointer cannot point to local object", P); + ("??non-local pointer cannot point to local object", P); Error_Msg_F - ("\?Program_Error will be raised at run time", P); + ("\??Program_Error will be raised at run time", P); Rewrite (N, Make_Raise_Program_Error (Loc, Reason => PE_Accessibility_Check_Failed)); @@ -9484,11 +9485,13 @@ package body Sem_Attr is declare D : constant Node_Id := Declaration_Node (Entity (P)); begin - Error_Msg_N ("aliased object has explicit bounds?", - D); - Error_Msg_N ("\declare without bounds" - & " (and with explicit initialization)?", D); - Error_Msg_N ("\for use with unconstrained access?", D); + Error_Msg_N + ("aliased object has explicit bounds??", D); + Error_Msg_N + ("\declare without bounds (and with explicit " + & "initialization)??", D); + Error_Msg_N + ("\for use with unconstrained access??", D); end; end if; end if; diff --git a/gcc/ada/sem_case.adb b/gcc/ada/sem_case.adb index 3dd3b617820..432de5dc367 100644 --- a/gcc/ada/sem_case.adb +++ b/gcc/ada/sem_case.adb @@ -601,8 +601,8 @@ package body Sem_Case is and then Comes_From_Source (Others_Choice) and then Is_Empty_List (Choice_List) then - Error_Msg_N ("?OTHERS choice is redundant", Others_Choice); - Error_Msg_N ("\previous choices cover all values", Others_Choice); + Error_Msg_N ("?r?OTHERS choice is redundant", Others_Choice); + Error_Msg_N ("\?r?previous choices cover all values", Others_Choice); end if; end Expand_Others_Choice; diff --git a/gcc/ada/sem_cat.adb b/gcc/ada/sem_cat.adb index 4d8b8ffc5d0..e4615393dd2 100644 --- a/gcc/ada/sem_cat.adb +++ b/gcc/ada/sem_cat.adb @@ -923,6 +923,7 @@ package body Sem_Cat is then -- If the type is private, it must have the Ada 2005 pragma -- Has_Preelaborable_Initialization. + -- The check is omitted within predefined units. This is probably -- obsolete code to fix the Ada 95 weakness in this area ??? @@ -1728,8 +1729,7 @@ package body Sem_Cat is Direct_Designated_Type := Designated_Type (T); Desig_Type := Etype (Direct_Designated_Type); - -- Why is the check below not in - -- Validate_Remote_Access_To_Class_Wide_Type??? + -- Why is this check not in Validate_Remote_Access_To_Class_Wide_Type??? if not Is_Valid_Remote_Object_Type (Desig_Type) then Error_Msg_N @@ -2047,6 +2047,7 @@ package body Sem_Cat is function Is_Primary (N : Node_Id) return Boolean; -- Determine whether node is syntactically a primary in an expression -- This function should probably be somewhere else ??? + -- -- Also it does not do what it says, e.g if N is a binary operator -- whose parent is a binary operator, Is_Primary returns True ??? @@ -2170,7 +2171,7 @@ package body Sem_Cat is if GNAT_Mode then Error_Msg_N - ("?non-static constant in preelaborated unit", N); + ("??non-static constant in preelaborated unit", N); else Flag_Non_Static_Expr ("non-static constant in preelaborated unit", N); diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index fdf69d15694..89dcb2f4438 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -12996,6 +12996,22 @@ package body Sem_Ch12 is end if; if Is_Global (E) then + + -- If the entity is a package renaming that is the prefix of + -- an expanded name, it has been rewritten as the renamed + -- package, which is necessary semantically but complicates + -- ASIS tree traversal, so we recover the original entity to + -- expose the renaming. + + if Ekind (E) = E_Package + and then Nkind (Parent (N)) = N_Expanded_Name + 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; + Set_Global_Type (N, N2); elsif Nkind (N) = N_Op_Concat diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 2308234f9e9..eb25443babf 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -3643,9 +3643,9 @@ package body Sem_Ch3 is (E, Attribute_Address)) then Error_Msg_N - ("?more than one task with same entry address", N); + ("??more than one task with same entry address", N); Error_Msg_N - ("\?Program_Error will be raised at run time", N); + ("\??Program_Error will be raised at run time", N); Insert_Action (N, Make_Raise_Program_Error (Loc, Reason => PE_Duplicated_Entry_Address)); @@ -10866,7 +10866,7 @@ package body Sem_Ch3 is if Ada_Version < Ada_2005 then Error_Msg_N ("access subtype of general access type would not " & - "be allowed in Ada 2005?", S); + "be allowed in Ada 2005?y?", S); else Error_Msg_N ("access subtype of general access type not allowed", S); @@ -10882,7 +10882,7 @@ package body Sem_Ch3 is if Ada_Version < Ada_2005 then Error_Msg_N ("access subtype would not be allowed in generic body " & - "in Ada 2005?", S); + "in Ada 2005?y?", S); else Error_Msg_N ("access subtype not allowed in generic body", S); @@ -11320,6 +11320,7 @@ package body Sem_Ch3 is -- to one: one new discriminant can constrain several old ones. In -- that case, scan sequentially the stored_constraint, the list of -- discriminants of the parents, and the constraints. + -- Previous code checked for the present of the Stored_Constraint -- list for the derived type, but did not use it at all. Should it -- be present when the component is a discriminated task type? @@ -11780,7 +11781,7 @@ package body Sem_Ch3 is if Warn_On_Obsolescent_Feature then Error_Msg_N ("subtype digits constraint is an " & - "obsolescent feature (RM J.3(8))?", C); + "obsolescent feature (RM J.3(8))?j?", C); end if; D := Digits_Expression (C); @@ -11794,7 +11795,7 @@ package body Sem_Ch3 is if Digits_Value (Def_Id) > Digits_Value (T) then Error_Msg_Uint_1 := Digits_Value (T); - Error_Msg_N ("?digits value is too large, maximum is ^", D); + Error_Msg_N ("??digits value is too large, maximum is ^", D); Rais := Make_Raise_Constraint_Error (Sloc (D), Reason => CE_Range_Check_Failed); @@ -12007,7 +12008,7 @@ package body Sem_Ch3 is if Warn_On_Obsolescent_Feature then Error_Msg_S ("subtype delta constraint is an " & - "obsolescent feature (RM J.3(7))?"); + "obsolescent feature (RM J.3(7))?j?"); end if; D := Delta_Expression (C); @@ -12020,7 +12021,7 @@ package body Sem_Ch3 is -- course there is an ACVC test that checks this! if Delta_Value (Def_Id) < Delta_Value (T) then - Error_Msg_N ("?delta value is too small", D); + Error_Msg_N ("??delta value is too small", D); Rais := Make_Raise_Constraint_Error (Sloc (D), Reason => CE_Range_Check_Failed); @@ -16797,10 +16798,6 @@ package body Sem_Ch3 is Set_Must_Not_Freeze (I); Set_Must_Not_Freeze (Prefix (I)); - - -- Is order critical??? if so, document why, if not - -- use Analyze_And_Resolve - Analyze_And_Resolve (I); T := Etype (I); R := I; @@ -16928,7 +16925,8 @@ package body Sem_Ch3 is and then Nkind (Right_Opnd (Mod_Expr)) = N_Integer_Literal and then Intval (Right_Opnd (Mod_Expr)) <= Uint_64 then - Error_Msg_N ("suspicious MOD value, was '*'* intended'??", Mod_Expr); + Error_Msg_N + ("suspicious MOD value, was '*'* intended'??M?", Mod_Expr); end if; -- Proceed with analysis of mod expression @@ -17273,7 +17271,7 @@ package body Sem_Ch3 is High_Val := Expr_Value_R (High); if Low_Val > High_Val then - Error_Msg_NE ("?fixed point type& has null range", Def, T); + Error_Msg_NE ("??fixed point type& has null range", Def, T); end if; end; end if; @@ -19141,7 +19139,7 @@ package body Sem_Ch3 is then Make_Class_Wide_Type (Typ); Error_Msg_N - ("incomplete view of tagged type should be declared tagged?", + ("incomplete view of tagged type should be declared tagged??", Parent (Current_Entity (Typ))); end if; return; diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 718af47f17c..414b2404c2b 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -636,7 +636,9 @@ package body Sem_Ch4 is Analyze (Not_Null_Check); else - Error_Msg_N ("null value not allowed here?", E); + -- Seems weird for the following to be a warning ??? + + Error_Msg_N ("null value not allowed here??", E); end if; end; end if; @@ -2082,7 +2084,8 @@ package body Sem_Ch4 is -- account a possible implicit dereference. if Is_Access_Type (Array_Type) then - Error_Msg_NW (Warn_On_Dereference, "?implicit dereference", N); + Error_Msg_NW + (Warn_On_Dereference, "?d?implicit dereference", N); Array_Type := Process_Implicit_Dereference_Prefix (Pent, P); end if; @@ -2241,7 +2244,8 @@ package body Sem_Ch4 is if Is_Access_Type (Typ) then Typ := Designated_Type (Typ); - Error_Msg_NW (Warn_On_Dereference, "?implicit dereference", N); + Error_Msg_NW + (Warn_On_Dereference, "?d?implicit dereference", N); end if; if Is_Array_Type (Typ) then @@ -2670,7 +2674,7 @@ package body Sem_Ch4 is and then Intval (Right_Opnd (Parent (N))) <= Uint_64 then Error_Msg_N - ("suspicious MOD value, was '*'* intended'??", Parent (N)); + ("suspicious MOD value, was '*'* intended'??M?", Parent (N)); end if; -- Remaining processing is same as for other arithmetic operators @@ -3235,7 +3239,7 @@ package body Sem_Ch4 is while Present (It.Typ) loop if Is_Access_Type (It.Typ) then T := Designated_Type (It.Typ); - Error_Msg_NW (Warn_On_Dereference, "?implicit dereference", N); + Error_Msg_NW (Warn_On_Dereference, "?d?implicit dereference", N); else T := It.Typ; end if; @@ -3318,7 +3322,7 @@ package body Sem_Ch4 is then Insert_Explicit_Dereference (Nam); Error_Msg_NW - (Warn_On_Dereference, "?implicit dereference", N); + (Warn_On_Dereference, "?d?implicit dereference", N); end if; end if; @@ -3427,13 +3431,13 @@ package body Sem_Ch4 is if All_Present (N) then Error_Msg_N - ("?quantified expression with ALL " + ("??quantified expression with ALL " & "over a null range has value True", N); Rewrite (N, New_Occurrence_Of (Standard_True, Loc)); else Error_Msg_N - ("?quantified expression with SOME " + ("??quantified expression with SOME " & "over a null range has value False", N); Rewrite (N, New_Occurrence_Of (Standard_False, Loc)); end if; @@ -3810,7 +3814,7 @@ package body Sem_Ch4 is -- Normal case of selected component applied to access type else - Error_Msg_NW (Warn_On_Dereference, "?implicit dereference", N); + Error_Msg_NW (Warn_On_Dereference, "?d?implicit dereference", N); if Is_Entity_Name (Name) then Pent := Entity (Name); @@ -3922,7 +3926,7 @@ package body Sem_Ch4 is if Is_Access_Type (Etype (Name)) then Insert_Explicit_Dereference (Name); - Error_Msg_NW (Warn_On_Dereference, "?implicit dereference", N); + Error_Msg_NW (Warn_On_Dereference, "?d?implicit dereference", N); end if; elsif Is_Record_Type (Prefix_Type) then @@ -4220,7 +4224,7 @@ package body Sem_Ch4 is if Is_Access_Type (Etype (Name)) then Insert_Explicit_Dereference (Name); Error_Msg_NW - (Warn_On_Dereference, "?implicit dereference", N); + (Warn_On_Dereference, "?d?implicit dereference", N); end if; end if; @@ -4403,7 +4407,7 @@ package body Sem_Ch4 is Ent => Prefix_Type, Rep => False); else Apply_Compile_Time_Constraint_Error - (N, "component not present in }?", + (N, "component not present in }??", CE_Discriminant_Check_Failed, Ent => Prefix_Type, Rep => False); end if; @@ -4537,7 +4541,8 @@ package body Sem_Ch4 is if Is_Access_Type (Typ) then Typ := Designated_Type (Typ); - Error_Msg_NW (Warn_On_Dereference, "?implicit dereference", N); + Error_Msg_NW + (Warn_On_Dereference, "?d?implicit dereference", N); end if; if Is_Array_Type (Typ) @@ -4574,7 +4579,7 @@ package body Sem_Ch4 is if Is_Access_Type (Array_Type) then Array_Type := Designated_Type (Array_Type); - Error_Msg_NW (Warn_On_Dereference, "?implicit dereference", N); + Error_Msg_NW (Warn_On_Dereference, "?d?implicit dereference", N); end if; if not Is_Array_Type (Array_Type) then diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index a16e01e2be8..04c07bec6d9 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -430,9 +430,9 @@ package body Sem_Ch5 is if Locking_Policy /= 'C' then Error_Msg_N ("assignment to the attribute PRIORITY has " & - "no effect?", Lhs); + "no effect??", Lhs); Error_Msg_N ("\since no Locking_Policy has been " & - "specified", Lhs); + "specified??", Lhs); end if; return; @@ -636,8 +636,9 @@ package body Sem_Ch5 is if Known_Null (Rhs) then Apply_Compile_Time_Constraint_Error - (N => Rhs, - Msg => "(Ada 2005) null not allowed in null-excluding objects?", + (N => Rhs, + Msg => + "(Ada 2005) null not allowed in null-excluding objects??", Reason => CE_Null_Not_Allowed); -- We still mark this as a possible modification, that's necessary @@ -717,10 +718,10 @@ package body Sem_Ch5 is then if Nkind (Lhs) in N_Has_Entity then Error_Msg_NE -- CODEFIX - ("?useless assignment of & to itself!", N, Entity (Lhs)); + ("?r?useless assignment of & to itself!", N, Entity (Lhs)); else Error_Msg_N -- CODEFIX - ("?useless assignment of object to itself!", N); + ("?r?useless assignment of object to itself!", N); end if; end if; @@ -2405,7 +2406,7 @@ package body Sem_Ch5 is (L, H, Assume_Valid => False) = GT then Error_Msg_N - ("?loop range is null, loop will not execute", DS); + ("??loop range is null, loop will not execute", DS); -- Since we know the range of the loop is null, set the -- appropriate flag to remove the loop entirely during @@ -2420,9 +2421,11 @@ package body Sem_Ch5 is else Error_Msg_N - ("?loop range may be null, loop may not execute", DS); + ("??loop range may be null, loop may not execute", + DS); Error_Msg_N - ("?can only execute if invalid values are present", DS); + ("??can only execute if invalid values are present", + DS); end if; end if; @@ -2449,8 +2452,8 @@ package body Sem_Ch5 is (Intval (Original_Node (H)) = Uint_0 or else Intval (Original_Node (H)) = Uint_1) then - Error_Msg_N ("?loop range may be null", DS); - Error_Msg_N ("\?bounds may be wrong way round", DS); + Error_Msg_N ("??loop range may be null", DS); + Error_Msg_N ("\??bounds may be wrong way round", DS); end if; end; end if; @@ -2666,7 +2669,7 @@ package body Sem_Ch5 is then Error_Msg_Sloc := Sloc (ODSD); Error_Msg_N - ("inner range same as outer range#?", DSD); + ("inner range same as outer range#??", DSD); end if; end; end if; @@ -2918,7 +2921,7 @@ package body Sem_Ch5 is Check_SPARK_Restriction ("unreachable code is not allowed", Error_Node); else - Error_Msg ("?unreachable code!", Sloc (Error_Node)); + Error_Msg ("??unreachable code!", Sloc (Error_Node)); end if; end if; diff --git a/gcc/ada/sem_disp.adb b/gcc/ada/sem_disp.adb index 50929365596..2e4186f2652 100644 --- a/gcc/ada/sem_disp.adb +++ b/gcc/ada/sem_disp.adb @@ -904,10 +904,10 @@ package body Sem_Disp is and then not Is_Generic_Type (Typ) and then not In_Instance then - Error_Msg_N ("?declaration of& is too late!", Subp); + Error_Msg_N ("??declaration of& is too late!", Subp); Error_Msg_NE -- CODEFIX?? - ("\spec should appear immediately after declaration of &!", - Subp, Typ); + ("\??spec should appear immediately after declaration " + & "of & !", Subp, Typ); exit; end if; @@ -933,10 +933,10 @@ package body Sem_Disp is and then not Is_Generic_Type (Typ) and then not In_Instance then - Error_Msg_N ("?declaration of& is too late!", Subp); + Error_Msg_N ("??declaration of& is too late!", Subp); Error_Msg_NE - ("\spec should appear immediately after declaration of &!", - Subp, Typ); + ("\??spec should appear immediately after declaration " + & "of & !", Subp, Typ); end if; end if; end; @@ -1153,7 +1153,7 @@ package body Sem_Disp is and then In_Same_List (Parent (Tagged_Type), Parent (Parent (Subp))) then Error_Msg_N - ("?not dispatching (must be defined in a package spec)", Subp); + ("??not dispatching (must be defined in a package spec)", Subp); return; -- When the type is frozen, it is legitimate to define a new @@ -1169,7 +1169,7 @@ package body Sem_Disp is elsif Is_Frozen (Tagged_Type) and then not Has_Dispatching_Parent then Error_Msg_N ("this primitive operation is declared too late", Subp); Error_Msg_NE - ("?no primitive operations for& after this line", + ("??no primitive operations for& after this line", Freeze_Node (Tagged_Type), Tagged_Type); return; @@ -1220,7 +1220,7 @@ package body Sem_Disp is else Error_Msg_NE - ("operation does not override inherited&?", Subp, Subp); + ("operation does not override inherited&??", Subp, Subp); end if; else diff --git a/gcc/ada/sem_dist.adb b/gcc/ada/sem_dist.adb index 678a6001b1a..f3d3e33ff77 100644 --- a/gcc/ada/sem_dist.adb +++ b/gcc/ada/sem_dist.adb @@ -522,8 +522,9 @@ package body Sem_Dist is Parameter := First (Parameter_Specifications (Type_Def)); while Present (Parameter) loop if Nkind (Parameter_Type (Parameter)) = N_Access_Definition then - Error_Msg_N ("formal parameter& has anonymous access type?", - Defining_Identifier (Parameter)); + Error_Msg_N + ("formal parameter& has anonymous access type??", + Defining_Identifier (Parameter)); Is_Degenerate := True; exit; end if; @@ -533,7 +534,7 @@ package body Sem_Dist is if Is_Degenerate then Error_Msg_NE - ("remote access-to-subprogram type& can only be null?", + ("remote access-to-subprogram type& can only be null??", Defining_Identifier (Parameter), User_Type); -- The only legal value for a RAS with a formal parameter of an diff --git a/gcc/ada/sem_elab.adb b/gcc/ada/sem_elab.adb index 6d88c966e1f..2b7c7a1c779 100644 --- a/gcc/ada/sem_elab.adb +++ b/gcc/ada/sem_elab.adb @@ -908,8 +908,8 @@ package body Sem_Elab is if Inst_Case then Elab_Warning - ("instantiation of& may raise Program_Error?", - "info: instantiation of& during elaboration?", Ent); + ("instantiation of& may raise Program_Error?l?", + "info: instantiation of& during elaboration?l?", Ent); -- Indirect call case, warning only in static elaboration -- case, because the attribute reference itself cannot raise @@ -917,7 +917,7 @@ package body Sem_Elab is elsif Access_Case then Elab_Warning - ("", "info: access to& during elaboration?", Ent); + ("", "info: access to& during elaboration?l?", Ent); -- Subprogram call case @@ -927,14 +927,14 @@ package body Sem_Elab is and then Comes_From_Source (Ent) then Elab_Warning - ("implicit call to & may raise Program_Error?", - "info: implicit call to & during elaboration?", + ("implicit call to & may raise Program_Error?l?", + "info: implicit call to & during elaboration?l?", Ent); else Elab_Warning - ("call to & may raise Program_Error?", - "info: call to & during elaboration?", + ("call to & may raise Program_Error?l?", + "info: call to & during elaboration?l?", Ent); end if; end if; @@ -943,14 +943,14 @@ package body Sem_Elab is if Nkind (N) in N_Subprogram_Instantiation then Elab_Warning - ("\missing pragma Elaborate for&?", - "\info: implicit pragma Elaborate for& generated?", + ("\missing pragma Elaborate for&?l?", + "\info: implicit pragma Elaborate for& generated?l?", W_Scope); else Elab_Warning - ("\missing pragma Elaborate_All for&?", - "\info: implicit pragma Elaborate_All for & generated?", + ("\missing pragma Elaborate_All for&?l?", + "\info: implicit pragma Elaborate_All for & generated?l?", W_Scope); end if; end Generate_Elab_Warnings; @@ -1030,7 +1030,7 @@ 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&??", N, E); end if; -- Set indication for binder to generate Elaborate_All @@ -1138,13 +1138,13 @@ package body Sem_Elab is -- Here we definitely have a bad instantiation - Error_Msg_NE ("?cannot instantiate& before body seen", N, Ent); + Error_Msg_NE ("??cannot instantiate& before body seen", N, Ent); if Present (Instance_Spec (N)) then Supply_Bodies (Instance_Spec (N)); end if; - Error_Msg_N ("\?Program_Error will be raised at run time", N); + Error_Msg_N ("\??Program_Error will be raised at run time", N); Insert_Elab_Check (N); Set_ABE_Is_Certain (N); end Check_Bad_Instantiation; @@ -1720,13 +1720,13 @@ package body Sem_Elab is Error_Msg_Sloc := Sloc (Ent); Error_Msg_NE - ("?elaboration code may access& before it is initialized", + ("??elaboration code may access& before it is initialized", N, Ent); Error_Msg_NE - ("\?suggest adding pragma Elaborate_Body to spec of &", + ("\??suggest adding pragma Elaborate_Body to spec of &", N, Scop); Error_Msg_N - ("\?or an explicit initialization could be added #", N); + ("\??or an explicit initialization could be added #", N); end if; if not All_Errors_Mode then @@ -2181,12 +2181,12 @@ package body Sem_Elab is if Elab_Call.Last = 0 then if Inst_Case then Error_Msg_NE - ("?cannot instantiate& before body seen", N, Orig_Ent); + ("??cannot instantiate& before body seen", N, Orig_Ent); else - Error_Msg_NE ("?cannot call& before body seen", N, Orig_Ent); + Error_Msg_NE ("??cannot call& before body seen", N, Orig_Ent); end if; - Error_Msg_N ("\?Program_Error will be raised at run time", N); + Error_Msg_N ("\??Program_Error will be raised at run time", N); Insert_Elab_Check (N); -- Call is not at outer level @@ -2255,15 +2255,15 @@ package body Sem_Elab is then if Inst_Case then Error_Msg_NE - ("instantiation of& may occur before body is seen?", + ("instantiation of& may occur before body is seen??", N, Orig_Ent); else Error_Msg_NE - ("call to& may occur before body is seen?", N, Orig_Ent); + ("call to& may occur before body is seen??", N, Orig_Ent); end if; Error_Msg_N - ("\Program_Error may be raised at run time?", N); + ("\Program_Error may be raised at run time??", N); Output_Calls (N); end if; @@ -2359,10 +2359,10 @@ package body Sem_Elab is Scope (Proc) = Scope (Defining_Identifier (Decl))) then Error_Msg_N - ("task will be activated before elaboration of its body?", + ("task will be activated before elaboration of its body??", Decl); Error_Msg_N - ("\Program_Error will be raised at run time?", Decl); + ("\Program_Error will be raised at run time??", Decl); elsif Present (Corresponding_Body (Unit_Declaration_Node (Proc))) @@ -2506,7 +2506,7 @@ 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 &??", N, Ent); end if; Activate_Elaborate_All_Desirable (N, Task_Scope); @@ -3082,16 +3082,16 @@ package body Sem_Elab is Ent := Elab_Call.Table (J).Ent; if Is_Generic_Unit (Ent) then - Error_Msg_NE ("\?& instantiated #", N, Ent); + Error_Msg_NE ("\??& instantiated #", N, Ent); elsif Is_Init_Proc (Ent) then - Error_Msg_N ("\?initialization procedure called #", N); + Error_Msg_N ("\??initialization procedure called #", N); elsif Is_Printable_Error_Name (Chars (Ent)) then - Error_Msg_NE ("\?& called #", N, Ent); + Error_Msg_NE ("\??& called #", N, Ent); else - Error_Msg_N ("\? called #", N); + Error_Msg_N ("\?? called #", N); end if; end loop; end Output_Calls; diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb index 89f60ff5eac..ab7f3c934ae 100644 --- a/gcc/ada/sem_eval.adb +++ b/gcc/ada/sem_eval.adb @@ -293,7 +293,7 @@ package body Sem_Eval is and then Is_Out_Of_Range (N, Base_Type (T), Assume_Valid => True) then Error_Msg_N - ("?float value out of range, infinity will be generated", N); + ("??float value out of range, infinity will be generated", N); end if; return; @@ -369,7 +369,7 @@ package body Sem_Eval is Intval (N) > Expr_Value (Type_High_Bound (Universal_Integer))) then Apply_Compile_Time_Constraint_Error - (N, "non-static universal integer value out of range?", + (N, "non-static universal integer value out of range??", CE_Range_Check_Failed); -- Check out of range of base type @@ -390,7 +390,7 @@ package body Sem_Eval is elsif Is_Out_Of_Range (N, T, Assume_Valid => True) then Apply_Compile_Time_Constraint_Error - (N, "value not in range of}?", CE_Range_Check_Failed); + (N, "value not in range of}??", CE_Range_Check_Failed); elsif Checks_On then Enable_Range_Check (N); @@ -407,14 +407,12 @@ package body Sem_Eval is procedure Check_String_Literal_Length (N : Node_Id; Ttype : Entity_Id) is begin - if not Raises_Constraint_Error (N) - and then Is_Constrained (Ttype) - then + if not Raises_Constraint_Error (N) and then Is_Constrained (Ttype) then if UI_From_Int (String_Length (Strval (N))) /= String_Type_Len (Ttype) then Apply_Compile_Time_Constraint_Error - (N, "string length wrong for}?", + (N, "string length wrong for}??", CE_Length_Check_Failed, Ent => Ttype, Typ => Ttype); @@ -1655,7 +1653,7 @@ package body Sem_Eval is begin if Result < Lo or else Result > Hi then Apply_Compile_Time_Constraint_Error - (N, "value not in range of }?", + (N, "value not in range of }??", CE_Overflow_Check_Failed, Ent => BT); return; @@ -3316,10 +3314,10 @@ package body Sem_Eval is = Entity (Drange) then if Warn_On_Redundant_Constructs then - Error_Msg_N ("redundant slice denotes whole array?", N); + Error_Msg_N ("redundant slice denotes whole array?r?", N); end if; - -- The following might be a useful optimization???? + -- The following might be a useful optimization??? -- Rewrite (N, New_Occurrence_Of (E, Sloc (N))); end if; @@ -4656,7 +4654,7 @@ package body Sem_Eval is else Apply_Compile_Time_Constraint_Error - (N, "value not in range of}?", CE_Range_Check_Failed); + (N, "value not in range of}??", CE_Range_Check_Failed); end if; end Out_Of_Range; diff --git a/gcc/ada/sem_intr.adb b/gcc/ada/sem_intr.adb index 93eb4924735..fe3855d33d6 100644 --- a/gcc/ada/sem_intr.adb +++ b/gcc/ada/sem_intr.adb @@ -163,7 +163,7 @@ package body Sem_Intr is and then Can_Never_Be_Null (Etype (Arg1)) then Error_Msg_N - ("freeing `NOT NULL` object will raise Constraint_Error?", N); + ("freeing `NOT NULL` object will raise Constraint_Error??", N); -- For unchecked deallocation, error to deallocate from empty pool. -- Note: this test used to be in Exp_Intr as a warning, but AI 157 diff --git a/gcc/ada/sem_mech.adb b/gcc/ada/sem_mech.adb index 6bd498ef9fc..e2fce979a22 100644 --- a/gcc/ada/sem_mech.adb +++ b/gcc/ada/sem_mech.adb @@ -245,7 +245,7 @@ package body Sem_Mech is if Mech in Descriptor_Codes and then not Is_Formal (Ent) then if Is_Record_Type (Etype (Ent)) then - Error_Msg_N ("?records cannot be returned by Descriptor", Enod); + Error_Msg_N ("??records cannot be returned by Descriptor", Enod); return; end if; end if; diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 35410b8be3f..3364b6eb7e8 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -980,7 +980,7 @@ package body Sem_Prag is procedure Check_Ada_83_Warning is begin if Ada_Version = Ada_83 and then Comes_From_Source (N) then - Error_Msg_N ("(Ada 83) pragma& is non-standard?", N); + Error_Msg_N ("(Ada 83) pragma& is non-standard??", N); end if; end Check_Ada_83_Warning; @@ -1853,7 +1853,7 @@ package body Sem_Prag is then Error_Msg_Name_1 := Pname; Error_Msg_N - ("?pragma% is only effective in main program", N); + ("??pragma% is only effective in main program", N); end if; end Check_In_Main_Program; @@ -3551,7 +3551,7 @@ package body Sem_Prag is else if Warn_On_Export_Import and not OpenVMS_On_Target then Error_Msg_N - ("?unrecognized convention name, C assumed", + ("??unrecognized convention name, C assumed", Get_Pragma_Arg (Arg1)); end if; @@ -3860,7 +3860,7 @@ package body Sem_Prag is begin if not OpenVMS_On_Target then Error_Pragma - ("?pragma% ignored (applies only to Open'V'M'S)"); + ("??pragma% ignored (applies only to Open'V'M'S)"); end if; Process_Extended_Import_Export_Internal_Arg (Arg_Internal); @@ -3996,7 +3996,7 @@ package body Sem_Prag is end if; if Warn_On_Export_Import and then Is_Exported (Def_Id) then - Error_Msg_N ("?duplicate Export_Object pragma", N); + Error_Msg_N ("??duplicate Export_Object pragma", N); else Set_Exported (Def_Id, Arg_Internal); end if; @@ -4019,21 +4019,20 @@ package body Sem_Prag is and then Has_Discriminants (Etype (Def_Id)) then Error_Msg_N - ("imported value must be initialized?", Arg_Internal); + ("imported value must be initialized??", Arg_Internal); end if; if Warn_On_Export_Import and then Is_Access_Type (Etype (Def_Id)) then Error_Pragma_Arg - ("cannot import object of an access type?", Arg_Internal); + ("cannot import object of an access type??", Arg_Internal); end if; if Warn_On_Export_Import and then Is_Imported (Def_Id) then - Error_Msg_N - ("?duplicate Import_Object pragma", N); + Error_Msg_N ("??duplicate Import_Object pragma", N); -- Check for explicit initialization present. Note that an -- initialization generated by the code generator, e.g. for an @@ -4957,7 +4956,7 @@ package body Sem_Prag is if Front_End_Inlining and then Analyzed (Corresponding_Body (Decl)) then - Error_Msg_N ("pragma appears too late, ignored?", N); + Error_Msg_N ("pragma appears too late, ignored??", N); return True; -- If the subprogram is a renaming as body, the body is just a @@ -5209,10 +5208,12 @@ package body Sem_Prag is then if Inlining_Not_Possible (Subp) then Error_Msg_NE - ("pragma Inline for& is ignored?", N, Entity (Subp_Id)); + ("pragma Inline for& is ignored?r?", + N, Entity (Subp_Id)); else Error_Msg_NE - ("pragma Inline for& is redundant?", N, Entity (Subp_Id)); + ("pragma Inline for& is redundant?r?", + N, Entity (Subp_Id)); end if; end if; @@ -5284,7 +5285,7 @@ package body Sem_Prag is Get_Character (C) = '/')) then Error_Msg - ("?interface name contains illegal character", + ("??interface name contains illegal character", Sloc (SN) + Source_Ptr (J)); end if; end loop; @@ -5704,7 +5705,7 @@ package body Sem_Prag is if not UI_Is_In_Int_Range (Val) then Error_Pragma_Arg - ("pragma ignored, value too large?", Arg); + ("pragma ignored, value too large??", Arg); end if; -- Warning case. If the real restriction is active, then we @@ -5981,20 +5982,23 @@ package body Sem_Prag is and then Comes_From_Source (Arg) then Error_Msg_NE - ("?& has been made static as a result of Export", Arg, E); + ("?x?& has been made static as a result of Export", + Arg, E); Error_Msg_N - ("\this usage is non-standard and non-portable", Arg); + ("\?x?this usage is non-standard and non-portable", + Arg); end if; end if; end if; if Warn_On_Export_Import and then Is_Type (E) then - Error_Msg_NE ("exporting a type has no effect?", Arg, E); + Error_Msg_NE ("exporting a type has no effect?x?", Arg, E); end if; if Warn_On_Export_Import and Inside_A_Generic then Error_Msg_NE - ("all instances of& will have the same external name?", Arg, E); + ("all instances of& will have the same external name?x?", + Arg, E); end if; end Set_Exported; @@ -6562,13 +6566,13 @@ package body Sem_Prag is if not Is_Pragma_Name (Pname) then if Warn_On_Unrecognized_Pragma then Error_Msg_Name_1 := Pname; - Error_Msg_N ("?unrecognized pragma%!", Pragma_Identifier (N)); + Error_Msg_N ("?g?unrecognized pragma%!", Pragma_Identifier (N)); for PN in First_Pragma_Name .. Last_Pragma_Name loop if Is_Bad_Spelling_Of (Pname, PN) then Error_Msg_Name_1 := PN; Error_Msg_N -- CODEFIX - ("\?possible misspelling of %!", Pragma_Identifier (N)); + ("\?g?possible misspelling of %!", Pragma_Identifier (N)); exit; end if; end loop; @@ -8119,7 +8123,7 @@ package body Sem_Prag is -- Following message is obsolete ??? Error_Msg_N ("'G'N'A'T pragma cpp'_class is now obsolete and has no " & - "effect; replace it by pragma import?", N); + "effect; replace it by pragma import?j?", N); end if; Check_Arg_Count (1); @@ -8171,7 +8175,7 @@ package body Sem_Prag is if Is_Constructor (Def_Id) then Error_Msg_N - ("?duplicate argument for pragma 'C'P'P_Constructor", Arg1); + ("??duplicate argument for pragma 'C'P'P_Constructor", Arg1); return; end if; @@ -8245,7 +8249,7 @@ package body Sem_Prag is if Warn_On_Obsolescent_Feature then Error_Msg_N ("'G'N'A'T pragma cpp'_virtual is now obsolete and has " & - "no effect?", N); + "no effect?j?", N); end if; end CPP_Virtual; @@ -8260,7 +8264,7 @@ package body Sem_Prag is if Warn_On_Obsolescent_Feature then Error_Msg_N ("'G'N'A'T pragma cpp'_vtable is now obsolete and has " & - "no effect?", N); + "no effect?j?", N); end if; end CPP_Vtable; @@ -8745,9 +8749,9 @@ package body Sem_Prag is if Elab_Warnings and not Dynamic_Elaboration_Checks then Error_Msg_N - ("?use of pragma Elaborate may not be safe", N); + ("?l?use of pragma Elaborate may not be safe", N); Error_Msg_N - ("?use pragma Elaborate_All instead if possible", N); + ("?l?use pragma Elaborate_All instead if possible", N); end if; end Elaborate; @@ -9586,7 +9590,7 @@ package body Sem_Prag is if not OpenVMS_On_Target then if Chars (Get_Pragma_Arg (Arg1)) = Name_VAX_Float then Error_Pragma - ("?pragma% ignored (applies only to Open'V'M'S)"); + ("??pragma% ignored (applies only to Open'V'M'S)"); end if; return; @@ -11564,7 +11568,7 @@ package body Sem_Prag is Check_Arg_Is_One_Of (Arg1, Name_D_Float, Name_G_Float); if not OpenVMS_On_Target then - Error_Pragma ("?pragma% ignored (applies only to Open'V'M'S)"); + Error_Pragma ("??pragma% ignored (applies only to Open'V'M'S)"); end if; -- D_Float case @@ -12468,7 +12472,7 @@ package body Sem_Prag is elsif VM_Target /= No_VM then if not GNAT_Mode then Error_Pragma - ("?pragma% ignored in this configuration"); + ("??pragma% ignored in this configuration"); end if; -- Normal case where we do the pack action @@ -12494,7 +12498,7 @@ package body Sem_Prag is if VM_Target /= No_VM then if not GNAT_Mode then Error_Pragma - ("?pragma% ignored in this configuration"); + ("??pragma% ignored in this configuration"); end if; -- Normal case of pack request active @@ -12639,7 +12643,7 @@ package body Sem_Prag is if Has_Pragma_Preelab_Init (Ent) and then Warn_On_Redundant_Constructs then - Error_Pragma ("?duplicate pragma%!"); + Error_Pragma ("?r?duplicate pragma%!"); else Set_Has_Pragma_Preelab_Init (Ent); end if; @@ -13314,7 +13318,7 @@ package body Sem_Prag is or else Has_Rep_Pragma (Def_Id, Name_Psect_Object) then - Error_Msg_N ("?duplicate Common/Psect_Object pragma", N); + Error_Msg_N ("??duplicate Common/Psect_Object pragma", N); end if; if Ekind (Def_Id) = E_Constant then @@ -13338,7 +13342,7 @@ package body Sem_Prag is and then Warn_On_Export_Import then Error_Msg_N - ("?object for pragma % has defaults", Internal); + ("?x?object for pragma % has defaults", Internal); exit; else @@ -13522,7 +13526,7 @@ package body Sem_Prag is and then Warn_On_Redundant_Constructs then Error_Msg_NE - ("pragma Pure_Function on& is redundant?", + ("pragma Pure_Function on& is redundant?r?", N, Entity (E_Id)); end if; end if; @@ -13728,8 +13732,10 @@ package body Sem_Prag is Set_Ravenscar_Profile (N); if Warn_On_Obsolescent_Feature then - Error_Msg_N ("pragma Ravenscar is an obsolescent feature?", N); - Error_Msg_N ("|use pragma Profile (Ravenscar) instead", N); + Error_Msg_N + ("pragma Ravenscar is an obsolescent feature?j?", N); + Error_Msg_N + ("|use pragma Profile (Ravenscar) instead?j?", N); end if; ------------------------- @@ -13747,8 +13753,10 @@ package body Sem_Prag is if Warn_On_Obsolescent_Feature then Error_Msg_N - ("pragma Restricted_Run_Time is an obsolescent feature?", N); - Error_Msg_N ("|use pragma Profile (Restricted) instead", N); + ("pragma Restricted_Run_Time is an obsolescent feature?j?", + N); + Error_Msg_N + ("|use pragma Profile (Restricted) instead?j?", N); end if; ------------------ @@ -14939,7 +14947,7 @@ package body Sem_Prag is end if; if not AAMP_On_Target then - Error_Pragma ("?pragma% ignored (applies only to AAMP)"); + Error_Pragma ("??pragma% ignored (applies only to AAMP)"); end if; ---------------- @@ -15432,7 +15440,7 @@ package body Sem_Prag is if Err then Error_Msg - ("?pragma Warnings On with no " & + ("??pragma Warnings On with no " & "matching Warnings Off", Loc); end if; diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 26183a690c5..fff52950e2a 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -577,7 +577,7 @@ package body Sem_Res is -- Warn about the danger Error_Msg_N - ("?creation of & object may raise Storage_Error!", + ("??creation of & object may raise Storage_Error!", Scope (Disc)); <> @@ -769,8 +769,8 @@ package body Sem_Res is and then Nkind (Parent (P)) = N_Subprogram_Body and then Is_Empty_List (Declarations (Parent (P))) then - Error_Msg_N ("!?infinite recursion", N); - Error_Msg_N ("\!?Storage_Error will be raised at run time", N); + Error_Msg_N ("!??infinite recursion", N); + Error_Msg_N ("\!??Storage_Error will be raised at run time", N); Insert_Action (N, Make_Raise_Storage_Error (Sloc (N), Reason => SE_Infinite_Recursion)); @@ -867,8 +867,8 @@ package body Sem_Res is end if; end loop; - Error_Msg_N ("!?possible infinite recursion", N); - Error_Msg_N ("\!?Storage_Error may be raised at run time", N); + Error_Msg_N ("!??possible infinite recursion", N); + Error_Msg_N ("\!??Storage_Error may be raised at run time", N); return True; end Check_Infinite_Recursion; @@ -3963,14 +3963,14 @@ package body Sem_Res is if Is_Controlling_Formal (F) then Apply_Compile_Time_Constraint_Error (N => A, - Msg => "null value not allowed here?", + Msg => "null value not allowed here??", Reason => CE_Access_Check_Failed); elsif Ada_Version >= Ada_2005 then Apply_Compile_Time_Constraint_Error (N => A, Msg => "(Ada 2005) null not allowed in " - & "null-excluding formal?", + & "null-excluding formal??", Reason => CE_Null_Not_Allowed); end if; end if; @@ -4448,9 +4448,9 @@ package body Sem_Res is Deepest_Type_Access_Level (Typ) then if In_Instance_Body then - Error_Msg_N ("?type in allocator has deeper level than" & + Error_Msg_N ("??type in allocator has deeper level than" & " designated class-wide type", E); - Error_Msg_N ("\?Program_Error will be raised at run time", + Error_Msg_N ("\??Program_Error will be raised at run time", E); Rewrite (N, Make_Raise_Program_Error (Sloc (N), @@ -4556,8 +4556,8 @@ package body Sem_Res is and then Ekind (Current_Scope) = E_Package and then not In_Package_Body (Current_Scope) then - Error_Msg_N ("?cannot activate task before body seen", N); - Error_Msg_N ("\?Program_Error will be raised at run time", N); + Error_Msg_N ("??cannot activate task before body seen", N); + Error_Msg_N ("\??Program_Error will be raised at run time", N); end if; -- Ada 2012 (AI05-0111-3): Detect an attempt to allocate a task or a @@ -4569,8 +4569,8 @@ package body Sem_Res is and then Present (Subpool_Handle_Name (N)) and then Has_Task (Desig_T) then - Error_Msg_N ("?cannot allocate task on subpool", N); - Error_Msg_N ("\?Program_Error will be raised at run time", N); + Error_Msg_N ("??cannot allocate task on subpool", N); + Error_Msg_N ("\??Program_Error will be raised at run time", N); Rewrite (N, Make_Raise_Program_Error (Sloc (N), @@ -5026,24 +5026,24 @@ package body Sem_Res is then Error_Msg_N ("float division by zero, " & - "may generate '+'/'- infinity?", Right_Opnd (N)); + "may generate '+'/'- infinity??", Right_Opnd (N)); -- For all other cases, we get a Constraint_Error else Apply_Compile_Time_Constraint_Error - (N, "division by zero?", CE_Divide_By_Zero, + (N, "division by zero??", CE_Divide_By_Zero, Loc => Sloc (Right_Opnd (N))); end if; when N_Op_Rem => Apply_Compile_Time_Constraint_Error - (N, "rem with zero divisor?", CE_Divide_By_Zero, + (N, "rem with zero divisor??", CE_Divide_By_Zero, Loc => Sloc (Right_Opnd (N))); when N_Op_Mod => Apply_Compile_Time_Constraint_Error - (N, "mod with zero divisor?", CE_Divide_By_Zero, + (N, "mod with zero divisor??", CE_Divide_By_Zero, Loc => Sloc (Right_Opnd (N))); -- Division by zero can only happen with division, rem, @@ -5285,10 +5285,10 @@ package body Sem_Res is then Rtype := Etype (N); Error_Msg_NE - ("?& should not be used in entry body (RM C.7(17))", + ("??& should not be used in entry body (RM C.7(17))", N, Nam); Error_Msg_NE - ("\Program_Error will be raised at run time?", N, Nam); + ("\Program_Error will be raised at run time??", N, Nam); Rewrite (N, Make_Raise_Program_Error (Loc, Reason => PE_Current_Task_In_Entry_Body)); @@ -5578,9 +5578,9 @@ package body Sem_Res is Set_Has_Recursive_Call (Nam); Error_Msg_N - ("?possible infinite recursion!", N); + ("??possible infinite recursion!", N); Error_Msg_N - ("\?Storage_Error may be raised at run time!", N); + ("\??Storage_Error may be raised at run time!", N); end if; exit Scope_Loop; @@ -5898,8 +5898,8 @@ package body Sem_Res is end loop; if not Call_OK then - Error_Msg_N ("!? cannot determine tag of result", N); - Error_Msg_N ("!? Program_Error will be raised", N); + Error_Msg_N ("!?? cannot determine tag of result", N); + Error_Msg_N ("!?? Program_Error will be raised", N); Insert_Action (N, Make_Raise_Program_Error (Sloc (N), Reason => PE_Explicit_Raise)); @@ -6100,7 +6100,7 @@ package body Sem_Res is -- Check comparison on unordered enumeration if Bad_Unordered_Enumeration_Reference (N, Etype (L)) then - Error_Msg_N ("comparison on unordered enumeration type?", N); + Error_Msg_N ("comparison on unordered enumeration type?U?", N); end if; -- Evaluate the relation (note we do this after the above check since @@ -6939,7 +6939,7 @@ package body Sem_Res is and then Comes_From_Source (R) then Error_Msg_N -- CODEFIX - ("?comparison with True is redundant!", R); + ("?r?comparison with True is redundant!", R); end if; Check_Unset_Reference (L); @@ -7322,9 +7322,9 @@ package body Sem_Res is and then Is_Bit_Packed_Array (Array_Type) and then Is_LHS (N) then - Error_Msg_N ("?assignment to component of packed atomic array", + Error_Msg_N ("??assignment to component of packed atomic array", Prefix (N)); - Error_Msg_N ("?\may cause unexpected accesses to atomic object", + Error_Msg_N ("??\may cause unexpected accesses to atomic object", Prefix (N)); end if; end Resolve_Indexed_Component; @@ -7700,7 +7700,7 @@ package body Sem_Res is while Present (Alt) loop if Is_Static_Expression (Alt) and then (Nkind_In (Alt, N_Integer_Literal, - N_Character_Literal) + N_Character_Literal) or else Nkind (Alt) in N_Has_Entity) then Nalts := Nalts + 1; @@ -7709,7 +7709,7 @@ package body Sem_Res is for J in 1 .. Nalts - 1 loop if Alts (J).Val = Alts (Nalts).Val then Error_Msg_Sloc := Sloc (Alts (J).Alt); - Error_Msg_N ("duplicate of value given#?", Alt); + Error_Msg_N ("duplicate of value given#??", Alt); end if; end loop; end if; @@ -7838,7 +7838,7 @@ package body Sem_Res is if not Inside_Init_Proc then Insert_Action (Compile_Time_Constraint_Error (N, - "(Ada 2005) null not allowed in null-excluding objects?"), + "(Ada 2005) null not allowed in null-excluding objects??"), Make_Raise_Constraint_Error (Loc, Reason => CE_Access_Check_Failed)); else @@ -8308,7 +8308,7 @@ package body Sem_Res is and then not Is_Boolean_Type (Typ) and then Parent_Is_Boolean then - Error_Msg_N ("?not expression should be parenthesized here!", N); + Error_Msg_N ("?q?not expression should be parenthesized here!", N); end if; -- Warn on double negation if checking redundant constructs @@ -8319,7 +8319,7 @@ package body Sem_Res is and then Root_Type (Typ) = Standard_Boolean and then Nkind (Right_Opnd (N)) = N_Op_Not then - Error_Msg_N ("redundant double negation?", N); + Error_Msg_N ("redundant double negation?r?", N); end if; -- Complete resolution and evaluation of NOT @@ -8459,7 +8459,7 @@ package body Sem_Res is and then not First_Last_Ref then - Error_Msg ("subrange of unordered enumeration type?", Sloc (N)); + Error_Msg ("subrange of unordered enumeration type?U?", Sloc (N)); end if; Check_Unset_Reference (L); @@ -8546,7 +8546,7 @@ package body Sem_Res is and then Warn_On_Bad_Fixed_Value then Error_Msg_N - ("?static fixed-point value is not a multiple of Small!", + ("?b?static fixed-point value is not a multiple of Small!", N); end if; @@ -8796,9 +8796,9 @@ package body Sem_Res is and then Is_LHS (N) then Error_Msg_N - ("?assignment to component of packed atomic record", Prefix (N)); + ("??assignment to component of packed atomic record", Prefix (N)); Error_Msg_N - ("?\may cause unexpected accesses to atomic object", Prefix (N)); + ("\??may cause unexpected accesses to atomic object", Prefix (N)); end if; Analyze_Dimension (N); @@ -8891,7 +8891,7 @@ package body Sem_Res is -- of the First_Node call here. Error_Msg_F - ("?assertion would fail at run time!", + ("??assertion would fail at run time!", Expression (First (Pragma_Argument_Associations (Orig)))); end if; @@ -8906,10 +8906,9 @@ package body Sem_Res is declare Expr : constant Node_Id := - Original_Node - (Expression - (Next (First - (Pragma_Argument_Associations (Orig))))); + Original_Node + (Expression + (Next (First (Pragma_Argument_Associations (Orig))))); begin if Is_Entity_Name (Expr) and then Entity (Expr) = Standard_False @@ -8923,7 +8922,7 @@ package body Sem_Res is -- comment above for an explanation of why we do this. Error_Msg_F - ("?check would fail at run time!", + ("??check would fail at run time!", Expression (Last (Pragma_Argument_Associations (Orig)))); end if; @@ -9329,7 +9328,8 @@ package body Sem_Res is or else Char_Val > Expr_Value (Comp_Typ_Hi) then Apply_Compile_Time_Constraint_Error - (N, "character out of range?", CE_Range_Check_Failed, + (N, "character out of range??", + CE_Range_Check_Failed, Loc => Source_Ptr (Int (Loc) + J)); end if; end loop; @@ -9474,11 +9474,10 @@ package body Sem_Res is and then abs (Realval (Rop)) < Delta_Value (Standard_Duration) then Error_Msg_N - ("?universal real operand can only " & - "be interpreted as Duration!", - Rop); + ("??universal real operand can only " & + "be interpreted as Duration!", Rop); Error_Msg_N - ("\?precision will be lost in the conversion!", Rop); + ("\??precision will be lost in the conversion!", Rop); end if; elsif Is_Numeric_Type (Typ) @@ -9654,15 +9653,17 @@ package body Sem_Res is -- entity, give the name of the entity in the message. If not, -- just mention the expression. + -- Shoudn't we test Warn_On_Redundant_Constructs here ??? + else if Is_Entity_Name (Orig_N) then Error_Msg_Node_2 := Orig_T; Error_Msg_NE -- CODEFIX - ("?redundant conversion, & is of type &!", + ("??redundant conversion, & is of type &!", N, Entity (Orig_N)); else Error_Msg_NE - ("?redundant conversion, expression is of type&!", + ("??redundant conversion, expression is of type&!", N, Orig_T); end if; end if; @@ -9830,7 +9831,7 @@ package body Sem_Res is if OK and then Hi >= Lo and then Lo >= 0 then Error_Msg_N -- CODEFIX - ("?abs applied to known non-negative value has no effect", N); + ("?r?abs applied to known non-negative value has no effect", N); end if; end if; @@ -9968,8 +9969,10 @@ package body Sem_Res is -- If we fall through warning should be issued + -- Shouldn't we test Warn_On_Questionable_Missing_Parens ??? + Error_Msg_N - ("?unary minus expression should be parenthesized here!", N); + ("??unary minus expression should be parenthesized here!", N); end if; end if; end; @@ -10443,9 +10446,11 @@ package body Sem_Res is end loop; if Nkind (N) = N_Real_Literal then - Error_Msg_NE ("?real literal interpreted as }!", N, T1); + Error_Msg_NE + ("??real literal interpreted as }!", N, T1); else - Error_Msg_NE ("?universal_fixed expression interpreted as }!", N, T1); + Error_Msg_NE + ("??universal_fixed expression interpreted as }!", N, T1); end if; return T1; @@ -10628,10 +10633,10 @@ package body Sem_Res is then if In_Instance_Body then Error_Msg_N - ("?source array type has " & + ("??source array type has " & "deeper accessibility level than target", Operand); Error_Msg_N - ("\?Program_Error will be raised at run time", + ("\??Program_Error will be raised at run time", Operand); Rewrite (N, Make_Raise_Program_Error (Sloc (N), @@ -10915,10 +10920,10 @@ package body Sem_Res is if In_Instance_Body then Error_Msg_N - ("?cannot convert local pointer to non-local access type", + ("??cannot convert local pointer to non-local access type", Operand); Error_Msg_N - ("\?Program_Error will be raised at run time", Operand); + ("\??Program_Error will be raised at run time", Operand); else Error_Msg_N @@ -10948,10 +10953,11 @@ package body Sem_Res is if In_Instance_Body then Error_Msg_N - ("?cannot convert access discriminant to non-local" & + ("??cannot convert access discriminant to non-local" & " access type", Operand); Error_Msg_N - ("\?Program_Error will be raised at run time", Operand); + ("\??Program_Error will be raised at run time", + Operand); else Error_Msg_N ("cannot convert access discriminant to non-local" & @@ -11092,10 +11098,10 @@ package body Sem_Res is if In_Instance_Body then Error_Msg_N - ("?cannot convert local pointer to non-local access type", + ("??cannot convert local pointer to non-local access type", Operand); Error_Msg_N - ("\?Program_Error will be raised at run time", Operand); + ("\??Program_Error will be raised at run time", Operand); else -- Avoid generation of spurious error message @@ -11130,10 +11136,10 @@ package body Sem_Res is if In_Instance_Body then Error_Msg_N - ("?cannot convert access discriminant to non-local" & - " access type", Operand); + ("??cannot convert access discriminant to non-local" + & " access type", Operand); Error_Msg_N - ("\?Program_Error will be raised at run time", + ("\??Program_Error will be raised at run time", Operand); else diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 7d3215e59c3..648362c658f 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -444,8 +444,8 @@ package body Sem_Util is begin if Has_Predicates (Typ) then if Is_Generic_Actual_Type (Typ) then - Error_Msg_FE (Msg & '?', N, Typ); - Error_Msg_F ("\Program_Error will be raised at run time?", N); + Error_Msg_FE (Msg & "??", N, Typ); + Error_Msg_F ("\Program_Error will be raised at run time??", N); Insert_Action (N, Make_Raise_Program_Error (Sloc (N), Reason => PE_Bad_Predicated_Generic_Type)); @@ -1576,7 +1576,7 @@ package body Sem_Util is then Error_Msg_N ("result may differ if evaluated " - & "after other actual in expression?", Act1); + & "after other actual in expression??", Act1); end if; end if; end loop; @@ -1610,7 +1610,7 @@ package body Sem_Util is while Present (S) and then S /= Standard_Standard loop if Is_Protected_Type (S) then Error_Msg_N - ("potentially blocking operation in protected operation?", N); + ("potentially blocking operation in protected operation??", N); return; end if; @@ -1724,7 +1724,7 @@ package body Sem_Util is Object_Access_Level (Context) then Error_Msg_N - ("?possible unprotected access to protected data", Expr); + ("??possible unprotected access to protected data", Expr); end if; end if; end Check_Unprotected_Access; @@ -2249,8 +2249,8 @@ package body Sem_Util is Loc : Source_Ptr := No_Location; Warn : Boolean := False) return Node_Id is - Msgc : String (1 .. Msg'Length + 2); - -- Copy of message, with room for possible ? and ! at end + Msgc : String (1 .. Msg'Length + 3); + -- Copy of message, with room for possible ?? and ! at end Msgl : Natural; Wmsg : Boolean; @@ -2289,11 +2289,15 @@ package body Sem_Util is elsif Warn or else (Ada_Version = Ada_83 and then Comes_From_Source (N)) then + Msgl := Msgl + 1; + Msgc (Msgl) := '?'; Msgl := Msgl + 1; Msgc (Msgl) := '?'; Wmsg := True; elsif In_Instance_Not_Visible then + Msgl := Msgl + 1; + Msgc (Msgl) := '?'; Msgl := Msgl + 1; Msgc (Msgl) := '?'; Wmsg := True; @@ -2413,19 +2417,19 @@ package body Sem_Util is and then not Comes_From_Source (Conc_Typ) then Error_Msg_NEL - ("\?& will be raised at run time", + ("\??& will be raised at run time", N, Standard_Constraint_Error, Eloc); else Error_Msg_NEL - ("\?& will be raised for objects of this type", + ("\??& will be raised for objects of this type", N, Standard_Constraint_Error, Eloc); end if; end; else Error_Msg_NEL - ("\?& will be raised at run time", + ("\??& will be raised at run time", N, Standard_Constraint_Error, Eloc); end if; @@ -3863,7 +3867,7 @@ package body Sem_Util is Is_Potentially_Use_Visible (C)) then Error_Msg_Sloc := Sloc (C); - Error_Msg_N ("declaration hides &#?", Def_Id); + Error_Msg_N ("declaration hides &#?h?", Def_Id); end if; end Enter_Name; @@ -11258,7 +11262,8 @@ package body Sem_Util is -- sure this is a modification. if Has_Pragma_Unmodified (Ent) and then Sure then - Error_Msg_NE ("?pragma Unmodified given for &!", N, Ent); + Error_Msg_NE + ("??pragma Unmodified given for &!", N, Ent); end if; Set_Never_Set_In_Source (Ent, False); @@ -11348,8 +11353,8 @@ package body Sem_Util is then Error_Msg_Sloc := Sloc (A); Error_Msg_NE - ("constant& may be modified via address clause#?", - N, Entity (Prefix (Exp))); + ("constant& may be modified via address " + & "clause#??", N, Entity (Prefix (Exp))); end if; end; end if; @@ -11600,16 +11605,15 @@ package body Sem_Util is end Return_Master_Scope_Depth_Of_Call; end if; - -- For convenience we handle qualified expressions, even though - -- they aren't technically object names. + -- For convenience we handle qualified expressions, even though they + -- aren't technically object names. elsif Nkind (Obj) = N_Qualified_Expression then return Object_Access_Level (Expression (Obj)); - -- Otherwise return the scope level of Standard. - -- (If there are cases that fall through - -- to this point they will be treated as - -- having global accessibility for now. ???) + -- Otherwise return the scope level of Standard. (If there are cases + -- that fall through to this point they will be treated as having + -- global accessibility for now. ???) else return Scope_Depth (Standard_Standard); diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb index 53ad6312daa..f683b2a4db3 100644 --- a/gcc/ada/sem_warn.adb +++ b/gcc/ada/sem_warn.adb @@ -200,7 +200,7 @@ package body Sem_Warn is if No (Asm_Input_Value) then Error_Msg_F - ("?code statement with no inputs should usually be Volatile!", N); + ("??code statement with no inputs should usually be Volatile!", N); return; end if; @@ -208,7 +208,7 @@ package body Sem_Warn is if No (Asm_Output_Variable) then Error_Msg_F - ("?code statement with no outputs should usually be Volatile!", N); + ("??code statement with no outputs should usually be Volatile!", N); return; end if; end Check_Code_Statement; @@ -707,9 +707,9 @@ package body Sem_Warn is if No_Ref_Found (Loop_Statement) = OK then Error_Msg_NE - ("?variable& is not modified in loop body!", Ref, Var); + ("??variable& is not modified in loop body!", Ref, Var); Error_Msg_N - ("\?possible infinite loop!", Ref); + ("\??possible infinite loop!", Ref); end if; end Check_Infinite_Loop_Warning; @@ -1057,7 +1057,7 @@ package body Sem_Warn is -- the designated object). if not Warnings_Off_E1 then - Error_Msg_NE ("?& may be null!", UR, E1); + Error_Msg_NE ("??& may be null!", UR, E1); end if; goto Continue; @@ -1083,7 +1083,7 @@ package body Sem_Warn is and then not Is_Imported (E1) then Error_Msg_N - ("?& is not modified, volatile has no effect!", E1); + ("??& is not modified, volatile has no effect!", E1); -- Another special case, Exception_Occurrence, this catches -- the case of exception choice (and a bit more too, but not @@ -1105,7 +1105,7 @@ package body Sem_Warn is then if not Warnings_Off_E1 then Error_Msg_N -- CODEFIX - ("?& is not modified, " + ("??& is not modified, " & "could be declared constant!", E1); end if; @@ -1237,7 +1237,7 @@ package body Sem_Warn is and then not Warnings_Off_E1 then Output_Reference_Error - ("?formal parameter& is read but " + ("?v?formal parameter& is read but " & "never assigned!"); end if; @@ -1245,7 +1245,7 @@ package body Sem_Warn is and then not Warnings_Off_E1 then Output_Reference_Error - ("?formal parameter& is not referenced!"); + ("?v?formal parameter& is not referenced!"); end if; end if; @@ -1257,14 +1257,14 @@ package body Sem_Warn is and then not Warnings_Off_E1 then Output_Reference_Error - ("?variable& is read but never assigned!"); + ("?v?variable& is read but never assigned!"); end if; elsif not Has_Unreferenced (E1) and then not Warnings_Off_E1 then Output_Reference_Error -- CODEFIX - ("?variable& is never read and never assigned!"); + ("?v?variable& is never read and never assigned!"); end if; -- Deal with special case where this variable is hidden @@ -1275,12 +1275,12 @@ package body Sem_Warn is and then not Warnings_Off_E1 then Error_Msg_N - ("?for loop implicitly declares loop variable!", + ("?v?for loop implicitly declares loop variable!", Hiding_Loop_Variable (E1)); Error_Msg_Sloc := Sloc (E1); Error_Msg_N - ("\?declaration hides & declared#!", + ("\?v?declaration hides & declared#!", Hiding_Loop_Variable (E1)); end if; end if; @@ -1321,7 +1321,8 @@ package body Sem_Warn is then if not Warnings_Off_E1 then Error_Msg_NE - ("?OUT parameter& not set before return", UR, E1); + ("?v?OUT parameter& not set before return", + UR, E1); end if; -- If the unset reference is a selected component