===================================================================
@@ -88,6 +88,12 @@
-- Source_Reference line, then this is initialized to No_Source_File,
-- to force an initial reference to the real source file name.
+ Warning_Doc_Switch : Boolean := False;
+ -- If this is set True, then the ??/?x?/?.x? sequences in error messages
+ -- are active (see errout.ads for details). If this switch is False, then
+ -- these sequences are ignored (i.e. simply equivalent to a single ?). The
+ -- -gnatw.d switch sets this flag True, -gnatw.D sets this flag False.
+
----------------------------------------
-- Error Message Insertion Parameters --
----------------------------------------
@@ -133,7 +139,9 @@
-- before any call to Error_Msg_xxx with a < insertion character present.
-- Setting is irrelevant if no < insertion character is present. Note
-- that it is not necessary to reset this after using it, since the proper
- -- procedure is always to set it before issuing such a message.
+ -- procedure is always to set it before issuing such a message. Note that
+ -- the warning documentation tag is always [enabled by default] in the
+ -- case where this flag is True.
Error_Msg_String : String (1 .. 4096);
Error_Msg_Strlen : Natural;
===================================================================
@@ -3095,7 +3095,7 @@
if Wrong_Order then
Error_Msg_N
- ("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;
===================================================================
@@ -22,9 +22,9 @@
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
+with Err_Vars; use Err_Vars;
+with Opt; use Opt;
-with Opt; use Opt;
-
package body Warnsw is
----------------------------
@@ -52,6 +52,12 @@
when 'C' =>
Warn_On_Unrepped_Components := False;
+ when 'd' =>
+ Warning_Doc_Switch := True;
+
+ when 'D' =>
+ Warning_Doc_Switch := False;
+
when 'e' =>
Address_Clause_Overlay_Warnings := True;
Check_Unreferenced := True;
===================================================================
@@ -821,9 +821,7 @@
-- with a comma space separator (eliminating a possible (style) or
-- info prefix).
- if Error_Msg_Line_Length /= 0
- and then Continuation
- then
+ if Error_Msg_Line_Length /= 0 and then Continuation then
Cur_Msg := Errors.Last;
declare
@@ -894,12 +892,24 @@
Msg_Buffer (M .. Msglen);
Newl := Newl + Msglen - M + 1;
Errors.Table (Cur_Msg).Text := new String'(Newm (1 .. Newl));
+
+ -- Update warning msg flag and message doc char if needed
+
+ if Is_Warning_Msg then
+ if not Errors.Table (Cur_Msg).Warn then
+ Errors.Table (Cur_Msg).Warn := True;
+ Errors.Table (Cur_Msg).Warn_Chr := Warning_Msg_Char;
+
+ elsif Warning_Msg_Char /= ' ' then
+ Errors.Table (Cur_Msg).Warn_Chr := Warning_Msg_Char;
+ end if;
+ end if;
end;
return;
end if;
- -- Otherwise build error message object for new message
+ -- Here we build a new error object
Errors.Append
((Text => new String'(Msg_Buffer (1 .. Msglen)),
@@ -911,6 +921,7 @@
Line => Get_Physical_Line_Number (Sptr),
Col => Get_Column_Number (Sptr),
Warn => Is_Warning_Msg,
+ Warn_Chr => Warning_Msg_Char,
Style => Is_Style_Msg,
Serious => Is_Serious_Error,
Uncond => Is_Unconditional_Msg,
@@ -2655,6 +2666,40 @@
C : Character; -- Current character
P : Natural; -- Current index;
+ procedure Set_Msg_Insertion_Warning;
+ -- Deal with ? ?? ?x? ?X? insertion sequences
+
+ -------------------------------
+ -- Set_Msg_Insertion_Warning --
+ -------------------------------
+
+ procedure Set_Msg_Insertion_Warning is
+ begin
+ Warning_Msg_Char := ' ';
+
+ if P + 1 <= Text'Last and then Text (P) = '?' then
+ if Warning_Doc_Switch then
+ Warning_Msg_Char := '?';
+ end if;
+
+ P := P + 1;
+
+ elsif P + 2 <= Text'Last
+ and then (Text (P) in 'a' .. 'z'
+ or else
+ Text (P) in 'A' .. 'Z')
+ and then Text (P + 1) = '?'
+ then
+ if Warning_Doc_Switch then
+ Warning_Msg_Char := Text (P);
+ end if;
+
+ P := P + 2;
+ end if;
+ end Set_Msg_Insertion_Warning;
+
+ -- Start of processing for Set_Msg_Text
+
begin
Manual_Quote_Mode := False;
Is_Unconditional_Msg := False;
@@ -2725,11 +2770,17 @@
Is_Unconditional_Msg := True;
when '?' =>
- null; -- already dealt with
+ Set_Msg_Insertion_Warning;
when '<' =>
- null; -- already dealt with
+ -- If tagging of messages is enabled, and this is a warning,
+ -- then it is treated as being [enabled by default].
+
+ if Error_Msg_Warn and Warning_Doc_Switch then
+ Warning_Msg_Char := '?';
+ end if;
+
when '|' =>
null; -- already dealt with
===================================================================
@@ -59,6 +59,12 @@
Error_Msg_Exception : exception renames Err_Vars.Error_Msg_Exception;
-- 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
+ -- are active (see errout.ads for details). If this switch is False, then
+ -- these sequences are ignored (i.e. simply equivalent to a single ?). The
+ -- -gnatw.d switch sets this flag True, -gnatw.D sets this flag False.
+
-----------------------------------
-- Suppression of Error Messages --
-----------------------------------
@@ -275,6 +281,24 @@
-- messages, and the usual style is to include it, since it makes it
-- clear that the continuation is part of a warning message.
+ -- Insertion character ?? (two question marks)
+ -- Like ?, but if the flag Warn_Doc_Switch is True, adds the string
+ -- "[enabled by default]" at the end of the warning message. In the
+ -- case of continuations, use this in each continuation message.
+
+ -- Insertion character ?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. In the case of 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. In
+ -- the case of 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
===================================================================
@@ -6912,10 +6912,10 @@
if Mode = 'F' then
if not Raise_Exception_Call then
Error_Msg_N
- ("?RETURN statement missing following this statement!",
+ ("??RETURN statement missing following this statement!",
Last_Stm);
Error_Msg_N
- ("\?Program_Error may be raised at run time!",
+ ("\??Program_Error may be raised at run time!",
Last_Stm);
end if;
===================================================================
@@ -339,9 +339,9 @@
if Warn_On_Obsolescent_Feature then
Error_Msg
- ("use of "":"" is an obsolescent feature (RM J.2(3))?", S);
+ ("?j?use of "":"" is an obsolescent feature (RM J.2(3))", S);
Error_Msg
- ("\use ""'#"" instead?", S);
+ ("\?j?use ""'#"" instead", S);
end if;
end if;
end Check_Obsolete_Base_Char;
@@ -382,8 +382,8 @@
if Warn_On_Obsolescent_Feature then
Error_Msg_SC
- ("use of ""'%"" is an obsolescent feature (RM J.2(4))?");
- Error_Msg_SC ("\use """""" instead?");
+ ("?j?use of ""'%"" is an obsolescent feature (RM J.2(4))");
+ Error_Msg_SC ("\?j?use """""" instead");
end if;
end if;
@@ -398,8 +398,8 @@
if Warn_On_Obsolescent_Feature then
Error_Msg_SC
- ("use of ""'!"" is an obsolescent feature (RM J.2(2))?");
- Error_Msg_SC ("\use ""'|"" instead?");
+ ("?j?use of ""'!"" is an obsolescent feature (RM J.2(2))");
+ Error_Msg_SC ("\?j?use ""'|"" instead");
end if;
end if;
===================================================================
@@ -211,6 +211,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).Warn_Chr := Warning_Msg_Char;
Errors.Table (Cur_Msg).Serious := Is_Serious_Error;
Errors.Table (Cur_Msg).Uncond := Is_Unconditional_Msg;
Errors.Table (Cur_Msg).Msg_Cont := Continuation;
===================================================================
@@ -1610,6 +1610,7 @@
if Nkind (Parent (N)) = N_Compilation_Unit then
declare
Aux : constant Node_Id := Aux_Decls_Node (Parent (N));
+
begin
if No (Pragmas_After (Aux)) then
Set_Pragmas_After (Aux, New_List);
@@ -2014,9 +2015,9 @@
if Warn_On_Obsolescent_Feature then
Error_Msg_N
- ("at clause is an obsolescent feature (RM J.7(2))?", N);
+ ("?j?at clause is an obsolescent feature (RM J.7(2))", N);
Error_Msg_N
- ("\use address attribute definition clause instead?", N);
+ ("\?j?use address attribute definition clause instead", N);
end if;
-- Rewrite as address clause
@@ -4720,9 +4721,9 @@
if Warn_On_Obsolescent_Feature then
Error_Msg_N
- ("mod clause is an obsolescent feature (RM J.8)?", N);
+ ("?j?mod clause is an obsolescent feature (RM J.8)", N);
Error_Msg_N
- ("\use alignment attribute definition clause instead?", N);
+ ("\?j?use alignment attribute definition clause instead?", N);
end if;
if Present (P) then
===================================================================
@@ -442,13 +442,37 @@
Length : Nat;
-- Maximum total length of lines
- Txt : constant String_Ptr := Errors.Table (E).Text;
- Len : constant Natural := Txt'Length;
- Ptr : Natural;
- Split : Natural;
- Start : Natural;
+ Text : constant String_Ptr := Errors.Table (E).Text;
+ Warn : constant Boolean := Errors.Table (E).Warn;
+ Warn_Chr : constant Character := Errors.Table (E).Warn_Chr;
+ Warn_Tag : String_Ptr;
+ Ptr : Natural;
+ Split : Natural;
+ Start : Natural;
begin
+ -- Add warning doc tag if needed
+
+ if Warn and then Warn_Chr /= ' ' then
+ if Warn_Chr = '?' then
+ Warn_Tag := new String'(" [enabled by default]");
+
+ elsif Warn_Chr in 'a' .. 'z' then
+ Warn_Tag := new String'(" [-gnatw" & Warn_Chr & ']');
+
+ else pragma Assert (Warn_Chr in 'A' .. 'Z');
+ Warn_Tag :=
+ new String'(" [-gnatw."
+ & Character'Val (Character'Pos (Warn_Chr) + 32)
+ & ']');
+ end if;
+
+ else
+ Warn_Tag := new String'("");
+ end if;
+
+ -- Set error message line length
+
if Error_Msg_Line_Length = 0 then
Length := Nat'Last;
else
@@ -457,87 +481,95 @@
Max := Integer (Length - Column + 1);
- -- For warning message, add "warning: " unless msg starts with "info: "
+ declare
+ Txt : constant String := Text.all & Warn_Tag.all;
+ Len : constant Natural := Txt'Length;
- if Errors.Table (E).Warn then
- if Len < 6 or else Txt (Txt'First .. Txt'First + 5) /= "info: " then
- Write_Str ("warning: ");
- Max := Max - 9;
- end if;
+ begin
+ -- For warning, add "warning: " unless msg starts with "info: "
- -- No prefix needed for style message, since "(style)" is there already
+ if Errors.Table (E).Warn then
+ if Len < 6
+ or else Txt (Txt'First .. Txt'First + 5) /= "info: "
+ then
+ Write_Str ("warning: ");
+ Max := Max - 9;
+ end if;
- elsif Errors.Table (E).Style then
- null;
+ -- No prefix needed for style message, "(style)" is there already
- -- All other cases, add "error: "
+ elsif Errors.Table (E).Style then
+ null;
- elsif Opt.Unique_Error_Tag then
- Write_Str ("error: ");
- Max := Max - 7;
- end if;
+ -- All other cases, add "error: "
- -- Here we have to split the message up into multiple lines
+ elsif Opt.Unique_Error_Tag then
+ Write_Str ("error: ");
+ Max := Max - 7;
+ end if;
- Ptr := 1;
- loop
- -- Make sure we do not have ludicrously small line
+ -- Here we have to split the message up into multiple lines
- Max := Integer'Max (Max, 20);
+ Ptr := 1;
+ loop
+ -- Make sure we do not have ludicrously small line
- -- If remaining text fits, output it respecting LF and we are done
+ Max := Integer'Max (Max, 20);
- if Len - Ptr < Max then
- for J in Ptr .. Len loop
- if Txt (J) = ASCII.LF then
- Write_Eol;
- Write_Spaces (Offs);
- else
- Write_Char (Txt (J));
- end if;
- end loop;
+ -- If remaining text fits, output it respecting LF and we are done
- return;
+ if Len - Ptr < Max then
+ for J in Ptr .. Len loop
+ if Txt (J) = ASCII.LF then
+ Write_Eol;
+ Write_Spaces (Offs);
+ else
+ Write_Char (Txt (J));
+ end if;
+ end loop;
+ return;
+
-- Line does not fit
- else
- Start := Ptr;
+ else
+ Start := Ptr;
- -- First scan forward looking for a hard end of line
+ -- First scan forward looking for a hard end of line
- for Scan in Ptr .. Ptr + Max - 1 loop
- if Txt (Scan) = ASCII.LF then
- Split := Scan - 1;
- Ptr := Scan + 1;
- goto Continue;
- end if;
- end loop;
+ for Scan in Ptr .. Ptr + Max - 1 loop
+ if Txt (Scan) = ASCII.LF then
+ Split := Scan - 1;
+ Ptr := Scan + 1;
+ goto Continue;
+ end if;
+ end loop;
- -- Otherwise scan backwards looking for a space
+ -- Otherwise scan backwards looking for a space
- for Scan in reverse Ptr .. Ptr + Max - 1 loop
- if Txt (Scan) = ' ' then
- Split := Scan - 1;
- Ptr := Scan + 1;
- goto Continue;
- end if;
- end loop;
+ for Scan in reverse Ptr .. Ptr + Max - 1 loop
+ if Txt (Scan) = ' ' then
+ Split := Scan - 1;
+ Ptr := Scan + 1;
+ goto Continue;
+ end if;
+ end loop;
- -- If we fall through, no space, so split line arbitrarily
+ -- If we fall through, no space, so split line arbitrarily
- Split := Ptr + Max - 1;
- Ptr := Split + 1;
- end if;
+ Split := Ptr + Max - 1;
+ Ptr := Split + 1;
+ end if;
- <<Continue>>
- if Start <= Split then
- Write_Line (Txt (Start .. Split));
- Write_Spaces (Offs);
- end if;
+ <<Continue>>
+ if Start <= Split then
+ Write_Line (Txt (Start .. Split));
+ Write_Spaces (Offs);
+ end if;
- Max := Integer (Length - Column + 1);
- end loop;
+ Max := Integer (Length - Column + 1);
+ end loop;
+ end;
end Output_Msg_Text;
--------------------
@@ -846,9 +878,7 @@
-- Remove upper case letter at end, again, we should not be getting
-- such names, and what we hope is that the remainder makes sense.
- if Name_Len > 1
- and then Name_Buffer (Name_Len) in 'A' .. 'Z'
- then
+ if Name_Len > 1 and then Name_Buffer (Name_Len) in 'A' .. 'Z' then
Name_Len := Name_Len - 1;
end if;
@@ -1217,11 +1247,13 @@
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_Warning_Msg := Error_Msg_Warn;
+ Warning_Msg_Char := ' ';
elsif Msg (J) = '|'
and then (J = Msg'First or else Msg (J - 1) /= ''')
===================================================================
@@ -50,6 +50,13 @@
Is_Warning_Msg : Boolean := False;
-- Set True to indicate if current message is warning message
+ 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' -- ?x? appeared in message (X is upper case of x)
+
Is_Style_Msg : Boolean := False;
-- Set True to indicate if the current message is a style message
-- (i.e. a message whose text starts with the characters "(style)").
@@ -182,6 +189,13 @@
Warn : Boolean;
-- True if warning message (i.e. insertion character ? appeared)
+ Warn_Chr : Character;
+ -- Warning character, valid only if Warn is True
+ -- ' ' -- ? appeared on its own in message
+ -- '?' -- ?? appeared in message
+ -- 'x' -- ?x? appeared in message
+ -- 'X' -- ?x? appeared in message (X is upper case of x)
+
Style : Boolean;
-- True if style message (starts with "(style)")
This patch implements the -gnatw.d switch to activate tagging of warning messages. With this switch set, warning messages will have a tag at the end which is one of: [-gnatw?] ? in a .. z [-gnatw.?] ? in a .. z [enabled by default] So, similar to the tags emitted by GCC for other languages. The patch enables the general mechanism (using new insertion tags ?? and ?x?). So far only a few messages have been tagged, but eventually we will tag as many warning messages as possible. The following source program is compiled with -gnatj.p.d -gnatj70: 1. function warndoc (a, b, c : integer) return integer is 2. x : string := %abc%; | >>> warning: use of "%" is an obsolescent feature (RM J.2(4)), use """ instead [-gnatwj] 3. begin 4. if b > 0 then | >>> warning: "return" statement missing following this statement, Program_Error may be raised at run time [enabled by default] 5. return warndoc (b, a, c); | >>> warning: actuals for this call may be in wrong order [-gnatw.p] 6. end if; 7. end; Tested on x86_64-pc-linux-gnu, committed on trunk 2013-01-02 Robert Dewar <dewar@adacore.com> * err_vars.ads (Warning_Doc_Switch): New flag. * errout.adb (Error_Msg_Internal): Implement new warning flag doc tag stuff (Set_Msg_Insertion_Warning): New procedure. * errout.ads: Document new insertion sequences ?? ?x? ?.x? * erroutc.adb (Output_Msg_Text): Handle ?? and ?x? warning doc tag stuff. * erroutc.ads (Warning_Msg_Char): New variable. (Warn_Chr): New field in error message object. * errutil.adb (Error_Msg): Set Warn_Chr in error message object. * sem_ch13.adb: Minor reformatting. * warnsw.adb: Add handling for -gnatw.d and -gnatw.D (Warning_Doc_Switch). * warnsw.ads: Add handling of -gnatw.d/.D switches (warning doc tag).