2013-01-02 Robert Dewar <dewar@adacore.com>
+ * errout.ads: Minor comment fixes.
+ * opt.ads: Minor comment additions.
+ * exp_aggr.adb: Add tags to warning messages
+ * exp_ch11.adb, exp_ch3.adb, exp_ch4.adb, exp_util.adb, sem_aggr.adb,
+ sem_attr.adb, sem_case.adb, sem_cat.adb, sem_ch3.adb, sem_ch4.adb,
+ sem_ch5.adb, sem_disp.adb, sem_dist.adb, sem_elab.adb, sem_eval.adb,
+ sem_intr.adb, sem_mech.adb, sem_prag.adb, sem_res.adb, sem_util.adb,
+ sem_warn.adb: Add tags to warning messages
+
+2013-01-02 Doug Rupp <rupp@adacore.com>
+
+ * init.c [VMS] Remove subtest on reason mask for ACCVIO that is a C_E.
+
+2013-01-02 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_ch12.adb: Recover source name for renamed packagea.
+
+2013-01-02 Robert Dewar <dewar@adacore.com>
+
* errout.adb (Set_Msg_Insertion_Warning): Correct typo causing
tests to fail if insertion sequence is at end of message string.
* opt.ads: Minor comment fixes and additions.
-- 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.
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;
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;
else
Error_Msg_N
- ("non-static object requires elaboration code?", N);
+ ("non-static object requires elaboration code??", N);
exit;
end if;
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;
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
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;
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;
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;
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,
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;
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;
-- 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;
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));
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));
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,
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,
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;
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;
----------------------
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;
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;
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;
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;
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;
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;
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;
/* 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}
}
};
-- 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.
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
-- 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
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
-- 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
-- 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
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
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
-- 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
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);
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;
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;
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.
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;
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;
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);
(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
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;
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;
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;
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
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???)
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;
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
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
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
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
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,
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
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)
"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;
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;
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);
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);
-- 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));
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));
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;
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;
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 ???
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
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 ???
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);
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
(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));
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);
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);
-- 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?
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);
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);
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);
-- 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);
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;
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
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;
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;
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;
-- 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;
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
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
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;
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;
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;
-- 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);
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
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;
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;
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)
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
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;
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
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;
(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
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;
(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;
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;
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;
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;
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;
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
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;
else
Error_Msg_NE
- ("operation does not override inherited&?", Subp, Subp);
+ ("operation does not override inherited&??", Subp, Subp);
end if;
else
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;
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
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
elsif Access_Case then
Elab_Warning
- ("", "info: access to& during elaboration?", Ent);
+ ("", "info: access to& during elaboration?l?", Ent);
-- Subprogram call case
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;
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;
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
-- 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;
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
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
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;
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)))
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);
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;
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;
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
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);
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);
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;
= 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;
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;
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
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;
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;
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;
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;
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);
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;
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
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
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;
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;
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
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;
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;
-- 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);
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;
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;
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;
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;
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;
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
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
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
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;
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
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
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;
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;
-------------------------
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;
------------------
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;
----------------
if Err then
Error_Msg
- ("?pragma Warnings On with no " &
+ ("??pragma Warnings On with no " &
"matching Warnings Off",
Loc);
end if;
-- Warn about the danger
Error_Msg_N
- ("?creation of & object may raise Storage_Error!",
+ ("??creation of & object may raise Storage_Error!",
Scope (Disc));
<<No_Danger>>
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));
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;
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;
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),
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
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),
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,
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));
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;
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));
-- 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
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);
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;
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;
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;
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
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
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
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);
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;
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);
-- 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;
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
-- 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;
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;
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)
-- 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;
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;
-- 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;
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;
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),
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
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" &
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
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
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));
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;
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;
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;
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;
then
Msgl := Msgl + 1;
Msgc (Msgl) := '?';
+ Msgl := Msgl + 1;
+ Msgc (Msgl) := '?';
Wmsg := True;
elsif In_Instance_Not_Visible then
Msgl := Msgl + 1;
Msgc (Msgl) := '?';
+ Msgl := Msgl + 1;
+ Msgc (Msgl) := '?';
Wmsg := True;
-- Otherwise we have a real error message (Ada 95 static case)
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;
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;
-- 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);
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;
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);
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;
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;
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;
-- 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;
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
then
if not Warnings_Off_E1 then
Error_Msg_N -- CODEFIX
- ("?& is not modified, "
+ ("??& is not modified, "
& "could be declared constant!",
E1);
end if;
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;
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;
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
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;
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
OSDN Git Service
