This is a fairly major internal reorganization of how info and warning
messages are handled. Info messages for elaboration are now tagged
as [-gnatel] if warning tagging is activated (-gnatw.d), and info
messages coming from instantiations are consistently labeled as such
as shown by this example, compiled with -gnatw.e -gnatl
1. generic
2. package IWInfoD is
3. type Handle_Type is private;
4. function CH return Handle_Type;
|
>>> info: "IWInfoD" requires body ("CH" requires completion)
5. private
6. type Handle_Type is
7. record
8. Initialised : Boolean;
9. end record;
10. end;
1. package body IWInfoD is
2. function CH return Handle_Type is
3. begin
4. return (Initialised => False);
5. end CH;
6. end;
1. with IWInfoD;
2. generic
3. with package My_D is new IWInfoD;
|
>>> info: in instantiation at iwinfod.ads:4
>>> info: "My_D" requires body ("CH" requires completion)
4. with procedure Method (Client : in out My_D.Handle_Type);
5. package IWInfo is
6. private
7. procedure C;
|
>>> info: "IWInfo" requires body ("C" requires completion)
8. end;
1. package body IWInfoD is
2. function CH return Handle_Type is
3. begin
4. return (Initialised => False);
5. end CH;
6. end;
prior to this fix the messages on line 3 of the IWinfo spec
were inconsistent with the first saying warning: and the
second saying info: which was confusing
Tested on x86_64-pc-linux-gnu, committed on trunk
2014-06-11 Robert Dewar <de...@adacore.com>
* errout.adb (Warn_Insertion): New function.
(Error_Msg): Use Warn_Insertion and Prescan_Message.
(Error_Msg_Internal): Set Info field of error object.
(Error_Msg_NEL): Use Prescan_Message.
(Set_Msg_Text): Don't store info: at start of message.
(Skip_Msg_Insertion_Warning): New name for Set_Msg_Insertion_Warning.
(Skip_Msg_Insertion_Warning): Now just skips warning insertion.
* errout.ads: Document new ?$? and >$> insertion sequences
Document use of "(style)" and "info: "
* erroutc.adb (dmsg): Print several missing fields
(Get_Warning_Tag): Handle -gnatel case (?$?) (Output_Msg_Text):
Deal with new tagging of info messages
* erroutc.ads: Is_Info_Msg: New global (Error_Msg_Object):
Add field Info (Prescan_Message): New procedure, this procedure
replaces the old Test_Style_Warning_Serious_Unconditional_Msg
* errutil.adb, exp_util.adb, par-ch7.adb, sem_ch13.adb, sem_ch7.adb,
sem_elab.adb: Follow new rules for info message (info belongs
only at the start of a message, and only in the first message,
not in any of the continuations).
* gnat_ugn.texi: Document full set of warning tags.
Index: errout.adb
===================================================================
--- errout.adb (revision 211445)
+++ errout.adb (working copy)
@@ -197,6 +197,17 @@
-- spec for precise definition of the conversion that is performed by this
-- routine in OpenVMS mode.
+ function Warn_Insertion return String;
+ -- 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
+
-----------------------
-- Change_Error_Text --
-----------------------
@@ -282,7 +293,7 @@
-- Start of processing for new message
Sindex := Get_Source_File_Index (Flag_Location);
- Test_Style_Warning_Serious_Unconditional_Msg (Msg);
+ Prescan_Message (Msg);
Orig_Loc := Original_Location (Flag_Location);
-- If the current location is in an instantiation, the issue arises of
@@ -332,8 +343,7 @@
-- that style checks are not considered warning messages for this
-- purpose.
- if Is_Warning_Msg
- and then Warnings_Suppressed (Orig_Loc) /= No_String
+ if Is_Warning_Msg and then Warnings_Suppressed (Orig_Loc) /= No_String
then
return;
@@ -438,9 +448,9 @@
-- Case of inlined body
if Inlined_Body (X) then
- if Is_Warning_Msg or else Is_Style_Msg then
+ if Is_Warning_Msg or Is_Style_Msg then
Error_Msg_Internal
- ("?in inlined body #",
+ (Warn_Insertion & "in inlined body #",
Actual_Error_Loc, Flag_Location, Msg_Cont_Status);
else
Error_Msg_Internal
@@ -453,7 +463,7 @@
else
if Is_Warning_Msg or else Is_Style_Msg then
Error_Msg_Internal
- ("?in instantiation #",
+ (Warn_Insertion & "in instantiation #",
Actual_Error_Loc, Flag_Location, Msg_Cont_Status);
else
Error_Msg_Internal
@@ -732,7 +742,6 @@
Continuation_New_Line := False;
Suppress_Message := False;
Kill_Message := False;
- Warning_Msg_Char := ' ';
Set_Msg_Text (Msg, Sptr);
-- Kill continuation if parent message killed
@@ -944,6 +953,7 @@
Line => Get_Physical_Line_Number (Sptr),
Col => Get_Column_Number (Sptr),
Warn => Is_Warning_Msg,
+ Info => Is_Info_Msg,
Warn_Err => False, -- reset below
Warn_Chr => Warning_Msg_Char,
Style => Is_Style_Msg,
@@ -1159,7 +1169,7 @@
return;
end if;
- Test_Style_Warning_Serious_Unconditional_Msg (Msg);
+ Prescan_Message (Msg);
-- Special handling for warning messages
@@ -2745,19 +2755,21 @@
C : Character; -- Current character
P : Natural; -- Current index;
- procedure Set_Msg_Insertion_Warning (C : Character);
- -- Deal with ? ?? ?x? ?X? insertion sequences (also < << <x< <X<). The
- -- caller has already bumped the pointer past the initial ? or < and C
- -- is set to this initial character (? or <).
+ procedure Skip_Msg_Insertion_Warning (C : Character);
+ -- Deal with ? ?? ?x? ?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.
- -------------------------------
- -- Set_Msg_Insertion_Warning --
- -------------------------------
+ --------------------------------
+ -- Skip_Msg_Insertion_Warning --
+ --------------------------------
- procedure Set_Msg_Insertion_Warning (C : Character) is
+ procedure Skip_Msg_Insertion_Warning (C : Character) is
begin
if P <= Text'Last and then Text (P) = C then
- Warning_Msg_Char := '?';
P := P + 1;
elsif P + 1 <= Text'Last
@@ -2765,15 +2777,14 @@
or else
Text (P) in 'A' .. 'Z'
or else
- Text (P) = '*')
+ Text (P) = '*'
+ or else
+ Text (P) = '$')
and then Text (P + 1) = C
then
- Warning_Msg_Char := Text (P);
P := P + 2;
- else
- Warning_Msg_Char := ' ';
end if;
- end Set_Msg_Insertion_Warning;
+ end Skip_Msg_Insertion_Warning;
-- Start of processing for Set_Msg_Text
@@ -2782,7 +2793,21 @@
Msglen := 0;
Flag_Source := Get_Source_File_Index (Flag);
- P := Text'First;
+ -- Skip info: at start, we have recorded this in Is_Info_Msg, and this
+ -- will be used (Info field in error message object) to put back the
+ -- string when it is printed. We need to do this, or we get confused
+ -- with instantiation continuations.
+
+ if Text'Length > 6
+ and then Text (Text'First .. Text'First + 5) = "info: "
+ then
+ P := Text'First + 6;
+ else
+ P := Text'First;
+ end if;
+
+ -- Loop through characters of message
+
while P <= Text'Last loop
C := Text (P);
P := P + 1;
@@ -2846,17 +2871,11 @@
null; -- already dealt with
when '?' =>
- Set_Msg_Insertion_Warning ('?');
+ Skip_Msg_Insertion_Warning ('?');
when '<' =>
+ Skip_Msg_Insertion_Warning ('<');
- -- Note: the prescan already set Is_Warning_Msg True if and
- -- only if Error_Msg_Warn is set to True. If Error_Msg_Warn
- -- is False, the call to Set_Msg_Insertion_Warning here does
- -- no harm, since Warning_Msg_Char is ignored in that case.
-
- Set_Msg_Insertion_Warning ('<');
-
when '|' =>
null; -- already dealt with
@@ -3233,4 +3252,22 @@
end loop;
end VMS_Convert;
+ --------------------
+ -- Warn_Insertion --
+ --------------------
+
+ 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;
+ end Warn_Insertion;
+
end Errout;
Index: errout.ads
===================================================================
--- errout.ads (revision 211445)
+++ errout.ads (working copy)
@@ -60,12 +60,13 @@
-- Exception raised if Raise_Exception_On_Error is true
Warning_Doc_Switch : Boolean renames Err_Vars.Warning_Doc_Switch;
- -- If this is set True, then the ??/?*?/?x?/?X? sequences in error messages
- -- generate appropriate tags for the output error messages. If this switch
- -- is False, then these sequences are still recognized (for the purposes
- -- of implementing 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? 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.
-----------------------------------
-- Suppression of Error Messages --
@@ -283,7 +284,7 @@
-- messages, and the usual style is to include it, since it makes it
-- clear that the continuation is part of a warning message.
--
- -- Note: this usage is obsolete, use ?? ?*? ?x? ?X? instead to specify
+ -- 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 will be removed later.
@@ -309,11 +310,17 @@
-- "[restriction warning]" at the end of the warning message. For
-- continuations, use this on each continuation message.
+ -- Insertion character ?$? (elaboration information messages)
+ -- Like ?, but if the flag Warn_Doc_Switch is True, adds the string
+ -- "[-gnatel]" at the end of the info message. This is used for the
+ -- messages generated by the switch -gnatel. For continuations, use
+ -- this on each continuation message.
+
-- 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< and <*< have the effect of ?? ?X? and ?*? respectively. If
+ -- effect is the same as ? described above, and in particular << <X<
+ -- <x< <$< <*< have the effect of ?? ?X? ?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.
@@ -392,6 +399,19 @@
-- This is like [ except that the insertion messages say may/might,
-- instead of will/would.
+ -- Insertion sequence "(style)" (style message)
+ -- This appears only at the start of the message (and not any of its
+ -- continuations, if any), and indicates that the message is a style
+ -- message. Style messages are also considered to be warnings, but
+ -- they do not get a tag.
+
+ -- Insertion sequence "info: " (information message)
+ -- This appears only at the start of the message (and not any of its
+ -- continuations, if any), and indicates that the message is an info
+ -- message. The message will be output with this prefix, and if there
+ -- are continuations that are not printed using the -gnatj switch they
+ -- will also have this prefix.
+
----------------------------------------
-- Specialization of Messages for VMS --
----------------------------------------
Index: erroutc.adb
===================================================================
--- erroutc.adb (revision 211445)
+++ erroutc.adb (working copy)
@@ -257,6 +257,7 @@
w ("Dumping error message, Id = ", Int (Id));
w (" Text = ", E.Text.all);
w (" Next = ", Int (E.Next));
+ w (" Prev = ", Int (E.Prev));
w (" Sfile = ", Int (E.Sfile));
Write_Str
@@ -272,6 +273,8 @@
w (" Line = ", Int (E.Line));
w (" Col = ", Int (E.Col));
w (" Warn = ", E.Warn);
+ w (" Warn_Err = ", E.Warn_Err);
+ w (" Warn_Chr = '" & E.Warn_Chr & ''');
w (" Style = ", E.Style);
w (" Serious = ", E.Serious);
w (" Uncond = ", E.Uncond);
@@ -312,6 +315,8 @@
return "[enabled by default]";
elsif Warn_Chr = '*' then
return "[restriction warning]";
+ elsif Warn_Chr = '$' then
+ return "[-gnatel]";
elsif Warn_Chr in 'a' .. 'z' then
return "[-gnatw" & Warn_Chr & ']';
else pragma Assert (Warn_Chr in 'A' .. 'Z');
@@ -574,24 +579,22 @@
if Errors.Table (E).Warn then
- -- Nothing to do with info messages, "info " already set
+ -- For info messages, prefix message with "info: "
- if Txt'Length >= 6
- and then Txt (Txt'First .. Txt'First + 5) = "info: "
- then
- null;
+ if Errors.Table (E).Info then
+ Txt := new String'("info: " & Txt.all);
-- Warning treated as error
elsif Errors.Table (E).Warn_Err then
- -- We prefix the tag error: rather than warning: and postfix
+ -- We prefix with "error:" rather than warning: and postfix
-- [warning-as-error] at the end.
Warnings_Treated_As_Errors := Warnings_Treated_As_Errors + 1;
Txt := new String'("error: " & Txt.all & " [warning-as-error]");
- -- Normal case, prefix
+ -- Normal case, prefix with "warning: "
else
Txt := new String'("warning: " & Txt.all);
@@ -683,6 +686,103 @@
end;
end Output_Msg_Text;
+ ---------------------
+ -- Prescan_Message --
+ ---------------------
+
+ procedure Prescan_Message (Msg : String) is
+ J : Natural;
+
+ begin
+ -- Nothing to do for continuation line
+
+ if Msg (Msg'First) = '\' then
+ return;
+ end if;
+
+ -- 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;
+
+ -- Check style message
+
+ Is_Style_Msg :=
+ Msg'Length > 7 and then Msg (Msg'First .. Msg'First + 6) = "(style)";
+
+ -- Check info message
+
+ Is_Info_Msg :=
+ Msg'Length > 6 and then Msg (Msg'First .. Msg'First + 5) = "info: ";
+
+ -- Loop through message looking for relevant insertion sequences
+
+ J := Msg'First;
+ while J <= Msg'Last loop
+
+ -- If we have a quote, don't look at following character
+
+ if Msg (J) = ''' then
+ J := J + 2;
+
+ -- Warning message (? or < insertion sequence)
+
+ 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;
+ end if;
+
+ -- Unconditional message (! insertion)
+
+ elsif Msg (J) = '!' then
+ Is_Unconditional_Msg := True;
+ J := J + 1;
+
+ if J <= Msg'Last and then Msg (J) = '!' then
+ Has_Double_Exclam := True;
+ J := J + 1;
+ end if;
+
+ -- Non-serious error (| insertion)
+
+ elsif Msg (J) = '|' then
+ Is_Serious_Error := False;
+ J := J + 1;
+
+ else
+ J := J + 1;
+ end if;
+ end loop;
+
+ if Is_Warning_Msg or Is_Style_Msg then
+ Is_Serious_Error := False;
+ end if;
+ end Prescan_Message;
+
--------------------
-- Purge_Messages --
--------------------
@@ -1251,6 +1351,7 @@
for J in 1 .. Specific_Warnings.Last loop
declare
SWE : Specific_Warning_Entry renames Specific_Warnings.Table (J);
+
begin
if Msg = SWE.Msg.all
and then Loc > SWE.Start
@@ -1352,63 +1453,6 @@
end if;
end Set_Warnings_Mode_On;
- ------------------------------------
- -- Test_Style_Warning_Serious_Msg --
- ------------------------------------
-
- 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;
-
- -- 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)");
-
- for J in Msg'Range loop
- if Msg (J) = '?'
- and then (J = Msg'First or else Msg (J - 1) /= ''')
- then
- 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
- Is_Warning_Msg := Error_Msg_Warn;
- Warning_Msg_Char := ' ';
-
- elsif Msg (J) = '|'
- and then (J = Msg'First or else Msg (J - 1) /= ''')
- then
- Is_Serious_Error := False;
- end if;
- end loop;
-
- if Is_Warning_Msg or Is_Style_Msg then
- Is_Serious_Error := False;
- end if;
- end Test_Style_Warning_Serious_Unconditional_Msg;
-
--------------------------------
-- Validate_Specific_Warnings --
--------------------------------
Index: erroutc.ads
===================================================================
--- erroutc.ads (revision 211445)
+++ erroutc.ads (working copy)
@@ -60,15 +60,24 @@
-- 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 (contains ?)
+ -- Set True to indicate if current message is warning message (contains ?
+ -- or contains < and Error_Msg_Warn is True.
+ Is_Info_Msg : Boolean := False;
+ -- Set True to indicate that the current message starts with the characters
+ -- "info: " and is to be treated as an information message. This string
+ -- will be prepended to the message and all its continuations.
+
Warning_Msg_Char : Character;
-- Warning character, valid only if Is_Warning_Msg is True
- -- ' ' -- ? appeared on its own in message
- -- '?' -- ?? appeared in message
- -- 'x' -- ?x? appeared in message (x = a .. z)
- -- 'X' -- ?X? appeared in message (X = A .. Z)
- -- '*' -- ?*? appeared in message
+ -- ' ' -- ? 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
Is_Style_Msg : Boolean := False;
-- Set True to indicate if the current message is a style message
@@ -194,19 +203,25 @@
-- Column number for error message
Warn : Boolean;
- -- True if warning message (i.e. insertion character ? appeared)
+ -- True if warning message
+ Info : Boolean;
+ -- True if info message
+
Warn_Err : Boolean;
-- 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)
- -- ' ' -- ? appeared on its own in message
- -- '?' -- ?? appeared in message
- -- 'x' -- ?x? appeared in message (x = a .. z)
- -- 'X' -- ?X? appeared in message (X = A .. Z)
- -- '*' -- ?*? appeared in message
+ -- ' ' -- ? 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
Style : Boolean;
-- True if style message (starts with "(style)")
@@ -404,6 +419,34 @@
-- splits the line generating multiple lines of output, and in this case
-- the last line has no terminating end of line character.
+ procedure Prescan_Message (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_Info_Msg is set True if Msg is an information message (starts
+ -- with "info: ". Such messages must contain a ? sequence since they
+ -- are also considered to be warning messages, and get a tag.
+ --
+ -- 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.
+ --
+ -- We need to know right away these aspects of a message, since we will
+ -- test these values before doing the full error scan.
+ --
+ -- Note that the call has no effect for continuation messages (those whose
+ -- first character is '\'), and all variables are left unchanged.
+
procedure Purge_Messages (From : Source_Ptr; To : Source_Ptr);
-- All error messages whose location is in the range From .. To (not
-- including the end points) will be deleted from the error listing.
@@ -523,27 +566,6 @@
-- 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_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 String_Id;
-- Determines if given location is covered by a warnings off suppression
-- range in the warnings table (or is suppressed by compilation option,
Index: errutil.adb
===================================================================
--- errutil.adb (revision 211445)
+++ errutil.adb (working copy)
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1991-2013, Free Software Foundation, Inc. --
+-- Copyright (C) 1991-2014, 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- --
@@ -177,7 +177,7 @@
raise Error_Msg_Exception;
end if;
- Test_Style_Warning_Serious_Unconditional_Msg (Msg);
+ Prescan_Message (Msg);
Set_Msg_Text (Msg, Sptr);
-- Kill continuation if parent message killed
@@ -212,6 +212,7 @@
Errors.Table (Cur_Msg).Col := Get_Column_Number (Sptr);
Errors.Table (Cur_Msg).Style := Is_Style_Msg;
Errors.Table (Cur_Msg).Warn := Is_Warning_Msg;
+ Errors.Table (Cur_Msg).Info := Is_Info_Msg;
Errors.Table (Cur_Msg).Warn_Chr := Warning_Msg_Char;
Errors.Table (Cur_Msg).Serious := Is_Serious_Error;
Errors.Table (Cur_Msg).Uncond := Is_Unconditional_Msg;
Index: exp_util.adb
===================================================================
--- exp_util.adb (revision 211445)
+++ exp_util.adb (working copy)
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
@@ -228,10 +228,10 @@
if Present (Msg_Node) then
Error_Msg_N
- ("?N?info: atomic synchronization set for &", Msg_Node);
+ ("info: atomic synchronization set for &?N?", Msg_Node);
else
Error_Msg_N
- ("?N?info: atomic synchronization set", N);
+ ("info: atomic synchronization set?N?", N);
end if;
end if;
end Activate_Atomic_Synchronization;
Index: gnat_ugn.texi
===================================================================
--- gnat_ugn.texi (revision 211445)
+++ gnat_ugn.texi (working copy)
@@ -5096,19 +5096,46 @@
indexed components, slices, and selected components.
@item -gnatw.d
-@emph{Activate tagging of warning messages.}
+@emph{Activate tagging of warning and info messages.}
@cindex @option{-gnatw.d} (@command{gcc})
-If this switch is set, then warning messages are tagged, either with
-the string ``@option{-gnatw?}'' showing which switch controls the warning,
-or with ``[enabled by default]'' if the warning is not under control of a
-specific @option{-gnatw?} switch. This mode is off by default, and is not
-affected by the use of @code{-gnatwa}.
+If this switch is set, then warning messages are tagged, with one of the
+following strings:
+@table @option
+
+@item [-gnatw?]
+Used to tag warnings controlled by the switch @option{-gnatwx} where x
+is a letter a-z.
+
+@item [-gnatw.?]
+Used to tag warnings controlled by the switch @option{-gnatw.x} where x
+is a letter a-z.
+
+@item [-gnatel]
+Used to tag elaboration information (info) messages generated when the
+static model of elaboration is used and the @option{-gnatel} switch is set.
+
+@item [restriction warning]
+Used to tag warning messages for restriction violations, activated by use
+of the pragma @option{Restriction_Warnings}.
+
+@item [warning-as-error]
+Used to tag warning messages that have been converted to error messages by
+use of the pragma Warning_As_Error. Note that such warnings are prefixed by
+the string "error: " rather than "warning: ".
+
+@item [enabled by default]
+Used to tag all other warnings that are always given by default, unless
+warnings are completely suppressed using pragma @option{Warnings(Off)} or
+the switch @option{-gnatws}.
+
+@end table
+
@item -gnatw.D
-@emph{Deactivate tagging of warning messages.}
+@emph{Deactivate tagging of warning and info messages messages.}
@cindex @option{-gnatw.d} (@command{gcc})
If this switch is set, then warning messages return to the default
-mode in which warnings are not tagged as described above for
+mode in which warnings and info messages are not tagged as described above for
@code{-gnatw.d}.
@item -gnatwe
Index: par-ch7.adb
===================================================================
--- par-ch7.adb (revision 211445)
+++ par-ch7.adb (working copy)
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
@@ -270,7 +270,7 @@
if Aspect_Sloc /= No_Location
and then not Aspect_Specifications_Present
then
- Error_Msg_SC ("\info: aspect specifications belong here");
+ Error_Msg_SC ("info: aspect specifications belong here??");
Move_Aspects (From => Dummy_Node, To => Package_Node);
end if;
Index: sem_ch13.adb
===================================================================
--- sem_ch13.adb (revision 211445)
+++ sem_ch13.adb (working copy)
@@ -661,12 +661,12 @@
if Bytes_Big_Endian then
Error_Msg_NE
- ("\info: big-endian range for "
+ ("\big-endian range for "
& "component & is ^ .. ^?V?",
First_Bit (CC), Comp);
else
Error_Msg_NE
- ("\info: little-endian range "
+ ("\little-endian range "
& "for component & is ^ .. ^?V?",
First_Bit (CC), Comp);
end if;
@@ -6324,7 +6324,7 @@
if Inherit and Opt.List_Inherited_Aspects then
Error_Msg_Sloc := Sloc (Ritem);
Error_Msg_N
- ("?L?info: & inherits `Invariant''Class` aspect from #",
+ ("info: & inherits `Invariant''Class` aspect from #?L?",
Typ);
end if;
end if;
Index: sem_ch7.adb
===================================================================
--- sem_ch7.adb (revision 211445)
+++ sem_ch7.adb (working copy)
@@ -2885,13 +2885,12 @@
-- Body required if library package with pragma Elaborate_Body
elsif Has_Pragma_Elaborate_Body (P) then
- Error_Msg_N
- ("?Y?info: & requires body (Elaborate_Body)", P);
+ Error_Msg_N ("info: & requires body (Elaborate_Body)?Y?", P);
-- Body required if subprogram
elsif Is_Subprogram (P) or else Is_Generic_Subprogram (P) then
- Error_Msg_N ("?Y?info: & requires body (subprogram case)", P);
+ Error_Msg_N ("info: & requires body (subprogram case)?Y?", P);
-- Body required if generic parent has Elaborate_Body
@@ -2904,7 +2903,7 @@
begin
if Has_Pragma_Elaborate_Body (G_P) then
Error_Msg_N
- ("?Y?info: & requires body (generic parent Elaborate_Body)",
+ ("info: & requires body (generic parent Elaborate_Body)?Y?",
P);
end if;
end;
@@ -2922,7 +2921,7 @@
not Is_Null_State (Node (First_Elmt (Abstract_States (P))))
then
Error_Msg_N
- ("?Y?info: & requires body (non-null abstract state aspect)", P);
+ ("info: & requires body (non-null abstract state aspect)?Y?", P);
end if;
-- Otherwise search entity chain for entity requiring completion
@@ -2985,7 +2984,7 @@
then
Error_Msg_Node_2 := E;
Error_Msg_NE
- ("?Y?info: & requires body (& requires completion)",
+ ("info: & requires body (& requires completion)?Y?",
E, P);
-- Entity that does not require completion
Index: sem_elab.adb
===================================================================
--- sem_elab.adb (revision 211445)
+++ sem_elab.adb (working copy)
@@ -942,7 +942,7 @@
if Inst_Case then
Elab_Warning
("instantiation of& may raise Program_Error?l?",
- "info: instantiation of& during elaboration?", Ent);
+ "info: instantiation of& during elaboration?$?", Ent);
-- Indirect call case, info message only in static elaboration
-- case, because the attribute reference itself cannot raise
@@ -950,7 +950,7 @@
elsif Access_Case then
Elab_Warning
- ("", "info: access to& during elaboration?", Ent);
+ ("", "info: access to& during elaboration?$?", Ent);
-- Subprogram call case
@@ -961,13 +961,13 @@
then
Elab_Warning
("implicit call to & may raise Program_Error?l?",
- "info: implicit call to & during elaboration?",
+ "info: implicit call to & during elaboration?$?",
Ent);
else
Elab_Warning
("call to & may raise Program_Error?l?",
- "info: call to & during elaboration?",
+ "info: call to & during elaboration?$?",
Ent);
end if;
end if;
@@ -977,13 +977,13 @@
if Nkind (N) in N_Subprogram_Instantiation then
Elab_Warning
("\missing pragma Elaborate for&?l?",
- "\info: implicit pragma Elaborate for& generated?",
+ "\implicit pragma Elaborate for& generated?$?",
W_Scope);
else
Elab_Warning
("\missing pragma Elaborate_All for&?l?",
- "\info: implicit pragma Elaborate_All for & generated?",
+ "\implicit pragma Elaborate_All for & generated?$?",
W_Scope);
end if;
end Generate_Elab_Warnings;
@@ -1063,7 +1063,7 @@
Error_Msg_Node_2 := W_Scope;
Error_Msg_NE
("info: call to& in elaboration code " &
- "requires pragma Elaborate_All on&?", N, E);
+ "requires pragma Elaborate_All on&?$?", N, E);
end if;
-- Set indication for binder to generate Elaborate_All
@@ -2320,15 +2320,14 @@
if Inst_Case then
Error_Msg_NE
- ("instantiation of& may occur before body is seen<<",
+ ("instantiation of& may occur before body is seen<l<",
N, Orig_Ent);
else
Error_Msg_NE
- ("call to& may occur before body is seen<<", N, Orig_Ent);
+ ("call to& may occur before body is seen<l<", N, Orig_Ent);
end if;
- Error_Msg_N
- ("\Program_Error ]<<", N);
+ Error_Msg_N ("\Program_Error ]<l<", N);
Output_Calls (N);
end if;
@@ -2570,7 +2569,7 @@
Error_Msg_Node_2 := Task_Scope;
Error_Msg_NE
("info: activation of an instance of task type&" &
- " requires pragma Elaborate_All on &?", N, Ent);
+ " requires pragma Elaborate_All on &?$?", N, Ent);
end if;
Activate_Elaborate_All_Desirable (N, Task_Scope);
@@ -3056,6 +3055,10 @@
-- by the error message circuits (i.e. it has a single upper
-- case letter at the end).
+ -----------------------------
+ -- Is_Printable_Error_Name --
+ -----------------------------
+
function Is_Printable_Error_Name (Nm : Name_Id) return Boolean is
begin
if not Is_Internal_Name (Nm) then
@@ -3078,17 +3081,31 @@
Ent := Elab_Call.Table (J).Ent;
- if Is_Generic_Unit (Ent) then
- Error_Msg_NE ("\??& instantiated #", N, Ent);
+ -- Dynamic elaboration model, warnings controlled by -gnatwl
- elsif Is_Init_Proc (Ent) then
- Error_Msg_N ("\??initialization procedure called #", N);
+ if Dynamic_Elaboration_Checks then
+ if Is_Generic_Unit (Ent) then
+ Error_Msg_NE ("\\?l?& instantiated #", N, Ent);
+ elsif Is_Init_Proc (Ent) then
+ Error_Msg_N ("\\?l?initialization procedure called #", N);
+ elsif Is_Printable_Error_Name (Chars (Ent)) then
+ Error_Msg_NE ("\\?l?& called #", N, Ent);
+ else
+ Error_Msg_N ("\\?l?called #", N);
+ end if;
- elsif Is_Printable_Error_Name (Chars (Ent)) then
- Error_Msg_NE ("\??& called #", N, Ent);
+ -- Static elaboration model, info messages controlled by -gnatel
else
- Error_Msg_N ("\?? called #", N);
+ if Is_Generic_Unit (Ent) then
+ Error_Msg_NE ("\\?$?& instantiated #", N, Ent);
+ elsif Is_Init_Proc (Ent) then
+ Error_Msg_N ("\\?$?initialization procedure called #", N);
+ elsif Is_Printable_Error_Name (Chars (Ent)) then
+ Error_Msg_NE ("\\?$?& called #", N, Ent);
+ else
+ Error_Msg_N ("\\?$?called #", N);
+ end if;
end if;
end loop;
end Output_Calls;
