This patch relaxes the restriction that ! and !! must appear at the end
of a compiler message. They can now appear anywhere. This is only an
internal implementation change with no functional effect, so no test.
Tested on x86_64-pc-linux-gnu, committed on trunk
2013-07-08 Robert Dewar <de...@adacore.com>
* errout.adb (Set_Msg_Txt): No longer sets Is_Style_Msg,
Is_Warning_Msg, or Is_Unconditional_Msg (all are set elsewhere
now).
* errout.ads: Insertions ! and !! no longer have to be at the
end of the message, they can be anywhere in the message.
* erroutc.adb (Test_Style_Warning_Serious_Unconditional_Msg):
Replaces Test_Style_Warning_Serious_Msg
* erroutc.ads (Has_Double_Exclam): New flag New comments for
existing flags (Test_Style_Warning_Serious_Unconditional_Msg):
Replaces Test_Style_Warning_Serious_Msg
* errutil.adb (Test_Style_Warning_Serious_Unconditional_Msg):
Replaces Test_Style_Warning_Serious_Msg
Index: errout.adb
===================================================================
--- errout.adb (revision 200688)
+++ errout.adb (working copy)
@@ -153,8 +153,7 @@
-- be one of the special insertion characters (see documentation in spec).
-- Flag is the location at which the error is to be posted, which is used
-- to determine whether or not the # insertion needs a file name. The
- -- variables Msg_Buffer, Msglen, Is_Style_Msg, Is_Warning_Msg, and
- -- Is_Unconditional_Msg are set on return.
+ -- variables Msg_Buffer are set on return Msglen.
procedure Set_Posted (N : Node_Id);
-- Sets the Error_Posted flag on the given node, and all its parents
@@ -283,7 +282,7 @@
-- Start of processing for new message
Sindex := Get_Source_File_Index (Flag_Location);
- Test_Style_Warning_Serious_Msg (Msg);
+ Test_Style_Warning_Serious_Unconditional_Msg (Msg);
Orig_Loc := Original_Location (Flag_Location);
-- If the current location is in an instantiation, the issue arises of
@@ -726,7 +725,7 @@
if Suppress_Message
and then not All_Errors_Mode
and then not Is_Warning_Msg
- and then Msg (Msg'Last) /= '!'
+ and then not Is_Unconditional_Msg
then
if not Continuation then
Last_Killed := True;
@@ -787,9 +786,9 @@
elsif Debug_Flag_GG then
null;
- -- Keep warning if message text ends in !!
+ -- Keep warning if message text contains !!
- elsif Msg (Msg'Last) = '!' and then Msg (Msg'Last - 1) = '!' then
+ elsif Has_Double_Exclam then
null;
-- Here is where we delete a warning from a with'ed unit
@@ -1123,7 +1122,7 @@
return;
end if;
- Test_Style_Warning_Serious_Msg (Msg);
+ Test_Style_Warning_Serious_Unconditional_Msg (Msg);
-- Special handling for warning messages
@@ -1163,7 +1162,7 @@
-- Test for message to be output
if All_Errors_Mode
- or else Msg (Msg'Last) = '!'
+ or else Is_Unconditional_Msg
or else Is_Warning_Msg
or else OK_Node (N)
or else (Msg (Msg'First) = '\' and then not Last_Killed)
@@ -2711,7 +2710,6 @@
begin
Manual_Quote_Mode := False;
- Is_Unconditional_Msg := False;
Msglen := 0;
Flag_Source := Get_Source_File_Index (Flag);
@@ -2776,7 +2774,7 @@
Set_Msg_Char ('"');
when '!' =>
- Is_Unconditional_Msg := True;
+ null; -- already dealt with
when '?' =>
Set_Msg_Insertion_Warning;
Index: errout.ads
===================================================================
--- errout.ads (revision 200688)
+++ errout.ads (working copy)
@@ -101,10 +101,9 @@
-- messages. Warning messages are only suppressed for case 1, and
-- when they come from other than the main extended unit.
- -- This normal suppression action may be overridden in cases 2-5 (but not
- -- in case 1) by setting All_Errors mode, or by setting the special
- -- unconditional message insertion character (!) at the end of the message
- -- text as described below.
+ -- This normal suppression action may be overridden in cases 2-5 (but
+ -- not in case 1) by setting All_Errors mode, or by setting the special
+ -- unconditional message insertion character (!) as described below.
---------------------------------------------------------
-- Error Message Text and Message Insertion Characters --
@@ -230,7 +229,7 @@
-- name is defined, this insertion character has no effect.
-- Insertion character ! (Exclamation: unconditional message)
- -- The character ! appearing as the last character of a message makes
+ -- The character ! appearing anywhere in the text of a message makes
-- the message unconditional which means that it is output even if it
-- would normally be suppressed. See section above for a description
-- of the cases in which messages are normally suppressed. Note that
@@ -249,7 +248,7 @@
-- Insertion character !! (Double exclamation: unconditional warning)
-- Normally warning messages issued in other than the main unit are
- -- suppressed. If the message ends with !! then this suppression is
+ -- suppressed. If the message contains !! then this suppression is
-- avoided. This is currently used by the Compile_Time_Warning pragma
-- to ensure the message for a with'ed unit is output, and for warnings
-- on ineffective back-end inlining, which is detected in units that
Index: errutil.adb
===================================================================
--- errutil.adb (revision 200688)
+++ errutil.adb (working copy)
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1991-2012, Free Software Foundation, Inc. --
+-- Copyright (C) 1991-2013, 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- --
@@ -163,9 +163,9 @@
-- Corresponds to the Sptr value in the error message object
Optr : Source_Ptr renames Flag_Location;
- -- Corresponds to the Optr value in the error message object. Note
- -- that for this usage, Sptr and Optr always have the same value,
- -- since we do not have to worry about generic instantiations.
+ -- Corresponds to the Optr value in the error message object. Note that
+ -- for this usage, Sptr and Optr always have the same value, since we do
+ -- not have to worry about generic instantiations.
begin
if Errors_Must_Be_Ignored then
@@ -176,7 +176,7 @@
raise Error_Msg_Exception;
end if;
- Test_Style_Warning_Serious_Msg (Msg);
+ Test_Style_Warning_Serious_Unconditional_Msg (Msg);
Set_Msg_Text (Msg, Sptr);
-- Kill continuation if parent message killed
@@ -680,8 +680,8 @@
------------------
procedure Set_Msg_Text (Text : String; Flag : Source_Ptr) is
- C : Character; -- Current character
- P : Natural; -- Current index;
+ C : Character; -- Current character
+ P : Natural; -- Current index;
begin
Manual_Quote_Mode := False;
@@ -744,7 +744,7 @@
Set_Msg_Char ('"');
elsif C = '!' then
- Is_Unconditional_Msg := True;
+ null;
elsif C = '?' then
null;
Index: erroutc.adb
===================================================================
--- erroutc.adb (revision 200688)
+++ erroutc.adb (working copy)
@@ -1226,22 +1226,24 @@
-- Test_Style_Warning_Serious_Msg --
------------------------------------
- procedure Test_Style_Warning_Serious_Msg (Msg : String) is
+ procedure Test_Style_Warning_Serious_Unconditional_Msg (Msg : String) is
begin
+ -- Nothing to do for continuation line
+
if Msg (Msg'First) = '\' then
return;
end if;
- Is_Serious_Error := True;
- Is_Warning_Msg := False;
+ -- Set initial values of globals (may be changed during scan)
+ Is_Serious_Error := True;
+ Is_Unconditional_Msg := False;
+ Is_Warning_Msg := False;
+ Has_Double_Exclam := False;
+
Is_Style_Msg :=
(Msg'Length > 7 and then Msg (Msg'First .. Msg'First + 6) = "(style)");
- if Is_Style_Msg then
- Is_Serious_Error := False;
- end if;
-
for J in Msg'Range loop
if Msg (J) = '?'
and then (J = Msg'First or else Msg (J - 1) /= ''')
@@ -1249,6 +1251,16 @@
Is_Warning_Msg := True;
Warning_Msg_Char := ' ';
+ elsif Msg (J) = '!'
+ and then (J = Msg'First or else Msg (J - 1) /= ''')
+ then
+ Is_Unconditional_Msg := True;
+ Warning_Msg_Char := ' ';
+
+ if J < Msg'Last and then Msg (J + 1) = '!' then
+ Has_Double_Exclam := True;
+ end if;
+
elsif Msg (J) = '<'
and then (J = Msg'First or else Msg (J - 1) /= ''')
then
@@ -1265,7 +1277,7 @@
if Is_Warning_Msg or Is_Style_Msg then
Is_Serious_Error := False;
end if;
- end Test_Style_Warning_Serious_Msg;
+ end Test_Style_Warning_Serious_Unconditional_Msg;
--------------------------------
-- Validate_Specific_Warnings --
Index: erroutc.ads
===================================================================
--- erroutc.ads (revision 200688)
+++ erroutc.ads (working copy)
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2013, 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- --
@@ -47,8 +47,20 @@
Flag_Source : Source_File_Index;
-- Source file index for source file where error is being posted
+ Has_Double_Exclam : Boolean := False;
+ -- Set true to indicate that the current message contains the insertion
+ -- sequence !! (force warnings even in non-main unit source files).
+
+ Is_Serious_Error : Boolean := False;
+ -- Set True for a serious error (i.e. any message that is not a warning
+ -- or style message, and that does not contain a | insertion character).
+
+ Is_Unconditional_Msg : Boolean := False;
+ -- Set True to indicate that the current message contains the insertion
+ -- character ! and is thus to be treated as an unconditional message.
+
Is_Warning_Msg : Boolean := False;
- -- Set True to indicate if current message is warning message
+ -- Set True to indicate if current message is warning message (contains ?)
Warning_Msg_Char : Character;
-- Warning character, valid only if Is_Warning_Msg is True
@@ -61,12 +73,6 @@
-- Set True to indicate if the current message is a style message
-- (i.e. a message whose text starts with the characters "(style)").
- Is_Serious_Error : Boolean := False;
- -- Set by Set_Msg_Text to indicate if current message is serious error
-
- Is_Unconditional_Msg : Boolean := False;
- -- Set by Set_Msg_Text to indicate if current message is unconditional
-
Kill_Message : Boolean := False;
-- A flag used to kill weird messages (e.g. those containing uninterpreted
-- implicit type references) if we have already seen at least one message
@@ -490,14 +496,26 @@
-- Called in response to a pragma Warnings (On) to record the source
-- location from which warnings are to be turned back on.
- procedure Test_Style_Warning_Serious_Msg (Msg : String);
- -- Sets Is_Warning_Msg true if Msg is a warning message (contains a
- -- question mark character), and False otherwise. Is_Style_Msg is set true
- -- if Msg is a style message (starts with "(style)". Sets Is_Serious_Error
- -- True unless the message is a warning or style/info message or contains
- -- the character | indicating a non-serious error message. Note that the
- -- call has no effect for continuation messages (those whose first
- -- character is '\').
+ procedure Test_Style_Warning_Serious_Unconditional_Msg (Msg : String);
+ -- Scans message text and sets the following variables:
+ --
+ -- Is_Warning_Msg is set True if Msg is a warning message (contains a
+ -- question mark character), and False otherwise.
+ --
+ -- Is_Style_Msg is set True if Msg is a style message (starts with
+ -- "(style)") and False otherwise.
+ --
+ -- Is_Serious_Error is set to True unless the message is a warning or
+ -- style message or contains the character | (non-serious error).
+ --
+ -- Is_Unconditional_Msg is set True if the message contains the character
+ -- ! and is otherwise set False.
+ --
+ -- Has_Double_Exclam is set True if the message contains the sequence !!
+ -- and is otherwise set False.
+ --
+ -- Note that the call has no effect for continuation messages (those whose
+ -- first character is '\'), and all variables are left unchanged.
function Warnings_Suppressed (Loc : Source_Ptr) return Boolean;
-- Determines if given location is covered by a warnings off suppression
