public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc r12-4686] [Ada] Change format of the ?? warning insertion sequence
@ 2021-10-25 15:09 Pierre-Marie de Rodat
0 siblings, 0 replies; only message in thread
From: Pierre-Marie de Rodat @ 2021-10-25 15:09 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:ed00b051d907c6f2383c906ee2354c7ba7488dff
commit r12-4686-ged00b051d907c6f2383c906ee2354c7ba7488dff
Author: Etienne Servais <servais@adacore.com>
Date: Tue Oct 19 18:00:56 2021 +0200
[Ada] Change format of the ?? warning insertion sequence
gcc/ada/
* errout.adb (Skip_Msg_Insertion_Warning): Adapt and format as
Erroutc.Prescan_Message.Parse_Message_Class.
(Warn_Insertion): Adapt to new format.
* errout.ads: Update documentation.
* erroutc.adb (Get_Warning_Tag): Adapt to new format.
(Prescan_Message): Introduce Parse_Message_Class function.
(Validate_Specific_Warnings): Update ?W? to ?.w?.
* erroutc.ads: Update type and documentation.
* checks.adb (Validity_Check_Range): Update ?X? to ?.x?.
* exp_ch11.adb (Possible_Local_Raise): Update ?X? to ?.x?.
(Warn_If_No_Local_Raise): Likewise.
(Warn_If_No_Propagation): Likewise.
(Warn_No_Exception_Propagation_Active): Likewise.
* exp_ch4.adb (Expand_N_Allocator): Attach warning message to
-gnatw_a.
* exp_prag.adb (Expand_Pragma_Check): Update ?A? to ?.a?.
* exp_util.adb (Activate_Atomic_Synchronization): Update ?N? to
?.n?.
(Add_Invariant_Check): Update ?L? to ?.l?.
* freeze.adb (Check_Suspicious_Modulus): Update ?M? to ?.m?.
(Freeze_Entity): Update ?T? to ?.t?, ?Z? to ?.z?.
* par-util.adb (Warn_If_Standard_Redefinition): Update ?K? to
?.k?.
* sem_attr.adb (Min_Max): Update ?U? to ?.u?.
* sem_ch13.adb (Adjust_Record_For_Reverse_Bit_Order): Update ?V?
to ?.v?.
(Adjust_Record_For_Reverse_Bit_Order_Ada_95): Update ?V? to ?.v?.
(Component_Size_Case): Update ?S? to ?.s?.
(Analyze_Record_Representation_Clause): Update ?S? to ?.s? and
?C? to ?.c?.
(Add_Call): Update ?L? to ?.l?.
(Component_Order_Check): Attach warning message to -gnatw_r.
(Check_Component_List): Update ?H? to ?.h?.
(Set_Biased): Update ?B? to ?.b?.
* sem_ch3.adb (Modular_Type_Declaration): Update ?M? to ?.m?.
* sem_ch4.adb (Analyze_Mod): Update ?M? to ?.m?.
(Analyze_Quantified_Expression): Update ?T? to ?.t?.
* sem_ch6.adb (Check_Conformance): Attach warning message to
-gnatw_p.
(List_Inherited_Pre_Post_Aspects): Update ?L? to ?.l?.
* sem_ch7.adb (Unit_Requires_Body_Info): Update ?Y? to ?.y?.
* sem_ch8.adb (Analyze_Object_Renaming): Update ?R? to ?.r?.
* sem_prag.adb (Validate_Compile_Time_Warning_Or_Error): Attach
warning message to -gnatw_c.
* sem_res.adb (Check_Argument_Order): Update ?P? to ?.p?.
(Resolve_Comparison_Op): Update ?U? to ?.u?.
(Resolve_Range): Update ?U? to ?.u?.
(Resolve_Short_Circuit): Update ?A? to ?.a?.
(Resolve_Unary_Op): Update ?M? to ?.m?.
* sem_util.adb (Check_Result_And_Post_State): Update ?T? to ?.t?.
* sem_warn.adb (Output_Unused_Warnings_Off_Warnings): Update ?W?
to ?.w?.
* warnsw.ads: Update documentation for -gnatw_c.
Diff:
---
gcc/ada/checks.adb | 2 +-
gcc/ada/errout.adb | 55 +++++++++++++++-----------------
gcc/ada/errout.ads | 43 +++++++++++--------------
gcc/ada/erroutc.adb | 90 +++++++++++++++++++++++++++++++++-------------------
gcc/ada/erroutc.ads | 28 ++++++----------
gcc/ada/exp_ch11.adb | 12 +++----
gcc/ada/exp_ch4.adb | 2 +-
gcc/ada/exp_prag.adb | 4 +--
gcc/ada/exp_util.adb | 6 ++--
gcc/ada/freeze.adb | 14 ++++----
gcc/ada/par-util.adb | 2 +-
gcc/ada/sem_attr.adb | 2 +-
gcc/ada/sem_ch13.adb | 39 ++++++++++++-----------
gcc/ada/sem_ch3.adb | 2 +-
gcc/ada/sem_ch4.adb | 8 ++---
gcc/ada/sem_ch6.adb | 8 ++---
gcc/ada/sem_ch7.adb | 11 ++++---
gcc/ada/sem_ch8.adb | 6 ++--
gcc/ada/sem_prag.adb | 2 +-
gcc/ada/sem_res.adb | 12 +++----
gcc/ada/sem_util.adb | 12 +++----
gcc/ada/sem_warn.adb | 12 +++----
gcc/ada/warnsw.ads | 3 +-
23 files changed, 193 insertions(+), 182 deletions(-)
diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb
index 6823f0695ff..bbccab765c0 100644
--- a/gcc/ada/checks.adb
+++ b/gcc/ada/checks.adb
@@ -847,7 +847,7 @@ package body Checks is
else
Error_Msg_N
("\address value may be incompatible with alignment of "
- & "object?X?", AC);
+ & "object?.x?", AC);
end if;
end if;
diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb
index 05a826682e0..76a82681c2d 100644
--- a/gcc/ada/errout.adb
+++ b/gcc/ada/errout.adb
@@ -211,12 +211,9 @@ package body Errout is
-- This is called for warning messages only (so Warning_Msg_Char is set)
-- and returns a corresponding string to use at the beginning of generated
-- auxiliary messages, such as "in instantiation at ...".
- -- 'a' .. 'z' returns "?x?"
- -- 'A' .. 'Z' returns "?X?"
- -- '*' returns "?*?"
- -- '$' returns "?$?info: "
- -- ' ' returns " "
- -- No other settings are valid
+ -- "?" returns "??"
+ -- " " returns "?"
+ -- other trimmed, prefixed and suffixed with "?".
-----------------------
-- Change_Error_Text --
@@ -1177,7 +1174,7 @@ package body Errout is
Errors.Table (Cur_Msg).Warn := True;
Errors.Table (Cur_Msg).Warn_Chr := Warning_Msg_Char;
- elsif Warning_Msg_Char /= ' ' then
+ elsif Warning_Msg_Char /= " " then
Errors.Table (Cur_Msg).Warn_Chr := Warning_Msg_Char;
end if;
end if;
@@ -3927,12 +3924,15 @@ package body Errout is
P : Natural; -- Current index;
procedure Skip_Msg_Insertion_Warning (C : Character);
- -- Deal with ? ?? ?x? ?X? ?*? ?$? insertion sequences (and the same
+ -- Skip the ? ?? ?x? ?*? ?$? insertion sequences (and the same
-- sequences using < instead of ?). The caller has already bumped
-- the pointer past the initial ? or < and C is set to this initial
-- character (? or <). This procedure skips past the rest of the
-- sequence. We do not need to set Msg_Insertion_Char, since this
-- was already done during the message prescan.
+ -- No validity check is performed as the insertion sequence is
+ -- supposed to be sane. See Prescan_Message.Parse_Message_Class in
+ -- erroutc.adb for the validity checks.
--------------------------------
-- Skip_Msg_Insertion_Warning --
@@ -3943,17 +3943,16 @@ package body Errout is
if P <= Text'Last and then Text (P) = C then
P := P + 1;
- elsif P + 1 <= Text'Last
- and then (Text (P) in 'a' .. 'z'
- or else
- Text (P) in 'A' .. 'Z'
- or else
- Text (P) = '*'
- or else
- Text (P) = '$')
- and then Text (P + 1) = C
+ elsif P < Text'Last and then Text (P + 1) = C
+ and then Text (P) in 'a' .. 'z' | '*' | '$'
then
P := P + 2;
+
+ elsif P + 1 < Text'Last and then Text (P + 2) = C
+ and then Text (P) in '.' | '_'
+ and then Text (P + 1) in 'a' .. 'z'
+ then
+ P := P + 3;
end if;
end Skip_Msg_Insertion_Warning;
@@ -4404,19 +4403,15 @@ package body Errout is
function Warn_Insertion return String is
begin
- case Warning_Msg_Char is
- when '?' =>
- return "??";
-
- when 'a' .. 'z' | 'A' .. 'Z' | '*' | '$' =>
- return '?' & Warning_Msg_Char & '?';
-
- when ' ' =>
- return "?";
-
- when others =>
- raise Program_Error;
- end case;
+ if Warning_Msg_Char = "? " then
+ return "??";
+ elsif Warning_Msg_Char = " " then
+ return "?";
+ elsif Warning_Msg_Char (2) = ' ' then
+ return '?' & Warning_Msg_Char (1) & '?';
+ else
+ return '?' & Warning_Msg_Char & '?';
+ end if;
end Warn_Insertion;
end Errout;
diff --git a/gcc/ada/errout.ads b/gcc/ada/errout.ads
index 9b2e08d65e7..60b1b4fb62d 100644
--- a/gcc/ada/errout.ads
+++ b/gcc/ada/errout.ads
@@ -60,13 +60,13 @@ package Errout is
-- Exception raised if Raise_Exception_On_Error is true
Warning_Doc_Switch : Boolean renames Err_Vars.Warning_Doc_Switch;
- -- If this is set True, then the ??/?*?/?$?/?x?/?X? insertion sequences in
- -- error messages generate appropriate tags for the output error messages.
- -- If this switch is False, then these sequences are still recognized (for
- -- the purposes of implementing the pattern matching in pragmas Warnings
- -- (Off,..) and Warning_As_Pragma(...) but do not result in adding the
- -- error message tag. The -gnatw.d switch sets this flag True, -gnatw.D
- -- sets this flag False.
+ -- If this is set True, then the ??/?*?/?$?/?x?/?.x?/?_x? insertion
+ -- sequences in error messages generate appropriate tags for the output
+ -- error messages. If this switch is False, then these sequences are still
+ -- recognized (for the purposes of implementing the pattern matching in
+ -- pragmas Warnings (Off,..) and Warning_As_Pragma(...) but do not result
+ -- in adding the error message tag. The -gnatw.d switch sets this flag
+ -- True, -gnatw.D sets this flag False.
Current_Node : Node_Id := Empty;
-- Used by Error_Msg as a default Node_Id.
@@ -302,28 +302,23 @@ package Errout is
-- clear that the continuation is part of a warning message, but it is
-- not necessary to go through any computational effort to include it.
--
- -- Note: this usage is obsolete, use ?? ?*? ?$? ?x? ?X? to specify
- -- the string to be added when Warn_Doc_Switch is set to True. If this
- -- switch is True, then for simple ? messages it has no effect. This
- -- simple form is to ease transition and may be removed later except
- -- for GNATprove-specific messages (info and warnings) which are not
- -- subject to the same GNAT warning switches.
+ -- Note: this usage is obsolete, use ?? ?*? ?$? ?x? ?.x? ?_x? to
+ -- specify the string to be added when Warn_Doc_Switch is set to True.
+ -- If this switch is True, then for simple ? messages it has no effect.
+ -- This simple form is to ease transition and may be removed later
+ -- except for GNATprove-specific messages (info and warnings) which are
+ -- not subject to the same GNAT warning switches.
-- Insertion character ?? (Two question marks: default warning)
-- Like ?, but if the flag Warn_Doc_Switch is True, adds the string
-- "[enabled by default]" at the end of the warning message. For
-- continuations, use this in each continuation message.
- -- Insertion character ?x? (warning with switch)
+ -- Insertion character ?x? ?.x? ?_x? (warning with switch)
-- Like ?, but if the flag Warn_Doc_Switch is True, adds the string
- -- "[-gnatwx]" at the end of the warning message. x is a lower case
- -- letter. For continuations, use this on each continuation message.
-
- -- Insertion character ?X? (warning with dot switch)
- -- Like ?, but if the flag Warn_Doc_Switch is True, adds the string
- -- "[-gnatw.x]" at the end of the warning message. X is an upper case
- -- letter corresponding to the lower case letter x in the message.
- -- For continuations, use this on each continuation message.
+ -- "[-gnatwx]", "[-gnatw.x]", or "[-gnatw_x]", at the end of the
+ -- warning message. x must be lower case. For continuations, use this
+ -- on each continuation message.
-- Insertion character ?*? (restriction warning)
-- Like ?, but if the flag Warn_Doc_Switch is True, adds the string
@@ -339,8 +334,8 @@ package Errout is
-- Insertion character < (Less Than: conditional warning message)
-- The character < appearing anywhere in a message is used for a
-- conditional error message. If Error_Msg_Warn is True, then the
- -- effect is the same as ? described above, and in particular << <X<
- -- <x< <$< <*< have the effect of ?? ?X? ?x? ?$? ?*? respectively. If
+ -- effect is the same as ? described above, and in particular << <x<
+ -- <$< <*< have the effect of ?? ?x? ?$? ?*? respectively. If
-- Error_Msg_Warn is False, then the < << or <X< sequence is ignored
-- and the message is treated as a error rather than a warning.
diff --git a/gcc/ada/erroutc.adb b/gcc/ada/erroutc.adb
index 8d362de6657..8225fd451c6 100644
--- a/gcc/ada/erroutc.adb
+++ b/gcc/ada/erroutc.adb
@@ -364,20 +364,20 @@ package body Erroutc is
---------------------
function Get_Warning_Tag (Id : Error_Msg_Id) return String is
- Warn : constant Boolean := Errors.Table (Id).Warn;
- Warn_Chr : constant Character := Errors.Table (Id).Warn_Chr;
+ Warn : constant Boolean := Errors.Table (Id).Warn;
+ Warn_Chr : constant String (1 .. 2) := Errors.Table (Id).Warn_Chr;
begin
- if Warn and then Warn_Chr /= ' ' then
- if Warn_Chr = '?' then
+ if Warn and then Warn_Chr /= " " then
+ if Warn_Chr = "? " then
return "[enabled by default]";
- elsif Warn_Chr = '*' then
+ elsif Warn_Chr = "* " then
return "[restriction warning]";
- elsif Warn_Chr = '$' then
+ elsif Warn_Chr = "$ " then
return "[-gnatel]";
- elsif Warn_Chr in 'a' .. 'z' then
+ elsif Warn_Chr (2) = ' ' then
+ return "[-gnatw" & Warn_Chr (1) & ']';
+ else
return "[-gnatw" & Warn_Chr & ']';
- else pragma Assert (Warn_Chr in 'A' .. 'Z');
- return "[-gnatw." & Fold_Lower (Warn_Chr) & ']';
end if;
else
return "";
@@ -841,6 +841,51 @@ package body Erroutc is
procedure Prescan_Message (Msg : String) is
J : Natural;
+ function Parse_Message_Class return String;
+ -- Convert the warning insertion sequence to a warning class represented
+ -- as a length-two string padded, if necessary, with spaces.
+ -- Return the Message class and set the iterator J to the character
+ -- following the sequence.
+ -- Raise a Program_Error if the insertion sequence is not valid.
+
+ -------------------------
+ -- Parse_Message_Class --
+ -------------------------
+
+ function Parse_Message_Class return String is
+ C : constant Character := Msg (J - 1);
+ Message_Class : String (1 .. 2) := " ";
+ begin
+ if J <= Msg'Last and then Msg (J) = C then
+ Message_Class := "? ";
+ J := J + 1;
+
+ elsif J < Msg'Last and then Msg (J + 1) = C
+ and then Msg (J) in 'a' .. 'z' | '*' | '$'
+ then
+ Message_Class := Msg (J) & " ";
+ J := J + 2;
+
+ elsif J + 1 < Msg'Last and then Msg (J + 2) = C
+ and then Msg (J) in '.' | '_'
+ and then Msg (J + 1) in 'a' .. 'z'
+ then
+ Message_Class := Msg (J .. J + 1);
+ J := J + 3;
+ elsif (J < Msg'Last and then Msg (J + 1) = C) or else
+ (J + 1 < Msg'Last and then Msg (J + 2) = C)
+ then
+ raise Program_Error;
+ end if;
+
+ -- In any other cases, this is not a warning insertion sequence
+ -- and the default " " value is returned.
+
+ return Message_Class;
+ end Parse_Message_Class;
+
+ -- Start of processing for Prescan_Message
+
begin
-- Nothing to do for continuation line, unless -gnatdF is set
@@ -848,7 +893,7 @@ package body Erroutc is
return;
-- Some global variables are not set for continuation messages, as they
- -- only make sense for the initial mesage.
+ -- only make sense for the initial message.
elsif Msg (Msg'First) /= '\' then
@@ -900,29 +945,10 @@ package body Erroutc is
elsif Msg (J) = '?' or else Msg (J) = '<' then
Is_Warning_Msg := Msg (J) = '?' or else Error_Msg_Warn;
- Warning_Msg_Char := ' ';
J := J + 1;
if Is_Warning_Msg then
- declare
- C : constant Character := Msg (J - 1);
- begin
- if J <= Msg'Last then
- if Msg (J) = C then
- Warning_Msg_Char := '?';
- J := J + 1;
-
- elsif J < Msg'Last and then Msg (J + 1) = C
- and then (Msg (J) in 'a' .. 'z' or else
- Msg (J) in 'A' .. 'Z' or else
- Msg (J) = '*' or else
- Msg (J) = '$')
- then
- Warning_Msg_Char := Msg (J);
- J := J + 2;
- end if;
- end if;
- end;
+ Warning_Msg_Char := Parse_Message_Class;
end if;
-- Bomb if untagged warning message. This code can be uncommented
@@ -1687,7 +1713,7 @@ package body Erroutc is
if SWE.Open then
Eproc.all
- ("?W?pragma Warnings Off with no matching Warnings On",
+ ("?.w?pragma Warnings Off with no matching Warnings On",
SWE.Start);
-- Warn for ineffective Warnings (Off, ..)
@@ -1702,7 +1728,7 @@ package body Erroutc is
(SWE.Msg'Length > 3 and then SWE.Msg (2 .. 3) = "-W")
then
Eproc.all
- ("?W?no warning suppressed by this pragma", SWE.Start);
+ ("?.w?no warning suppressed by this pragma", SWE.Start);
end if;
end if;
end;
diff --git a/gcc/ada/erroutc.ads b/gcc/ada/erroutc.ads
index 891391c5d43..0c194e803d8 100644
--- a/gcc/ada/erroutc.ads
+++ b/gcc/ada/erroutc.ads
@@ -80,14 +80,14 @@ package Erroutc is
-- Set True to indicate that the current message starts with one of
-- "high: ", "medium: ", "low: " and is to be treated as a check message.
- Warning_Msg_Char : Character;
- -- Warning character, valid only if Is_Warning_Msg is True
- -- ' ' -- ? or < appeared on its own in message
- -- '?' -- ?? or << appeared in message
- -- 'x' -- ?x? or <x< appeared in message (x = a .. z)
- -- 'X' -- ?X? or <X< appeared in message (X = A .. Z)
- -- '*' -- ?*? or <*< appeared in message
- -- '$' -- ?$? or <$< appeared in message
+ Warning_Msg_Char : String (1 .. 2);
+ -- Warning switch, valid only if Is_Warning_Msg is True
+ -- " " -- ? or < appeared on its own in message
+ -- "? " -- ?? or << appeared in message
+ -- "x " -- ?x? or <x< appeared in message
+ -- -- (x = a .. z | A .. Z | * | $)
+ -- ".x" -- ?.x? appeared in message (x = a .. z | A .. Z)
+ -- "_x" -- ?_x? appeared in message (x = a .. z | A .. Z)
-- In the case of the < sequences, this is set only if the message is
-- actually a warning, i.e. if Error_Msg_Warn is True
@@ -239,16 +239,8 @@ package Erroutc is
-- True if this is a warning message which is to be treated as an error
-- as a result of a match with a Warning_As_Error pragma.
- Warn_Chr : Character;
- -- Warning character (note: set even if Warning_Doc_Switch is False)
- -- ' ' -- ? or < appeared on its own in message
- -- '?' -- ?? or << appeared in message
- -- 'x' -- ?x? or <x< appeared in message (x = a .. z)
- -- 'X' -- ?X? or <X< appeared in message (X = A .. Z)
- -- '*' -- ?*? or <*< appeared in message
- -- '$' -- ?$? or <$< appeared in message
- -- In the case of the < sequences, this is set only if the message is
- -- actually a warning, i.e. if Error_Msg_Warn is True
+ Warn_Chr : String (1 .. 2);
+ -- See Warning_Msg_Char
Style : Boolean;
-- True if style message (starts with "(style)")
diff --git a/gcc/ada/exp_ch11.adb b/gcc/ada/exp_ch11.adb
index d27ac6a5c17..b8a9a8dee63 100644
--- a/gcc/ada/exp_ch11.adb
+++ b/gcc/ada/exp_ch11.adb
@@ -1861,10 +1861,10 @@ package body Exp_Ch11 is
if Configurable_Run_Time_Mode then
Error_Msg_NE
- ("\?X?& may call Last_Chance_Handler", N, E);
+ ("\?.x?& may call Last_Chance_Handler", N, E);
else
Error_Msg_NE
- ("\?X?& may result in unhandled exception", N, E);
+ ("\?.x?& may result in unhandled exception", N, E);
end if;
end if;
end;
@@ -2163,7 +2163,7 @@ package body Exp_Ch11 is
Warn_No_Exception_Propagation_Active (N);
Error_Msg_N
- ("\?X?this handler can never be entered, and has been removed", N);
+ ("\?.x?this handler can never be entered, and has been removed", N);
end if;
end Warn_If_No_Local_Raise;
@@ -2180,10 +2180,10 @@ package body Exp_Ch11 is
if Configurable_Run_Time_Mode then
Error_Msg_N
- ("\?X?Last_Chance_Handler will be called on exception", N);
+ ("\?.x?Last_Chance_Handler will be called on exception", N);
else
Error_Msg_N
- ("\?X?execution may raise unhandled exception", N);
+ ("\?.x?execution may raise unhandled exception", N);
end if;
end if;
end Warn_If_No_Propagation;
@@ -2195,7 +2195,7 @@ package body Exp_Ch11 is
procedure Warn_No_Exception_Propagation_Active (N : Node_Id) is
begin
Error_Msg_N
- ("?X?pragma Restrictions (No_Exception_Propagation) in effect", N);
+ ("?.x?pragma Restrictions (No_Exception_Propagation) in effect", N);
end Warn_No_Exception_Propagation_Active;
end Exp_Ch11;
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 3dd0cc4f1af..1eebde446e7 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -4592,7 +4592,7 @@ package body Exp_Ch4 is
and then Nkind (Associated_Node_For_Itype (PtrT)) =
N_Object_Declaration)
then
- Error_Msg_N ("??use of an anonymous access type allocator", N);
+ Error_Msg_N ("?_a?use of an anonymous access type allocator", N);
end if;
-- RM E.2.2(17). We enforce that the expected type of an allocator
diff --git a/gcc/ada/exp_prag.adb b/gcc/ada/exp_prag.adb
index 27b4e7df571..f0b4b0b93ca 100644
--- a/gcc/ada/exp_prag.adb
+++ b/gcc/ada/exp_prag.adb
@@ -563,9 +563,9 @@ package body Exp_Prag is
null;
elsif Nam = Name_Assert then
- Error_Msg_N ("?A?assertion will fail at run time", N);
+ Error_Msg_N ("?.a?assertion will fail at run time", N);
else
- Error_Msg_N ("?A?check will fail at run time", N);
+ Error_Msg_N ("?.a?check will fail at run time", N);
end if;
end if;
end Expand_Pragma_Check;
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index 861442bde35..b0ea44a7f7b 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -315,10 +315,10 @@ package body Exp_Util is
if Present (Msg_Node) then
Error_Msg_N
- ("info: atomic synchronization set for &?N?", Msg_Node);
+ ("info: atomic synchronization set for &?.n?", Msg_Node);
else
Error_Msg_N
- ("info: atomic synchronization set?N?", N);
+ ("info: atomic synchronization set?.n?", N);
end if;
end if;
end Activate_Atomic_Synchronization;
@@ -2849,7 +2849,7 @@ package body Exp_Util is
if Inherited and Opt.List_Inherited_Aspects then
Error_Msg_Sloc := Sloc (Prag);
Error_Msg_N
- ("info: & inherits `Invariant''Class` aspect from #?L?", Typ);
+ ("info: & inherits `Invariant''Class` aspect from #?.l?", Typ);
end if;
-- Add the pragma to the list of processed pragmas
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index 50481563e7c..d57f6d50312 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -3371,7 +3371,7 @@ package body Freeze is
Error_Msg_Uint_1 := Modv;
Error_Msg_N
- ("?M?2 '*'*^' may have been intended here",
+ ("?.m?2 '*'*^' may have been intended here",
Modulus);
end;
end if;
@@ -6412,7 +6412,7 @@ package body Freeze is
then
Error_Msg_NE
("useless postcondition, & is marked "
- & "No_Return?T?", Exp, E);
+ & "No_Return?.t?", Exp, E);
end if;
end if;
@@ -6793,24 +6793,24 @@ package body Freeze is
if Sloc (SC) > Sloc (AC) then
Loc := SC;
Error_Msg_NE
- ("?Z?size is not a multiple of alignment for &",
+ ("?.z?size is not a multiple of alignment for &",
Loc, E);
Error_Msg_Sloc := Sloc (AC);
Error_Msg_Uint_1 := Alignment (E);
- Error_Msg_N ("\?Z?alignment of ^ specified #", Loc);
+ Error_Msg_N ("\?.z?alignment of ^ specified #", Loc);
else
Loc := AC;
Error_Msg_NE
- ("?Z?size is not a multiple of alignment for &",
+ ("?.z?size is not a multiple of alignment for &",
Loc, E);
Error_Msg_Sloc := Sloc (SC);
Error_Msg_Uint_1 := RM_Size (E);
- Error_Msg_N ("\?Z?size of ^ specified #", Loc);
+ Error_Msg_N ("\?.z?size of ^ specified #", Loc);
end if;
Error_Msg_Uint_1 := ((RM_Size (E) / Abits) + 1) * Abits;
- Error_Msg_N ("\?Z?Object_Size will be increased to ^", Loc);
+ Error_Msg_N ("\?.z?Object_Size will be increased to ^", Loc);
end if;
end;
end if;
diff --git a/gcc/ada/par-util.adb b/gcc/ada/par-util.adb
index f4179b9ece7..1d7283c8190 100644
--- a/gcc/ada/par-util.adb
+++ b/gcc/ada/par-util.adb
@@ -816,7 +816,7 @@ package body Util is
C : constant Entity_Id := Current_Entity (N);
begin
if Present (C) and then Sloc (C) = Standard_Location then
- Error_Msg_N ("redefinition of entity& in Standard?K?", N);
+ Error_Msg_N ("redefinition of entity& in Standard?.k?", N);
end if;
end;
end if;
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index f2bb12dae5f..e1ee09e5500 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -2854,7 +2854,7 @@ package body Sem_Attr is
if Bad_Unordered_Enumeration_Reference (N, P_Base_Type) then
Error_Msg_Sloc := Sloc (P_Base_Type);
Error_Msg_NE
- ("comparison on unordered enumeration type& declared#?U?",
+ ("comparison on unordered enumeration type& declared#?.u?",
N, P_Base_Type);
end if;
end Min_Max;
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 71e2d2c2675..6059cee0022 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -483,16 +483,16 @@ package body Sem_Ch13 is
if Warn_On_Reverse_Bit_Order then
Error_Msg_N
("info: multi-byte field specified with "
- & "non-standard Bit_Order?V?", CC);
+ & "non-standard Bit_Order?.v?", CC);
if Bytes_Big_Endian then
Error_Msg_N
("\bytes are not reversed "
- & "(component is big-endian)?V?", CC);
+ & "(component is big-endian)?.v?", CC);
else
Error_Msg_N
("\bytes are not reversed "
- & "(component is little-endian)?V?", CC);
+ & "(component is little-endian)?.v?", CC);
end if;
end if;
@@ -707,17 +707,18 @@ package body Sem_Ch13 is
Error_Msg_Uint_1 := MSS;
Error_Msg_N
("info: reverse bit order in machine scalar of "
- & "length^?V?", First_Bit (CC));
+ & "length^?.v?", First_Bit (CC));
Error_Msg_Uint_1 := NFB;
Error_Msg_Uint_2 := NLB;
if Bytes_Big_Endian then
Error_Msg_NE
- ("\big-endian range for component & is ^ .. ^?V?",
+ ("\big-endian range for component & is ^ .. ^?.v?",
First_Bit (CC), Comp);
else
Error_Msg_NE
- ("\little-endian range for component & is ^ .. ^?V?",
+ ("\little-endian range for component " &
+ "& is ^ .. ^?.v?",
First_Bit (CC), Comp);
end if;
end if;
@@ -782,16 +783,16 @@ package body Sem_Ch13 is
then
Error_Msg_N
("info: multi-byte field specified with non-standard "
- & "Bit_Order?V?", CLC);
+ & "Bit_Order?.v?", CLC);
if Bytes_Big_Endian then
Error_Msg_N
("\bytes are not reversed "
- & "(component is big-endian)?V?", CLC);
+ & "(component is big-endian)?.v?", CLC);
else
Error_Msg_N
("\bytes are not reversed "
- & "(component is little-endian)?V?", CLC);
+ & "(component is little-endian)?.v?", CLC);
end if;
-- Do not allow non-contiguous field
@@ -815,13 +816,13 @@ package body Sem_Ch13 is
then
Error_Msg_N
("info: Bit_Order clause does not affect byte "
- & "ordering?V?", Pos);
+ & "ordering?.v?", Pos);
Error_Msg_Uint_1 :=
Intval (Pos) + Intval (FB) /
System_Storage_Unit;
Error_Msg_N
("info: position normalized to ^ before bit order "
- & "interpreted?V?", Pos);
+ & "interpreted?.v?", Pos);
end if;
-- Here is where we fix up the Component_Bit_Offset value
@@ -6911,7 +6912,7 @@ package body Sem_Ch13 is
and then RM_Size (Ctyp) /= Csize
then
Error_Msg_NE
- ("component size overrides size clause for&?S?", N, Ctyp);
+ ("component size overrides size clause for&?.s?", N, Ctyp);
end if;
Set_Has_Component_Size_Clause (Btype, True);
@@ -8809,7 +8810,7 @@ package body Sem_Ch13 is
and then RM_Size (Etype (Comp)) /= Esize (Comp)
then
Error_Msg_NE
- ("?S?component size overrides size clause for&",
+ ("?.s?component size overrides size clause for&",
Component_Name (CC), Etype (Comp));
end if;
@@ -8918,7 +8919,7 @@ package body Sem_Ch13 is
then
Error_Msg_Sloc := Sloc (Comp);
Error_Msg_NE
- ("?C?no component clause given for & declared #",
+ ("?.c?no component clause given for & declared #",
N, Comp);
end if;
@@ -10125,7 +10126,7 @@ package body Sem_Ch13 is
then
Error_Msg_Sloc := Sloc (Predicate_Function (T));
Error_Msg_Node_2 := T;
- Error_Msg_N ("info: & inherits predicate from & #?L?", Typ);
+ Error_Msg_N ("info: & inherits predicate from & #?.l?", Typ);
end if;
end if;
end Add_Call;
@@ -11910,7 +11911,7 @@ package body Sem_Ch13 is
Clause : Node_Id := First (Component_Clauses (N));
Prev_Bit_Offset : Uint := Uint_0;
OOO : constant String :=
- "?component clause out of order with respect to declaration";
+ "?_r?component clause out of order with respect to declaration";
begin
-- Step Comp through components and Clause through component clauses,
@@ -11936,7 +11937,7 @@ package body Sem_Ch13 is
and then not Reverse_Storage_Order (Rectype)
and then Component_Bit_Offset (Comp) < Prev_Bit_Offset
then
- Error_Msg_N ("?memory layout out of order", Clause);
+ Error_Msg_N ("?_r?memory layout out of order", Clause);
exit;
end if;
@@ -12176,7 +12177,7 @@ package body Sem_Ch13 is
if Warn and then Error_Msg_Uint_1 > 0 then
Error_Msg_NE
- ("?H?^-bit gap before component&",
+ ("?.h?^-bit gap before component&",
Component_Name (Component_Clause (CEnt)),
CEnt);
end if;
@@ -16700,7 +16701,7 @@ package body Sem_Ch13 is
if Warn_On_Biased_Representation then
Error_Msg_NE
- ("?B?" & Msg & " forces biased representation for&", N, E);
+ ("?.b?" & Msg & " forces biased representation for&", N, E);
end if;
end if;
end Set_Biased;
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index c8d4ec1abf3..b8ff3ce6ab4 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -19890,7 +19890,7 @@ package body Sem_Ch3 is
and then Intval (Right_Opnd (Mod_Expr)) <= Uint_128
then
Error_Msg_N
- ("suspicious MOD value, was '*'* intended'??M?", Mod_Expr);
+ ("suspicious MOD value, was '*'* intended'??.m?", Mod_Expr);
end if;
-- Proceed with analysis of mod expression
diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index fecc060a403..6afce5d5aab 100644
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -3229,7 +3229,7 @@ package body Sem_Ch4 is
and then Intval (Right_Opnd (Parent (N))) <= Uint_128
then
Error_Msg_N
- ("suspicious MOD value, was '*'* intended'??M?", Parent (N));
+ ("suspicious MOD value, was '*'* intended'??.m?", Parent (N));
end if;
-- Remaining processing is same as for other arithmetic operators
@@ -4334,7 +4334,7 @@ package body Sem_Ch4 is
(if Kind = Conjunct then "conjunct" else "disjunct");
begin
Error_Msg_NE
- ("?T?unused variable & in " & Sub, Expr, Loop_Id);
+ ("?.t?unused variable & in " & Sub, Expr, Loop_Id);
Error_Msg_NE
("\consider extracting " & Sub & " from quantified "
& "expression", Expr, Loop_Id);
@@ -4354,7 +4354,7 @@ package body Sem_Ch4 is
and then not (Modify_Tree_For_C and In_Inlined_Body)
then
if not Referenced (Loop_Id, Cond) then
- Error_Msg_N ("?T?unused variable &", Loop_Id);
+ Error_Msg_N ("?.t?unused variable &", Loop_Id);
else
Check_Subexpr (Cond, Kind => Full);
end if;
@@ -4375,7 +4375,7 @@ package body Sem_Ch4 is
and then Nkind (Cond) = N_If_Expression
and then No_Else_Or_Trivial_True (Cond)
then
- Error_Msg_N ("?T?suspicious expression", N);
+ Error_Msg_N ("?.t?suspicious expression", N);
Error_Msg_N ("\\did you mean (for all X ='> (if P then Q))", N);
Error_Msg_N ("\\or (for some X ='> P and then Q) instead'?", N);
end if;
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index c608c77530b..af8756b2cca 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -6254,7 +6254,7 @@ package body Sem_Ch6 is
(Old_Id, Old_Type, New_Type)
then
Error_Msg_N ("result subtypes conform but come from different "
- & "declarations??", New_Id);
+ & "declarations?_p?", New_Id);
end if;
-- Ada 2005 (AI-231): In case of anonymous access types check the
@@ -6462,7 +6462,7 @@ package body Sem_Ch6 is
(Old_Id, Old_Formal_Base, New_Formal_Base)
then
Error_Msg_N ("formal subtypes conform but come from "
- & "different declarations??", New_Formal);
+ & "different declarations?_p?", New_Formal);
end if;
-- For mode conformance, mode must match
@@ -10918,11 +10918,11 @@ package body Sem_Ch6 is
if Pragma_Name (Prag) = Name_Precondition then
Error_Msg_N
("info: & inherits `Pre''Class` aspect from "
- & "#?L?", E);
+ & "#?.l?", E);
else
Error_Msg_N
("info: & inherits `Post''Class` aspect from "
- & "#?L?", E);
+ & "#?.l?", E);
end if;
end if;
diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb
index 3852a9ae9f7..a0bddb19288 100644
--- a/gcc/ada/sem_ch7.adb
+++ b/gcc/ada/sem_ch7.adb
@@ -3363,12 +3363,12 @@ package body Sem_Ch7 is
-- Body required if library package with pragma Elaborate_Body
elsif Has_Pragma_Elaborate_Body (Pack_Id) then
- Error_Msg_N ("info: & requires body (Elaborate_Body)?Y?", Pack_Id);
+ Error_Msg_N ("info: & requires body (Elaborate_Body)?.y?", Pack_Id);
-- Body required if subprogram
elsif Is_Subprogram_Or_Generic_Subprogram (Pack_Id) then
- Error_Msg_N ("info: & requires body (subprogram case)?Y?", Pack_Id);
+ Error_Msg_N ("info: & requires body (subprogram case)?.y?", Pack_Id);
-- Body required if generic parent has Elaborate_Body
@@ -3381,7 +3381,7 @@ package body Sem_Ch7 is
begin
if Has_Pragma_Elaborate_Body (G_P) then
Error_Msg_N
- ("info: & requires body (generic parent Elaborate_Body)?Y?",
+ ("info: & requires body (generic parent Elaborate_Body)?.y?",
Pack_Id);
end if;
end;
@@ -3399,7 +3399,7 @@ package body Sem_Ch7 is
(Node (First_Elmt (Abstract_States (Pack_Id))))
then
Error_Msg_N
- ("info: & requires body (non-null abstract state aspect)?Y?",
+ ("info: & requires body (non-null abstract state aspect)?.y?",
Pack_Id);
end if;
@@ -3410,7 +3410,8 @@ package body Sem_Ch7 is
if Requires_Completion_In_Body (E, Pack_Id) then
Error_Msg_Node_2 := E;
Error_Msg_NE
- ("info: & requires body (& requires completion)?Y?", E, Pack_Id);
+ ("info: & requires body (& requires completion)?.y?", E,
+ Pack_Id);
end if;
Next_Entity (E);
diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb
index b05727e64f0..3590e5557c5 100644
--- a/gcc/ada/sem_ch8.adb
+++ b/gcc/ada/sem_ch8.adb
@@ -1327,13 +1327,13 @@ package body Sem_Ch8 is
and then Comes_From_Source (Nam)
then
Error_Msg_N
- ("renaming function result object is suspicious?R?", Nam);
+ ("renaming function result object is suspicious?.r?", Nam);
Error_Msg_NE
- ("\function & will be called only once?R?", Nam,
+ ("\function & will be called only once?.r?", Nam,
Entity (Name (Nam)));
Error_Msg_N -- CODEFIX
("\suggest using an initialized constant object "
- & "instead?R?", Nam);
+ & "instead?.r?", Nam);
end if;
end case;
end if;
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 1e6397f87b8..10ad82fd8a4 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -31976,7 +31976,7 @@ package body Sem_Prag is
Error_Msg_N ("condition is not known at compile time", Arg1x);
elsif Warn_On_Unknown_Compile_Time_Warning then
- Error_Msg_N ("??condition is not known at compile time", Arg1x);
+ Error_Msg_N ("?_c?condition is not known at compile time", Arg1x);
end if;
end Validate_Compile_Time_Warning_Or_Error;
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 0bdc4634c99..f61eca21261 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -3712,7 +3712,7 @@ package body Sem_Res is
if Wrong_Order then
Error_Msg_N
- ("?P?actuals for this call may be in wrong order", N);
+ ("?.p?actuals for this call may be in wrong order", N);
end if;
end;
end;
@@ -7488,7 +7488,7 @@ package body Sem_Res is
if Bad_Unordered_Enumeration_Reference (N, Etype (L)) then
Error_Msg_Sloc := Sloc (Etype (L));
Error_Msg_NE
- ("comparison on unordered enumeration type& declared#?U?",
+ ("comparison on unordered enumeration type& declared#?.u?",
N, Etype (L));
end if;
@@ -10647,7 +10647,7 @@ package body Sem_Res is
then
Error_Msg_Sloc := Sloc (Typ);
Error_Msg_NE
- ("subrange of unordered enumeration type& declared#?U?", N, Typ);
+ ("subrange of unordered enumeration type& declared#?.u?", N, Typ);
end if;
Check_Unset_Reference (L);
@@ -11163,7 +11163,7 @@ package body Sem_Res is
-- of the First_Node call here.
Error_Msg_F
- ("?A?assertion would fail at run time!",
+ ("?.a?assertion would fail at run time!",
Expression
(First (Pragma_Argument_Associations (Orig))));
end if;
@@ -11194,7 +11194,7 @@ package body Sem_Res is
-- comment above for an explanation of why we do this.
Error_Msg_F
- ("?A?check would fail at run time!",
+ ("?.a?check would fail at run time!",
Expression
(Last (Pragma_Argument_Associations (Orig))));
end if;
@@ -12185,7 +12185,7 @@ package body Sem_Res is
and then Expr_Value (R) > Uint_1
then
Error_Msg_N
- ("?M?negative literal of modular type is in fact positive", N);
+ ("?.m?negative literal of modular type is in fact positive", N);
Error_Msg_Uint_1 := (-Expr_Value (R)) mod Modulus (B_Typ);
Error_Msg_Uint_2 := Expr_Value (R);
Error_Msg_N ("\do you really mean^ when writing -^ '?", N);
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 193afc5222f..72406813857 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -4854,17 +4854,17 @@ package body Sem_Util is
if Pragma_Name (Prag) = Name_Contract_Cases then
Error_Msg_NE (Adjust_Message
("contract case does not check the outcome of calling "
- & "&?T?"), Expr, Subp_Id);
+ & "&?.t?"), Expr, Subp_Id);
elsif Pragma_Name (Prag) = Name_Refined_Post then
Error_Msg_NE (Adjust_Message
("refined postcondition does not check the outcome of "
- & "calling &?T?"), Err_Node, Subp_Id);
+ & "calling &?.t?"), Err_Node, Subp_Id);
else
Error_Msg_NE (Adjust_Message
("postcondition does not check the outcome of calling "
- & "&?T?"), Err_Node, Subp_Id);
+ & "&?.t?"), Err_Node, Subp_Id);
end if;
end if;
end Check_Conjunct;
@@ -5132,20 +5132,20 @@ package body Sem_Util is
then
Error_Msg_N
("neither postcondition nor contract cases mention function "
- & "result?T?", Post_Prag);
+ & "result?.t?", Post_Prag);
-- The function has contract cases only and they do not mention
-- attribute 'Result.
elsif Present (Case_Prag) and then not Seen_In_Case then
- Error_Msg_N ("contract cases do not mention result?T?", Case_Prag);
+ Error_Msg_N ("contract cases do not mention result?.t?", Case_Prag);
-- The function has postconditions only and they do not mention
-- attribute 'Result.
elsif Present (Post_Prag) and then not Seen_In_Post then
Error_Msg_N
- ("postcondition does not mention function result?T?", Post_Prag);
+ ("postcondition does not mention function result?.t?", Post_Prag);
end if;
end Check_Result_And_Post_State;
diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb
index 85945bb9b60..d9d5d958315 100644
--- a/gcc/ada/sem_warn.adb
+++ b/gcc/ada/sem_warn.adb
@@ -3293,21 +3293,21 @@ package body Sem_Warn is
elsif Warnings_Off_Used_Unmodified (E) then
Error_Msg_NE
- ("?W?could use Unmodified instead of "
+ ("?.w?could use Unmodified instead of "
& "Warnings Off for &", Pragma_Identifier (N), E);
-- Used only in context where Unreferenced would have worked
elsif Warnings_Off_Used_Unreferenced (E) then
Error_Msg_NE
- ("?W?could use Unreferenced instead of "
+ ("?.w?could use Unreferenced instead of "
& "Warnings Off for &", Pragma_Identifier (N), E);
-- Not used at all
else
Error_Msg_NE
- ("?W?pragma Warnings Off for & unused, "
+ ("?.w?pragma Warnings Off for & unused, "
& "could be omitted", N, E);
end if;
end;
@@ -3863,7 +3863,7 @@ package body Sem_Warn is
-- This is one of the messages
Error_Msg_FE
- ("<I<writable actual for & overlaps with actual for &",
+ ("<.i<writable actual for & overlaps with actual for &",
Act1, Form1);
end if;
end if;
@@ -4220,11 +4220,11 @@ package body Sem_Warn is
if Nkind (Par) = N_Op_Eq then
Error_Msg_N
("suspicious equality test with modified version of "
- & "same object?T?", Par);
+ & "same object?.t?", Par);
else
Error_Msg_N
("suspicious inequality test with modified version of "
- & "same object?T?", Par);
+ & "same object?.t?", Par);
end if;
end if;
end if;
diff --git a/gcc/ada/warnsw.ads b/gcc/ada/warnsw.ads
index 611353835ea..f58be1ea34e 100644
--- a/gcc/ada/warnsw.ads
+++ b/gcc/ada/warnsw.ads
@@ -50,7 +50,8 @@ package Warnsw is
Warn_On_Unknown_Compile_Time_Warning : Boolean := True;
-- Warn on a pragma Compile_Time_Warning whose condition has a value that
- -- is not known at compile time.
+ -- is not known at compile time. On by default, modified by use
+ -- of -gnatw_c/_C and set as part of -gnatwa.
Warn_On_Overridden_Size : Boolean := False;
-- Warn when explicit record component clause or array component_size
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2021-10-25 15:09 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2021-10-25 15:09 [gcc r12-4686] [Ada] Change format of the ?? warning insertion sequence Pierre-Marie de Rodat
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).