diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/ada/checks.adb | 2 | ||||
| -rw-r--r-- | gcc/ada/errout.adb | 55 | ||||
| -rw-r--r-- | gcc/ada/errout.ads | 43 | ||||
| -rw-r--r-- | gcc/ada/erroutc.adb | 90 | ||||
| -rw-r--r-- | gcc/ada/erroutc.ads | 28 | ||||
| -rw-r--r-- | gcc/ada/exp_ch11.adb | 12 | ||||
| -rw-r--r-- | gcc/ada/exp_ch4.adb | 2 | ||||
| -rw-r--r-- | gcc/ada/exp_prag.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/exp_util.adb | 6 | ||||
| -rw-r--r-- | gcc/ada/freeze.adb | 14 | ||||
| -rw-r--r-- | gcc/ada/par-util.adb | 2 | ||||
| -rw-r--r-- | gcc/ada/sem_attr.adb | 2 | ||||
| -rw-r--r-- | gcc/ada/sem_ch13.adb | 39 | ||||
| -rw-r--r-- | gcc/ada/sem_ch3.adb | 2 | ||||
| -rw-r--r-- | gcc/ada/sem_ch4.adb | 8 | ||||
| -rw-r--r-- | gcc/ada/sem_ch6.adb | 8 | ||||
| -rw-r--r-- | gcc/ada/sem_ch7.adb | 11 | ||||
| -rw-r--r-- | gcc/ada/sem_ch8.adb | 6 | ||||
| -rw-r--r-- | gcc/ada/sem_prag.adb | 2 | ||||
| -rw-r--r-- | gcc/ada/sem_res.adb | 12 | ||||
| -rw-r--r-- | gcc/ada/sem_util.adb | 12 | ||||
| -rw-r--r-- | gcc/ada/sem_warn.adb | 12 | ||||
| -rw-r--r-- | 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 6823f06..bbccab7 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 05a8266..76a8268 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 9b2e08d..60b1b4f 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 8d362de..8225fd4 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 891391c..0c194e8 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 d27ac6a..b8a9a8d 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 3dd0cc4..1eebde4 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 27b4e7d..f0b4b0b 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 861442b..b0ea44a 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 5048156..d57f6d5 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 f4179b9..1d7283c 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 f2bb12d..e1ee09e 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 71e2d2c..6059cee 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 c8d4ec1..b8ff3ce 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 fecc060a..6afce5d 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 c608c77..af8756b 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 3852a9a..a0bddb1 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 b05727e..3590e55 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 1e6397f..10ad82f 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 0bdc463..f61eca2 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 193afc5..7240681 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 85945bb..d9d5d95 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 6113538..f58be1e 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 |