===================================================================
@@ -261,7 +261,7 @@
then
if Ada_Version = Ada_83 then
Error_Msg_N
- ("optional package body (not allowed in Ada 95)?", N);
+ ("optional package body (not allowed in Ada 95)??", N);
else
Error_Msg_N ("spec of this package does not allow a body", N);
end if;
===================================================================
@@ -1062,9 +1062,9 @@
and then Nkind (First (Else_Statements (N))) in N_Delay_Statement
then
Error_Msg_N
- ("suspicious form of conditional entry call?!", N);
+ ("suspicious form of conditional entry call??!", N);
Error_Msg_N
- ("\`SELECT OR` may be intended rather than `SELECT ELSE`!", N);
+ ("\`SELECT OR` may be intended rather than `SELECT ELSE`??!", N);
end if;
-- Postpone the analysis of the statements till expansion. Analyze only
@@ -1987,11 +1987,11 @@
if Error_Msg_Sloc = No_Location then
Error_Msg_N
("objects of this type will violate " &
- "`No_Local_Protected_Objects`?", N);
+ "`No_Local_Protected_Objects`??", N);
else
Error_Msg_N
("objects of this type will violate " &
- "`No_Local_Protected_Objects`?#", N);
+ "`No_Local_Protected_Objects`#??", N);
end if;
end if;
@@ -2052,15 +2052,15 @@
or else From_Aspect_Specification (Prio_Item)
then
Error_Msg_Name_1 := Chars (Identifier (Prio_Item));
- Error_Msg_NE ("?aspect% for & has no effect when Lock_Free" &
- " given", Prio_Item, Id);
+ Error_Msg_NE ("aspect% for & has no effect when Lock_Free" &
+ " given??", Prio_Item, Id);
-- Pragma case
else
Error_Msg_Name_1 := Pragma_Name (Prio_Item);
- Error_Msg_NE ("?pragma% for & has no effect when Lock_Free" &
- " given", Prio_Item, Id);
+ Error_Msg_NE ("pragma% for & has no effect when Lock_Free" &
+ " given??", Prio_Item, Id);
end if;
end if;
end;
@@ -2089,16 +2089,16 @@
or else From_Aspect_Specification (Prio_Item))
and then Chars (Identifier (Prio_Item)) = Name_Priority
then
- Error_Msg_N ("?aspect Interrupt_Priority is preferred "
- & "in presence of handlers", Prio_Item);
+ Error_Msg_N ("aspect Interrupt_Priority is preferred "
+ & "in presence of handlers??", Prio_Item);
-- Pragma case
elsif Nkind (Prio_Item) = N_Pragma
and then Pragma_Name (Prio_Item) = Name_Priority
then
- Error_Msg_N ("?pragma Interrupt_Priority is preferred "
- & "in presence of handlers", Prio_Item);
+ Error_Msg_N ("pragma Interrupt_Priority is preferred "
+ & "in presence of handlers??", Prio_Item);
end if;
end if;
end;
@@ -2516,7 +2516,7 @@
if Entity (EDN1) = Ent then
Error_Msg_Sloc := Sloc (Stm1);
Error_Msg_N
- ("?accept duplicates one on line#", Stm);
+ ("accept duplicates one on line#??", Stm);
exit;
end if;
end if;
@@ -2799,7 +2799,7 @@
and then not Entry_Accepted (Ent)
and then Comes_From_Source (Ent)
then
- Error_Msg_NE ("no accept for entry &?", N, Ent);
+ Error_Msg_NE ("no accept for entry &??", N, Ent);
end if;
Next_Entity (Ent);
@@ -2923,10 +2923,10 @@
if Error_Msg_Sloc = No_Location then
Error_Msg_N
- ("objects of this type will violate `No_Task_Hierarchy`?", N);
+ ("objects of this type will violate `No_Task_Hierarchy`??", N);
else
Error_Msg_N
- ("objects of this type will violate `No_Task_Hierarchy`?#", N);
+ ("objects of this type will violate `No_Task_Hierarchy`#??", N);
end if;
end if;
===================================================================
@@ -556,7 +556,7 @@
Used_In_Spec)
then
Error_Msg_N -- CODEFIX
- ("?redundant with clause in body", Clause);
+ ("redundant with clause in body??", Clause);
end if;
Used_In_Body := False;
@@ -585,7 +585,7 @@
if Withed then
Error_Msg_N -- CODEFIX
- ("?redundant with clause", Clause);
+ ("redundant with clause??", Clause);
end if;
end;
end if;
@@ -1793,7 +1793,7 @@
Error_Msg_File_1 :=
Get_File_Name (Subunit_Name, Subunit => True);
Error_Msg_N
- ("subunit$$ in file{ not found?!!", N);
+ ("subunit$$ in file{ not found??!!", N);
Subunits_Missing := True;
end if;
@@ -2513,30 +2513,30 @@
begin
if U_Kind = Implementation_Unit then
- Error_Msg_F ("& is an internal 'G'N'A'T unit?", Name (N));
+ Error_Msg_F ("& is an internal 'G'N'A'T unit?i?", Name (N));
-- Add alternative name if available, otherwise issue a
-- general warning message.
if Error_Msg_Strlen /= 0 then
- Error_Msg_F ("\use ""~"" instead", Name (N));
+ Error_Msg_F ("\use ""~"" instead?i?", Name (N));
else
Error_Msg_F
("\use of this unit is non-portable " &
- "and version-dependent?", Name (N));
+ "and version-dependent?i?", Name (N));
end if;
elsif U_Kind = Ada_2005_Unit
and then Ada_Version < Ada_2005
and then Warn_On_Ada_2005_Compatibility
then
- Error_Msg_N ("& is an Ada 2005 unit?", Name (N));
+ Error_Msg_N ("& is an Ada 2005 unit?i?", Name (N));
elsif U_Kind = Ada_2012_Unit
and then Ada_Version < Ada_2012
and then Warn_On_Ada_2012_Compatibility
then
- Error_Msg_N ("& is an Ada 2012 unit?", Name (N));
+ Error_Msg_N ("& is an Ada 2012 unit?i?", Name (N));
end if;
end;
end if;
@@ -3342,7 +3342,7 @@
procedure License_Error is
begin
Error_Msg_N
- ("?license of withed unit & may be inconsistent",
+ ("license of withed unit & may be inconsistent??",
Name (Item));
end License_Error;
@@ -4129,7 +4129,7 @@
then
Error_Msg_NE
("child unit& hides compilation unit " &
- "with the same name?",
+ "with the same name??",
Name (Item), Id);
exit;
end if;
===================================================================
@@ -10491,8 +10491,7 @@
-- This is a binding interpretation that applies to previous versions
-- of the language, but for now we retain the milder check in order
- -- to preserve ACATS tests.
- -- These will be protested eventually ???
+ -- to preserve ACATS tests. These will be protested eventually ???
if Ada_Version < Ada_2012 then
Check_Mode_Conformant
@@ -12155,8 +12154,8 @@
E1 := First_Entity (Form);
E2 := First_Entity (Act);
while Present (E1) and then E1 /= First_Private_Entity (Form) loop
- -- Could this test be a single condition???
- -- Seems like it could, and isn't FPE (Form) a constant anyway???
+ -- Could this test be a single condition??? Seems like it could, and
+ -- isn't FPE (Form) a constant anyway???
if not Is_Internal (E1)
and then Present (Parent (E1))
@@ -12422,7 +12421,7 @@
-- provide additional warning which might explain the error.
Set_Is_Immediately_Visible (Cur, Vis);
- Error_Msg_NE ("& hides outer unit with the same name?",
+ Error_Msg_NE ("& hides outer unit with the same name??",
N, Defining_Unit_Name (N));
end if;
===================================================================
@@ -2677,14 +2677,14 @@
begin
Warning_Msg_Char := ' ';
- if P + 1 <= Text'Last and then Text (P) = '?' then
+ if P <= Text'Last and then Text (P) = '?' then
if Warning_Doc_Switch then
Warning_Msg_Char := '?';
end if;
P := P + 1;
- elsif P + 2 <= Text'Last
+ elsif P + 1 <= Text'Last
and then (Text (P) in 'a' .. 'z'
or else
Text (P) in 'A' .. 'Z')
===================================================================
@@ -261,7 +261,7 @@
or else Scop /= Scope (Etype (First_Formal (Designator))))
then
Error_Msg_N
- ("?abstract subprogram is not dispatching or overriding", N);
+ ("abstract subprogram is not dispatching or overriding?r?", N);
end if;
Generate_Reference_To_Formals (Designator);
@@ -579,16 +579,16 @@
if Inside_A_Generic then
Error_Msg_N
("return of limited object not permitted in Ada 2005 "
- & "(RM-2005 6.5(5.5/2))?", Expr);
+ & "(RM-2005 6.5(5.5/2))?y?", Expr);
elsif Is_Immutably_Limited_Type (R_Type) then
Error_Msg_N
("return by reference not permitted in Ada 2005 "
- & "(RM-2005 6.5(5.5/2))?", Expr);
+ & "(RM-2005 6.5(5.5/2))?y?", Expr);
else
Error_Msg_N
("cannot copy object of a limited type in Ada 2005 "
- & "(RM-2005 6.5(5.5/2))?", Expr);
+ & "(RM-2005 6.5(5.5/2))?y?", Expr);
end if;
-- Ada 95 mode, compatibility warnings disabled
@@ -847,7 +847,12 @@
if Has_Aliased then
if Ada_Version < Ada_2012 then
- Error_Msg_N ("aliased only allowed for limited"
+
+ -- Shouldn't this test Warn_On_Ada_2012_Compatibility ???
+ -- Can it really happen (extended return???)
+
+ Error_Msg_N
+ ("aliased only allowed for limited"
& " return objects in Ada 2012?", N);
elsif not Is_Immutably_Limited_Type (R_Type) then
@@ -937,7 +942,6 @@
and then Object_Access_Level (Expr) >
Subprogram_Access_Level (Scope_Id)
then
-
-- Suppress the message in a generic, where the rewriting
-- is irrelevant.
@@ -951,9 +955,9 @@
Analyze (N);
Error_Msg_N
- ("cannot return a local value by reference?", N);
+ ("cannot return a local value by reference??", N);
Error_Msg_NE
- ("\& will be raised at run time?",
+ ("\& will be raised at run time??",
N, Standard_Program_Error);
end if;
end if;
@@ -965,7 +969,7 @@
Apply_Compile_Time_Constraint_Error
(N => Expr,
Msg => "(Ada 2005) null not allowed for "
- & "null-excluding return?",
+ & "null-excluding return??",
Reason => CE_Null_Not_Allowed);
end if;
@@ -4168,7 +4172,7 @@
Error_Msg_NE (Msg (Msg'First .. Msg'Last - 1), N, Subp);
elsif Ineffective_Inline_Warnings then
- Error_Msg_NE (Msg, N, Subp);
+ Error_Msg_NE (Msg & "p?", N, Subp);
end if;
return;
@@ -4207,7 +4211,7 @@
(Unit_File_Name (Get_Source_Unit (Gen_P)))
then
Set_Is_Inlined (Subp, False);
- Error_Msg_NE (Msg, N, Subp);
+ Error_Msg_NE (Msg & "p?", N, Subp);
return;
end if;
end;
@@ -4225,7 +4229,7 @@
-- For backward compatibility we still report a warning.
if Ineffective_Inline_Warnings then
- Error_Msg_NE (Msg, N, Subp);
+ Error_Msg_NE (Msg & "p?", N, Subp);
end if;
end if;
@@ -6912,10 +6916,10 @@
if Mode = 'F' then
if not Raise_Exception_Call then
Error_Msg_N
- ("??RETURN statement missing following this statement!",
+ ("RETURN statement missing following this statement??!",
Last_Stm);
Error_Msg_N
- ("\??Program_Error may be raised at run time!",
+ ("\Program_Error may be raised at run time??!",
Last_Stm);
end if;
@@ -6931,11 +6935,11 @@
else
if not Raise_Exception_Call then
Error_Msg_N
- ("?implied return after this statement " &
- "will raise Program_Error",
+ ("implied return after this statement " &
+ "will raise Program_Error??",
Last_Stm);
Error_Msg_NE
- ("\?procedure & is marked as No_Return!",
+ ("\procedure & is marked as No_Return??!",
Last_Stm, Proc);
end if;
@@ -7172,7 +7176,7 @@
No_Warning_On_Some_Postcondition := True;
else
Error_Msg_N
- ("?`Ensures` component refers only to pre-state", Prag);
+ ("`Ensures` component refers only to pre-state??", Prag);
end if;
end if;
@@ -7229,7 +7233,7 @@
No_Warning_On_Some_Postcondition := True;
else
Error_Msg_N
- ("?postcondition refers only to pre-state", Prag);
+ ("postcondition refers only to pre-state??", Prag);
end if;
end if;
end if;
@@ -7283,16 +7287,16 @@
then
if Present (Last_Postcondition) then
if Present (Last_Contract_Case) then
- Error_Msg_N ("?neither function postcondition nor " &
- "contract cases do mention result",
+ Error_Msg_N ("neither function postcondition nor "
+ & "contract cases mention result??",
Last_Postcondition);
else
- Error_Msg_N ("?function postcondition does not mention result",
+ Error_Msg_N ("function postcondition does not mention result??",
Last_Postcondition);
end if;
else
- Error_Msg_N ("?contract cases do not mention result",
+ Error_Msg_N ("contract cases do not mention result??",
Last_Contract_Case);
end if;
end if;
@@ -8143,14 +8147,14 @@
then
if Scope (E) /= Standard_Standard then
Error_Msg_Sloc := Sloc (E);
- Error_Msg_N ("declaration of & hides one#?", S);
+ Error_Msg_N ("declaration of & hides one#?h?", S);
elsif Nkind (S) = N_Defining_Operator_Symbol
and then
Scope (Base_Type (Etype (First_Formal (S)))) /= Scope (S)
then
Error_Msg_N
- ("declaration of & hides predefined operator?", S);
+ ("declaration of & hides predefined operator?h?", S);
end if;
end if;
end loop;
@@ -8199,17 +8203,15 @@
& "before type& is frozen", Eq_Op, Typ);
Obj_Decl := Next (Parent (Typ));
- while Present (Obj_Decl)
- and then Obj_Decl /= Decl
- loop
+ while Present (Obj_Decl) and then Obj_Decl /= Decl loop
if Nkind (Obj_Decl) = N_Object_Declaration
and then Etype (Defining_Identifier (Obj_Decl)) = Typ
then
- Error_Msg_NE ("type& is frozen by declaration?",
- Obj_Decl, Typ);
+ Error_Msg_NE
+ ("type& is frozen by declaration??", Obj_Decl, Typ);
Error_Msg_N
("\an equality operator cannot be declared after this "
- & "point (RM 4.5.2 (9.8)) (Ada 2012))?", Obj_Decl);
+ & "point (RM 4.5.2 (9.8)) (Ada 2012))??", Obj_Decl);
exit;
end if;
@@ -9328,7 +9330,7 @@
Error_Msg_Node_2 := F_Typ;
Error_Msg_NE
("private operation& in generic unit does not override " &
- "any primitive operation of& (RM 12.3 (18))?",
+ "any primitive operation of& (RM 12.3 (18))??",
New_E, New_E);
end if;
@@ -9350,24 +9352,22 @@
and then (Is_Subprogram (E) or else Is_Generic_Subprogram (E))
then
declare
- Inherited : constant Subprogram_List :=
- Inherited_Subprograms (E);
+ Inherited : constant Subprogram_List := Inherited_Subprograms (E);
P : Node_Id;
begin
for J in Inherited'Range loop
P := Spec_PPC_List (Contract (Inherited (J)));
-
while Present (P) loop
Error_Msg_Sloc := Sloc (P);
if Class_Present (P) and then not Split_PPC (P) then
if Pragma_Name (P) = Name_Precondition then
Error_Msg_N
- ("?info: & inherits `Pre''Class` aspect from #", E);
+ ("info: & inherits `Pre''Class` aspect from #?", E);
else
Error_Msg_N
- ("?info: & inherits `Post''Class` aspect from #", E);
+ ("info: & inherits `Post''Class` aspect from #?", E);
end if;
end if;
@@ -10659,7 +10659,7 @@
and then No (F1)
and then No (F2)
then
- Error_Msg_NE ("calls to& may be ambiguous?", S, S);
+ Error_Msg_NE ("calls to& may be ambiguous??", S, S);
end if;
end;
end if;
@@ -11094,7 +11094,7 @@
if Convention (Formal_Type) = Convention_Ada_Pass_By_Copy then
Error_Msg_N
- ("?cannot pass aliased parameter & by copy", Formal);
+ ("cannot pass aliased parameter & by copy?", Formal);
end if;
-- Force mechanism if type has Convention Ada_Pass_By_Ref/Copy
===================================================================
@@ -58,26 +58,30 @@
Is_Serious : Boolean := False);
-- This procedure is called if the node N, an instance of a call to
-- subprogram Subp, cannot be inlined. Msg is the message to be issued,
- -- and has a ? as the last character. Temporarily the behavior of this
- -- routine depends on the value of -gnatd.k:
+ -- which ends with ? (but not ?p?, this routine takes care of the need
+ -- to change ? to ?p?). Temporarily the behavior of this routine depends
+ -- on the value of -gnatd.k:
+ --
-- * If -gnatd.k is not set (ie. old inlining model) then if Subp has
-- a pragma Always_Inlined, then an error message is issued (by
-- removing the last character of Msg). If Subp is not Always_Inlined,
-- then a warning is issued if the flag Ineffective_Inline_Warnings
-- is set, and if not, the call has no effect.
+ --
-- * If -gnatd.k is set (ie. new inlining model) then:
-- - If Is_Serious is true, then an error is reported (by removing the
-- last character of Msg);
-- - otherwise:
+ --
-- * Compiling without optimizations if Subp has a pragma
-- Always_Inlined, then an error message is issued; if Subp is
-- not Always_Inlined, then a warning is issued if the flag
-- Ineffective_Inline_Warnings is set, and if not, the call
-- has no effect.
- -- * Compiling with optimizations then a warning is issued if
- -- the flag Ineffective_Inline_Warnings is set; otherwise the
- -- call has no effect since inlining may be performed by the
- -- backend.
+ --
+ -- * Compiling with optimizations then a warning is issued if the
+ -- flag Ineffective_Inline_Warnings is set; otherwise the call has
+ -- no effect since inlining may be performed by the backend.
procedure Check_Conventions (Typ : Entity_Id);
-- Ada 2005 (AI-430): Check that the conventions of all inherited and
===================================================================
@@ -1017,13 +1017,13 @@
and then Comes_From_Source (Nam)
then
Error_Msg_N
- ("?renaming function result object is suspicious", Nam);
+ ("renaming function result object is suspicious?R?", Nam);
Error_Msg_NE
- ("\?function & will be called only once", Nam,
+ ("\function & will be called only once?R?", Nam,
Entity (Name (Nam)));
Error_Msg_N -- CODEFIX
- ("\?suggest using an initialized constant object instead",
- Nam);
+ ("\suggest using an initialized constant "
+ & "object instead?R?", Nam);
end if;
end case;
@@ -2289,10 +2289,10 @@
and then Hidden /= Old_S
then
Error_Msg_Sloc := Sloc (Hidden);
- Error_Msg_N ("?default subprogram is resolved " &
+ Error_Msg_N ("default subprogram is resolved " &
"in the generic declaration " &
- "(RM 12.6(17))", N);
- Error_Msg_NE ("\?and will not use & #", N, Hidden);
+ "(RM 12.6(17))??", N);
+ Error_Msg_NE ("\and will not use & #??", N, Hidden);
end if;
end;
end if;
@@ -2942,7 +2942,7 @@
and then Chars (Old_S) /= Chars (New_S)
then
Error_Msg_NE
- ("?& is being renamed as a different operator", N, Old_S);
+ ("& is being renamed as a different operator??", N, Old_S);
end if;
-- Check for renaming of obsolescent subprogram
@@ -2965,7 +2965,7 @@
and then Chars (Current_Scope) /= Chars (Old_S)
then
Error_Msg_N
- ("?redundant renaming, entity is directly visible", Name (N));
+ ("redundant renaming, entity is directly visible?r?", Name (N));
end if;
-- Implementation-defined aspect specifications can appear in a renaming
@@ -3219,7 +3219,7 @@
and then Pack = Current_Scope
then
Error_Msg_NE -- CODEFIX
- ("& is already use-visible within itself?", Pack_Name, Pack);
+ ("& is already use-visible within itself?r?", Pack_Name, Pack);
end if;
return False;
@@ -6015,7 +6015,8 @@
then
-- Selected component of record. Type checking will validate
-- name of selector.
- -- ??? could we rewrite an implicit dereference into an explicit
+
+ -- ??? Could we rewrite an implicit dereference into an explicit
-- one here?
Analyze_Selected_Component (N);
@@ -6275,18 +6276,18 @@
Set_Entity (N, Any_Type);
return;
- -- ??? This test is temporarily disabled (always False)
- -- because it causes an unwanted warning on GNAT sources
- -- (built with -gnatg, which includes Warn_On_Obsolescent_
- -- Feature). Once this issue is cleared in the sources, it
- -- can be enabled.
+ -- ??? This test is temporarily disabled (always
+ -- False) because it causes an unwanted warning on
+ -- GNAT sources (built with -gnatg, which includes
+ -- Warn_On_Obsolescent_ Feature). Once this issue
+ -- is cleared in the sources, it can be enabled.
elsif Warn_On_Obsolescent_Feature
and then False
then
Error_Msg_N
("applying 'Class to an untagged incomplete type"
- & " is an obsolescent feature (RM J.11)", N);
+ & " is an obsolescent feature (RM J.11)?r?", N);
end if;
end if;
@@ -6379,7 +6380,7 @@
and then Base_Type (Typ) = Typ
then
Error_Msg_NE -- CODEFIX
- ("?redundant attribute, & is its own base type", N, Typ);
+ ("redundant attribute, & is its own base type?r?", N, Typ);
end if;
T := Base_Type (Typ);
@@ -7248,7 +7249,7 @@
if Present (Redundant) then
Error_Msg_Sloc := Sloc (Prev_Use);
Error_Msg_NE -- CODEFIX
- ("& is already use-visible through previous use clause #?",
+ ("& is already use-visible through previous use clause #??",
Redundant, Pack_Name);
end if;
end Note_Redundant_Use;
@@ -8362,14 +8363,14 @@
Error_Msg_Sloc := Sloc (Current_Use_Clause (T));
Error_Msg_NE -- CODEFIX
("& is already use-visible through previous "
- & "use_type_clause #?", Clause1, T);
+ & "use_type_clause #??", Clause1, T);
return;
elsif Nkind (Unit1) = N_Subunit then
Error_Msg_Sloc := Sloc (Current_Use_Clause (T));
Error_Msg_NE -- CODEFIX
("& is already use-visible through previous "
- & "use_type_clause #?", Clause1, T);
+ & "use_type_clause #??", Clause1, T);
return;
elsif Nkind_In (Unit2, N_Package_Body, N_Subprogram_Body)
@@ -8379,7 +8380,7 @@
Error_Msg_Sloc := Sloc (Clause1);
Error_Msg_NE -- CODEFIX
("& is already use-visible through previous "
- & "use_type_clause #?", Current_Use_Clause (T), T);
+ & "use_type_clause #??", Current_Use_Clause (T), T);
return;
end if;
@@ -8431,7 +8432,7 @@
Error_Msg_NE -- CODEFIX
("& is already use-visible through previous "
- & "use_type_clause #?", Err_No, Id);
+ & "use_type_clause #??", Err_No, Id);
-- Case where current use type clause and the use type
-- clause for the type are not both at the compilation unit
@@ -8440,7 +8441,7 @@
else
Error_Msg_NE -- CODEFIX
("& is already use-visible through previous "
- & "use type clause?", Id, T);
+ & "use type clause??", Id, T);
end if;
end Use_Clause_Known;
@@ -8450,7 +8451,7 @@
else
Error_Msg_NE -- CODEFIX
("& is already use-visible through previous "
- & "use type clause?", Id, T);
+ & "use type clause??", Id, T);
end if;
-- The package where T is declared is already used
@@ -8458,7 +8459,7 @@
elsif In_Use (Scope (T)) then
Error_Msg_Sloc := Sloc (Current_Use_Clause (Scope (T)));
Error_Msg_NE -- CODEFIX
- ("& is already use-visible through package use clause #?",
+ ("& is already use-visible through package use clause #??",
Id, T);
-- The current scope is the package where T is declared
@@ -8466,7 +8467,7 @@
else
Error_Msg_Node_2 := Scope (T);
Error_Msg_NE -- CODEFIX
- ("& is already use-visible inside package &?", Id, T);
+ ("& is already use-visible inside package &??", Id, T);
end if;
end if;
end Use_One_Type;
===================================================================
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
+-- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -266,7 +266,7 @@
and then Scope (Entity (Id)) = Current_Scope
then
Error_Msg_NE
- ("?exception & is never raised", Entity (Id), Id);
+ ("exception & is never raised?r?", Entity (Id), Id);
end if;
if Present (Renamed_Entity (Entity (Id))) then
@@ -276,9 +276,9 @@
if Warn_On_Obsolescent_Feature then
Error_Msg_N
("Numeric_Error is an " &
- "obsolescent feature (RM J.6(1))?", Id);
+ "obsolescent feature (RM J.6(1))?j?", Id);
Error_Msg_N
- ("\use Constraint_Error instead?", Id);
+ ("\use Constraint_Error instead?j?", Id);
end if;
end if;
end if;
@@ -345,7 +345,7 @@
N_Others_Choice)
then
Error_Msg_N
- ("useless handler contains only a reraise statement?",
+ ("useless handler contains only a reraise statement?r?",
Handler);
end if;
@@ -445,8 +445,7 @@
end if;
-- Check for useless assignment to OUT or IN OUT scalar preceding the
- -- raise. Right now we only look at assignment statements, we could do
- -- more.
+ -- raise. Right now only look at assignment statements, could do more???
if Is_List_Member (N) then
declare
@@ -496,11 +495,11 @@
if No (Exception_Handlers (Par)) then
Error_Msg_N
- ("?assignment to pass-by-copy formal " &
- "may have no effect", P);
+ ("assignment to pass-by-copy formal " &
+ "may have no effect??", P);
Error_Msg_N
- ("\?RAISE statement may result in abnormal return" &
- " (RM 6.4.1(17))", P);
+ ("\RAISE statement may result in abnormal return" &
+ " (RM 6.4.1(17))??", P);
end if;
end if;
end if;
===================================================================
@@ -1506,8 +1506,8 @@
Warn_On_Biased_Representation : Boolean := True;
-- GNAT
-- Set to True to generate warnings for size clauses, component clauses
- -- and component_size clauses that force biased representation. Set False
- -- by -gnatw.B.
+ -- and component_size clauses that force biased representation. Modified
+ -- by use of -gnatw.b/.B.
Warn_On_Constant : Boolean := False;
-- GNAT
@@ -1567,12 +1567,14 @@
Warn_On_Object_Renames_Function : Boolean := False;
-- GNAT
-- Set to True to generate warnings when a function result is renamed as
- -- an object. The default is that this warning is disabled.
+ -- an object. The default is that this warning is disabled. Modified by
+ -- use of -gnatw.r/.R.
Warn_On_Obsolescent_Feature : Boolean := False;
-- GNAT
-- Set to True to generate warnings on use of any feature in Annex or if a
- -- subprogram is called for which a pragma Obsolescent applies.
+ -- subprogram is called for which a pragma Obsolescent applies. Modified
+ -- by use of -gnatwj/J.
Warn_On_Overlap : Boolean := False;
-- GNAT
@@ -1600,7 +1602,7 @@
-- GNAT
-- Set to True to generate warning (informational) messages for component
-- clauses that are affected by non-standard bit-order. The default is
- -- that this warning is enabled.
+ -- that this warning is enabled. Modified by -gnatw.v/.V.
Warn_On_Suspicious_Contract : Boolean := False;
-- GNAT
@@ -1616,8 +1618,8 @@
Warn_On_Unchecked_Conversion : Boolean := True;
-- GNAT
-- Set to True to generate warnings for unchecked conversions that may have
- -- non-portable semantics (e.g. because sizes of types differ). The default
- -- is that this warning is enabled.
+ -- non-portable semantics (e.g. because sizes of types differ). Modified
+ -- by use of -gnatw.z/.Z.
Warn_On_Unordered_Enumeration_Type : Boolean := False;
-- GNAT
@@ -1635,7 +1637,7 @@
-- GNAT
-- Set to True to generate warnings for the case of components of record
-- which have a record representation clause but this component does not
- -- have a component clause. The default is that this warning is disabled.
+ -- have a component clause. Modified by use of -gnatw.c/.C.
Warn_On_Warnings_Off : Boolean := False;
-- GNAT
===================================================================
@@ -279,16 +279,16 @@
then
Error_Msg_N
("multi-byte field specified with non-standard"
- & " Bit_Order?", CLC);
+ & " Bit_Order??", CLC);
if Bytes_Big_Endian then
Error_Msg_N
("bytes are not reversed "
- & "(component is big-endian)?", CLC);
+ & "(component is big-endian)??", CLC);
else
Error_Msg_N
("bytes are not reversed "
- & "(component is little-endian)?", CLC);
+ & "(component is little-endian)??", CLC);
end if;
-- Do not allow non-contiguous field
@@ -314,14 +314,14 @@
and then Warn_On_Reverse_Bit_Order
then
Error_Msg_N
- ("?Bit_Order clause does not affect " &
- "byte ordering", Pos);
+ ("Bit_Order clause does not affect " &
+ "byte ordering?V?", Pos);
Error_Msg_Uint_1 :=
Intval (Pos) + Intval (FB) /
System_Storage_Unit;
Error_Msg_N
- ("?position normalized to ^ before bit " &
- "order interpreted", Pos);
+ ("position normalized to ^ before bit " &
+ "order interpreted?V?", Pos);
end if;
-- Here is where we fix up the Component_Bit_Offset value
@@ -390,10 +390,8 @@
if Present (CC) then
declare
- Fbit : constant Uint :=
- Static_Integer (First_Bit (CC));
- Lbit : constant Uint :=
- Static_Integer (Last_Bit (CC));
+ Fbit : constant Uint := Static_Integer (First_Bit (CC));
+ Lbit : constant Uint := Static_Integer (Last_Bit (CC));
begin
-- Case of component with last bit >= max machine scalar
@@ -410,16 +408,16 @@
if Warn_On_Reverse_Bit_Order then
Error_Msg_N
("multi-byte field specified with "
- & " non-standard Bit_Order?", CC);
+ & " non-standard Bit_Order?V?", CC);
if Bytes_Big_Endian then
Error_Msg_N
("\bytes are not reversed "
- & "(component is big-endian)?", CC);
+ & "(component is big-endian)?V?", CC);
else
Error_Msg_N
("\bytes are not reversed "
- & "(component is little-endian)?", CC);
+ & "(component is little-endian)?V?", CC);
end if;
end if;
@@ -633,19 +631,19 @@
Error_Msg_Uint_1 := MSS;
Error_Msg_N
("info: reverse bit order in machine " &
- "scalar of length^?", First_Bit (CC));
+ "scalar of length^?V?", First_Bit (CC));
Error_Msg_Uint_1 := NFB;
Error_Msg_Uint_2 := NLB;
if Bytes_Big_Endian then
Error_Msg_NE
- ("?\info: big-endian range for "
- & "component & is ^ .. ^",
+ ("\info: big-endian range for "
+ & "component & is ^ .. ^?V?",
First_Bit (CC), Comp);
else
Error_Msg_NE
- ("?\info: little-endian range "
- & "for component & is ^ .. ^",
+ ("\info: little-endian range "
+ & "for component & is ^ .. ^?V?",
First_Bit (CC), Comp);
end if;
end if;
@@ -2759,9 +2757,9 @@
and then Comes_From_Source (Scope (U_Ent))
then
Error_Msg_N
- ("?entry address declared for entry in task type", N);
+ ("??entry address declared for entry in task type", N);
Error_Msg_N
- ("\?only one task can be declared of this type", N);
+ ("\??only one task can be declared of this type", N);
end if;
-- Entry address clauses are obsolescent
@@ -2770,10 +2768,10 @@
if Warn_On_Obsolescent_Feature then
Error_Msg_N
- ("attaching interrupt to task entry is an " &
- "obsolescent feature (RM J.7.1)?", N);
+ ("?j?attaching interrupt to task entry is an " &
+ "obsolescent feature (RM J.7.1)", N);
Error_Msg_N
- ("\use interrupt procedure instead?", N);
+ ("\?j?use interrupt procedure instead", N);
end if;
-- Case of an address clause for a controlled object which we
@@ -2783,9 +2781,9 @@
or else Has_Controlled_Component (Etype (U_Ent))
then
Error_Msg_NE
- ("?controlled object& must not be overlaid", Nam, U_Ent);
+ ("??controlled object& must not be overlaid", Nam, U_Ent);
Error_Msg_N
- ("\?Program_Error will be raised at run time", Nam);
+ ("\??Program_Error will be raised at run time", Nam);
Insert_Action (Declaration_Node (U_Ent),
Make_Raise_Program_Error (Loc,
Reason => PE_Overlaid_Controlled_Object));
@@ -2822,9 +2820,9 @@
or else Is_Controlled (Etype (O_Ent)))
then
Error_Msg_N
- ("?cannot overlay with controlled object", Expr);
+ ("??cannot overlay with controlled object", Expr);
Error_Msg_N
- ("\?Program_Error will be raised at run time", Expr);
+ ("\??Program_Error will be raised at run time", Expr);
Insert_Action (Declaration_Node (U_Ent),
Make_Raise_Program_Error (Loc,
Reason => PE_Overlaid_Controlled_Object));
@@ -2834,7 +2832,7 @@
and then Ekind (U_Ent) = E_Constant
and then not Is_Constant_Object (O_Ent)
then
- Error_Msg_N ("constant overlays a variable?", Expr);
+ Error_Msg_N ("??constant overlays a variable", Expr);
-- Imported variables can have an address clause, but then
-- the import is pretty meaningless except to suppress
@@ -3005,7 +3003,7 @@
if Is_Tagged_Type (U_Ent) and then Align > Max_Align then
Error_Msg_N
- ("?alignment for & set to Maximum_Aligment", Nam);
+ ("alignment for & set to Maximum_Aligment??", Nam);
Set_Alignment (U_Ent, Max_Align);
-- All other cases
@@ -3133,7 +3131,7 @@
if not GNAT_Mode then
Error_Msg_N
- ("?component size ignored in this configuration", N);
+ ("component size ignored in this configuration??", N);
end if;
end if;
@@ -3144,8 +3142,7 @@
and then RM_Size (Ctyp) /= Csize
then
Error_Msg_NE
- ("?component size overrides size clause for&",
- N, Ctyp);
+ ("component size overrides size clause for&?S?", N, Ctyp);
end if;
Set_Has_Component_Size_Clause (Btype, True);
@@ -3301,11 +3298,12 @@
if not Is_Library_Level_Entity (U_Ent) then
Error_Msg_NE
- ("?non-unique external tag supplied for &", N, U_Ent);
+ ("??non-unique external tag supplied for &", N, U_Ent);
Error_Msg_N
- ("?\same external tag applies to all subprogram calls", N);
+ ("\??same external tag applies to all "
+ & "subprogram calls", N);
Error_Msg_N
- ("?\corresponding internal tag cannot be obtained", N);
+ ("\??corresponding internal tag cannot be obtained", N);
end if;
end if;
end External_Tag;
@@ -3586,7 +3584,7 @@
-- case this is useless.
Error_Msg_N
- ("?size clauses are ignored in this configuration", N);
+ ("size clauses are ignored in this configuration??", N);
end if;
if Is_Type (U_Ent) then
@@ -3875,9 +3873,9 @@
if Warn_On_Obsolescent_Feature then
Error_Msg_N
- ("storage size clause for task is an " &
- "obsolescent feature (RM J.9)?", N);
- Error_Msg_N ("\use Storage_Size pragma instead?", N);
+ ("?j?storage size clause for task is an " &
+ "obsolescent feature (RM J.9)", N);
+ Error_Msg_N ("\?j?use Storage_Size pragma instead", N);
end if;
FOnly := True;
@@ -4510,7 +4508,7 @@
if First_Entity (E) /= Last_Entity (E) then
Error_Msg_N
- ("?'C'P'P type must import at least one primitive from C++",
+ ("'C'P'P type must import at least one primitive from C++??",
E);
end if;
end if;
@@ -4537,15 +4535,15 @@
or else Convention (Prim) /= Convention_CPP
then
Error_Msg_N
- ("?primitives of 'C'P'P types must be imported from C++"
- & " or abstract", Prim);
+ ("primitives of 'C'P'P types must be imported from C++ "
+ & "or abstract??", Prim);
elsif not Has_Constructors
and then not Error_Reported
then
Error_Msg_Name_1 := Chars (E);
Error_Msg_N
- ("?'C'P'P constructor required for type %", Prim);
+ ("??'C'P'P constructor required for type %", Prim);
Error_Reported := True;
end if;
end if;
@@ -4723,7 +4721,7 @@
Error_Msg_N
("?j?mod clause is an obsolescent feature (RM J.8)", N);
Error_Msg_N
- ("\?j?use alignment attribute definition clause instead?", N);
+ ("\?j?use alignment attribute definition clause instead", N);
end if;
if Present (P) then
@@ -4910,7 +4908,7 @@
& "with representation of ancestor", CC);
elsif Warn_On_Redundant_Constructs then
Error_Msg_N
- ("?redundant component clause "
+ ("?r?redundant component clause "
& "for inherited component!", CC);
end if;
end;
@@ -4950,7 +4948,7 @@
and then RM_Size (Etype (Comp)) /= Esize (Comp)
then
Error_Msg_NE
- ("?component size overrides size clause for&",
+ ("?S?component size overrides size clause for&",
Component_Name (CC), Etype (Comp));
end if;
@@ -5016,7 +5014,7 @@
Next_Component_Or_Discriminant (Comp);
end loop;
- -- If no Complete_Representation pragma, warn if missing components
+ -- Give missing components warning if required
elsif Warn_On_Unrepped_Components then
declare
@@ -5060,7 +5058,7 @@
then
Error_Msg_Sloc := Sloc (Comp);
Error_Msg_NE
- ("?no component clause given for & declared #",
+ ("?C?no component clause given for & declared #",
N, Comp);
end if;
@@ -5089,9 +5087,7 @@
-- Check for duplicate definiations.
- if Has_Invariants (Typ)
- and then Present (Invariant_Procedure (Typ))
- then
+ if Has_Invariants (Typ) and then Present (Invariant_Procedure (Typ)) then
return Empty;
end if;
@@ -5567,7 +5563,7 @@
then
Error_Msg_Sloc := Sloc (Predicate_Function (T));
Error_Msg_Node_2 := T;
- Error_Msg_N ("?info: & inherits predicate from & #", Typ);
+ Error_Msg_N ("info: & inherits predicate from & #??", Typ);
end if;
end if;
end Add_Call;
@@ -6777,7 +6773,7 @@
("visibility of aspect for& changes after freeze point",
ASN, Ent);
Error_Msg_NE
- ("?info: & is frozen here, aspects evaluated at this point",
+ ("info: & is frozen here, aspects evaluated at this point??",
Freeze_Node (Ent), Ent);
end if;
end Check_Aspect_At_End_Of_Declarations;
@@ -7954,7 +7950,7 @@
if Error_Msg_Uint_1 > 0 then
Error_Msg_NE
- ("?^-bit gap before component&",
+ ("?H?^-bit gap before component&",
Component_Name (Component_Clause (CEnt)), CEnt);
end if;
@@ -8909,7 +8905,7 @@
if Present (Freeze_Node (S)) then
Error_Msg_NE
- ("?no more representation items for }", Freeze_Node (S), S);
+ ("??no more representation items for }", Freeze_Node (S), S);
end if;
return True;
@@ -9291,7 +9287,7 @@
if Warn_On_Biased_Representation then
Error_Msg_NE
- ("?" & Msg & " forces biased representation for&", N, E);
+ ("?B?" & Msg & " forces biased representation for&", N, E);
end if;
end if;
end Set_Biased;
@@ -9400,13 +9396,13 @@
Error_Msg_NE
("?& overlays smaller object", ACCR.N, ACCR.X);
Error_Msg_N
- ("\?program execution may be erroneous", ACCR.N);
+ ("\??program execution may be erroneous", ACCR.N);
Error_Msg_Uint_1 := X_Size;
Error_Msg_NE
- ("\?size of & is ^", ACCR.N, ACCR.X);
+ ("\??size of & is ^", ACCR.N, ACCR.X);
Error_Msg_Uint_1 := Y_Size;
Error_Msg_NE
- ("\?size of & is ^", ACCR.N, ACCR.Y);
+ ("\??size of & is ^", ACCR.N, ACCR.Y);
-- Check for inadequate alignment, both of the base object
-- and of the offset, if any.
@@ -9427,24 +9423,20 @@
/= Known_Compatible))
then
Error_Msg_NE
- ("?specified address for& may be inconsistent "
- & "with alignment",
- ACCR.N, ACCR.X);
+ ("??specified address for& may be inconsistent "
+ & "with alignment", ACCR.N, ACCR.X);
Error_Msg_N
- ("\?program execution may be erroneous (RM 13.3(27))",
+ ("\??program execution may be erroneous (RM 13.3(27))",
ACCR.N);
Error_Msg_Uint_1 := X_Alignment;
Error_Msg_NE
- ("\?alignment of & is ^",
- ACCR.N, ACCR.X);
+ ("\??alignment of & is ^", ACCR.N, ACCR.X);
Error_Msg_Uint_1 := Y_Alignment;
Error_Msg_NE
- ("\?alignment of & is ^",
- ACCR.N, ACCR.Y);
+ ("\??alignment of & is ^", ACCR.N, ACCR.Y);
if Y_Alignment >= X_Alignment then
Error_Msg_N
- ("\?but offset is not multiple of alignment",
- ACCR.N);
+ ("\??but offset is not multiple of alignment", ACCR.N);
end if;
end if;
end if;
@@ -9805,7 +9797,8 @@
or else OpenVMS_On_Target
then
Error_Msg_N
- ("?conversion between pointers with different conventions!", N);
+ ("?Z?conversion between pointers with different conventions!",
+ N);
end if;
end if;
@@ -9831,7 +9824,7 @@
if Source = Calendar_Time or else Target = Calendar_Time then
Error_Msg_N
- ("?representation of 'Time values may change between " &
+ ("?Z?representation of 'Time values may change between " &
"'G'N'A'T versions", N);
end if;
end;
@@ -9853,7 +9846,8 @@
-- known statically, then we need the annotation.
if Known_Static_RM_Size (Source)
- and then Known_Static_RM_Size (Target)
+ and then
+ Known_Static_RM_Size (Target)
then
null;
else
@@ -9931,7 +9925,7 @@
if Source_Siz /= Target_Siz then
Error_Msg
- ("?types for unchecked conversion have different sizes!",
+ ("?Z?types for unchecked conversion have different sizes!",
Eloc);
if All_Errors_Mode then
@@ -9939,7 +9933,7 @@
Error_Msg_Uint_1 := Source_Siz;
Error_Msg_Name_2 := Chars (Target);
Error_Msg_Uint_2 := Target_Siz;
- Error_Msg ("\size of % is ^, size of % is ^?", Eloc);
+ Error_Msg ("\size of % is ^, size of % is ^?Z?", Eloc);
Error_Msg_Uint_1 := UI_Abs (Source_Siz - Target_Siz);
@@ -9949,44 +9943,41 @@
then
if Source_Siz > Target_Siz then
Error_Msg
- ("\?^ high order bits of source will be ignored!",
- Eloc);
+ ("\?Z?^ high order bits of source will "
+ & "be ignored!", Eloc);
elsif Is_Unsigned_Type (Source) then
Error_Msg
- ("\?source will be extended with ^ high order " &
- "zero bits?!", Eloc);
+ ("\?Z?source will be extended with ^ high order "
+ & "zero bits?!", Eloc);
else
Error_Msg
- ("\?source will be extended with ^ high order " &
- "sign bits!",
- Eloc);
+ ("\?Z?source will be extended with ^ high order "
+ & "sign bits!", Eloc);
end if;
elsif Source_Siz < Target_Siz then
if Is_Discrete_Type (Target) then
if Bytes_Big_Endian then
Error_Msg
- ("\?target value will include ^ undefined " &
- "low order bits!",
- Eloc);
+ ("\?Z?target value will include ^ undefined "
+ & "low order bits!", Eloc);
else
Error_Msg
- ("\?target value will include ^ undefined " &
- "high order bits!",
- Eloc);
+ ("\?Z?target value will include ^ undefined "
+ & "high order bits!", Eloc);
end if;
else
Error_Msg
- ("\?^ trailing bits of target value will be " &
- "undefined!", Eloc);
+ ("\?Z?^ trailing bits of target value will be "
+ & "undefined!", Eloc);
end if;
else pragma Assert (Source_Siz > Target_Siz);
Error_Msg
- ("\?^ trailing bits of source will be ignored!",
+ ("\?Z?^ trailing bits of source will be ignored!",
Eloc);
end if;
end if;
@@ -10039,11 +10030,11 @@
Error_Msg_Node_1 := D_Target;
Error_Msg_Node_2 := D_Source;
Error_Msg
- ("?alignment of & (^) is stricter than " &
- "alignment of & (^)!", Eloc);
+ ("?Z?alignment of & (^) is stricter than "
+ & "alignment of & (^)!", Eloc);
Error_Msg
- ("\?resulting access value may have invalid " &
- "alignment!", Eloc);
+ ("\?Z?resulting access value may have invalid "
+ & "alignment!", Eloc);
end if;
end;
end if;