* [COMMITTED] ada: Add tags on style messages
@ 2023-05-16 8:40 Marc Poulhiès
0 siblings, 0 replies; only message in thread
From: Marc Poulhiès @ 2023-05-16 8:40 UTC (permalink / raw)
To: gcc-patches; +Cc: Arnaud Charlet
From: Arnaud Charlet <charlet@adacore.com>
Similar to tags on warnings [-gnatwx], we add tags on style messages
[-gnatyx] when -gnatw.d is enabled.
gcc/ada/
* errout.ads: Update comment.
* errout.adb (Skip_Msg_Insertion_Warning): Update to take e.g.
-gnatyM into account.
* erroutc.adb (Get_Warning_Option, Get_Warning_Tag)
(Prescan_Message): Add support for Style tags.
* par-ch5.adb, par-ch6.adb, par-ch7.adb, par-endh.adb,
par-util.adb, style.adb, styleg.adb: Set tag on all style
messages.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/errout.adb | 3 ++-
gcc/ada/errout.ads | 6 ++---
gcc/ada/erroutc.adb | 37 +++++++++++++++++----------
gcc/ada/par-ch5.adb | 4 +--
gcc/ada/par-ch6.adb | 2 +-
gcc/ada/par-ch7.adb | 2 +-
gcc/ada/par-endh.adb | 2 +-
gcc/ada/par-util.adb | 4 +--
gcc/ada/style.adb | 18 +++++++-------
gcc/ada/styleg.adb | 59 ++++++++++++++++++++++----------------------
10 files changed, 75 insertions(+), 62 deletions(-)
diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb
index 96b56ffc57a..49281fdb05f 100644
--- a/gcc/ada/errout.adb
+++ b/gcc/ada/errout.adb
@@ -3976,7 +3976,8 @@ package body Errout is
P := P + 1;
elsif P < Text'Last and then Text (P + 1) = C
- and then Text (P) in 'a' .. 'z' | '*' | '$'
+ and then Text (P) in 'a' .. 'z' | 'A' .. 'Z' |
+ '0' .. '9' | '*' | '$'
then
P := P + 2;
diff --git a/gcc/ada/errout.ads b/gcc/ada/errout.ads
index 1e099614325..f152839678d 100644
--- a/gcc/ada/errout.ads
+++ b/gcc/ada/errout.ads
@@ -307,9 +307,9 @@ package Errout is
-- Insertion character ?x? ?.x? ?_x? (warning with switch)
-- "x" is a (lower-case) warning switch character.
-- Like ??, but if the flag Warn_Doc_Switch is True, adds the string
- -- "[-gnatwx]", "[-gnatw.x]", or "[-gnatw_x]", at the end of the
- -- warning message. For continuations, use this on each continuation
- -- message.
+ -- "[-gnatwx]", "[-gnatw.x]", "[-gnatw_x]", or "[-gnatyx]" (for style
+ -- messages), at the end of the warning message. 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
diff --git a/gcc/ada/erroutc.adb b/gcc/ada/erroutc.adb
index 291a340ef6e..e5caeba6802 100644
--- a/gcc/ada/erroutc.adb
+++ b/gcc/ada/erroutc.adb
@@ -367,17 +367,25 @@ package body Erroutc is
function Get_Warning_Option (Id : Error_Msg_Id) return String is
Warn : constant Boolean := Errors.Table (Id).Warn;
+ Style : constant Boolean := Errors.Table (Id).Style;
Warn_Chr : constant String (1 .. 2) := Errors.Table (Id).Warn_Chr;
+
begin
- if Warn and then Warn_Chr /= " " and then Warn_Chr (1) /= '?' then
+ if (Warn or Style)
+ and then Warn_Chr /= " "
+ and then Warn_Chr (1) /= '?'
+ then
if Warn_Chr = "$ " then
return "-gnatel";
+ elsif Style then
+ return "-gnaty" & Warn_Chr (1);
elsif Warn_Chr (2) = ' ' then
return "-gnatw" & Warn_Chr (1);
else
return "-gnatw" & Warn_Chr;
end if;
end if;
+
return "";
end Get_Warning_Option;
@@ -387,10 +395,12 @@ package body Erroutc is
function Get_Warning_Tag (Id : Error_Msg_Id) return String is
Warn : constant Boolean := Errors.Table (Id).Warn;
+ Style : constant Boolean := Errors.Table (Id).Style;
Warn_Chr : constant String (1 .. 2) := Errors.Table (Id).Warn_Chr;
Option : constant String := Get_Warning_Option (Id);
+
begin
- if Warn then
+ if Warn or Style then
if Warn_Chr = "? " then
return "[enabled by default]";
elsif Warn_Chr = "* " then
@@ -880,7 +890,7 @@ package body Erroutc is
J := J + 1;
elsif J < Msg'Last and then Msg (J + 1) = C
- and then Msg (J) in 'a' .. 'z' | '*' | '$'
+ and then Msg (J) in 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '*' | '$'
then
Message_Class := Msg (J) & " ";
J := J + 2;
@@ -964,19 +974,20 @@ package body Erroutc is
-- Warning message (? or < insertion sequence)
elsif Msg (J) = '?' or else Msg (J) = '<' then
- Is_Warning_Msg := Msg (J) = '?' or else Error_Msg_Warn;
- J := J + 1;
-
- if Is_Warning_Msg then
+ if Msg (J) = '?' or else Error_Msg_Warn then
+ Is_Warning_Msg := not Is_Style_Msg;
+ J := J + 1;
Warning_Msg_Char := Parse_Message_Class;
- end if;
- -- Bomb if untagged warning message. This code can be uncommented
- -- for debugging when looking for untagged warning messages.
+ -- Bomb if untagged warning message. This code can be
+ -- uncommented for debugging when looking for untagged warning
+ -- messages.
+
+ -- pragma Assert (Warning_Msg_Char /= " ");
- -- if Is_Warning_Msg and then Warning_Msg_Char = ' ' then
- -- raise Program_Error;
- -- end if;
+ else
+ J := J + 1;
+ end if;
-- Unconditional message (! insertion)
diff --git a/gcc/ada/par-ch5.adb b/gcc/ada/par-ch5.adb
index 418547b1cea..be821f775ba 100644
--- a/gcc/ada/par-ch5.adb
+++ b/gcc/ada/par-ch5.adb
@@ -1196,7 +1196,7 @@ package body Ch5 is
and then Start_Column /= Scopes (Scope.Last).Ecol
then
Error_Msg_Col := Scopes (Scope.Last).Ecol;
- Error_Msg_SC ("(style) this token should be@");
+ Error_Msg_SC ("(style) this token should be@?l?");
end if;
end Check_If_Column;
@@ -2206,7 +2206,7 @@ package body Ch5 is
and then Token_Is_At_Start_Of_Line
and then Start_Column /= Error_Msg_Col
then
- Error_Msg_SC ("(style) BEGIN in wrong column, should be@");
+ Error_Msg_SC ("(style) BEGIN in wrong column, should be@?l?");
else
Scopes (Scope.Last).Ecol := Start_Column;
diff --git a/gcc/ada/par-ch6.adb b/gcc/ada/par-ch6.adb
index 2de8cee93b1..3171c5c3ce1 100644
--- a/gcc/ada/par-ch6.adb
+++ b/gcc/ada/par-ch6.adb
@@ -1713,7 +1713,7 @@ package body Ch6 is
if Style.Mode_In_Check and then Token /= Tok_Out then
Error_Msg_SP -- CODEFIX
- ("(style) IN should be omitted");
+ ("(style) IN should be omitted?I?");
end if;
-- Since Ada 2005, formal objects can have an anonymous access type,
diff --git a/gcc/ada/par-ch7.adb b/gcc/ada/par-ch7.adb
index ae02298e049..e8a765bbac1 100644
--- a/gcc/ada/par-ch7.adb
+++ b/gcc/ada/par-ch7.adb
@@ -261,7 +261,7 @@ package body Ch7 is
and then Start_Column /= Error_Msg_Col
then
Error_Msg_SC
- ("(style) PRIVATE in wrong column, should be@");
+ ("(style) PRIVATE in wrong column, should be@?l?");
end if;
end if;
diff --git a/gcc/ada/par-endh.adb b/gcc/ada/par-endh.adb
index 5ca5004e1ee..56275bf1cab 100644
--- a/gcc/ada/par-endh.adb
+++ b/gcc/ada/par-endh.adb
@@ -1131,7 +1131,7 @@ package body Endh is
then
Error_Msg_Col := Scopes (Scope.Last).Ecol;
Error_Msg
- ("(style) END in wrong column, should be@", End_Sloc);
+ ("(style) END in wrong column, should be@?l?", End_Sloc);
end if;
end if;
diff --git a/gcc/ada/par-util.adb b/gcc/ada/par-util.adb
index b1085c847dc..fc44ddf2508 100644
--- a/gcc/ada/par-util.adb
+++ b/gcc/ada/par-util.adb
@@ -165,7 +165,7 @@ package body Util is
and then Start_Column <= Scopes (Scope.Last).Ecol
then
Error_Msg_BC -- CODEFIX
- ("(style) incorrect layout");
+ ("(style) incorrect layout?l?");
end if;
end Check_Bad_Layout;
@@ -713,7 +713,7 @@ package body Util is
and then Scope.Last = Style_Max_Nesting_Level + 1
then
Error_Msg
- ("(style) maximum nesting level exceeded",
+ ("(style) maximum nesting level exceeded?L?",
First_Non_Blank_Location);
end if;
diff --git a/gcc/ada/style.adb b/gcc/ada/style.adb
index dda5cd47c06..e21730bb49d 100644
--- a/gcc/ada/style.adb
+++ b/gcc/ada/style.adb
@@ -67,7 +67,7 @@ package body Style is
end;
end if;
- Error_Msg_N ("(style) subprogram body has no previous spec", N);
+ Error_Msg_N ("(style) subprogram body has no previous spec?s?", N);
end if;
end Body_With_No_Spec;
@@ -84,11 +84,11 @@ package body Style is
if Style_Check_Array_Attribute_Index then
if D = 1 and then Present (E1) then
Error_Msg_N -- CODEFIX
- ("(style) index number not allowed for one dimensional array",
+ ("(style) index number not allowed for one dimensional array?A?",
E1);
elsif D > 1 and then No (E1) then
Error_Msg_N -- CODEFIX
- ("(style) index number required for multi-dimensional array",
+ ("(style) index number required for multi-dimensional array?A?",
N);
end if;
end if;
@@ -167,7 +167,7 @@ package body Style is
Error_Msg_Node_1 := Def;
Error_Msg_Sloc := Sloc (Def);
Error_Msg -- CODEFIX
- ("(style) bad casing of & declared#", Sref, Ref);
+ ("(style) bad casing of & declared#?r?", Sref, Ref);
return;
end if;
@@ -249,7 +249,7 @@ package body Style is
Set_Casing (Cas);
Error_Msg_Name_1 := Name_Enter;
Error_Msg_N -- CODEFIX
- ("(style) bad casing of %% declared in Standard", Ref);
+ ("(style) bad casing of %% declared in Standard?n?", Ref);
end if;
end if;
end if;
@@ -293,16 +293,16 @@ package body Style is
if Nkind (N) = N_Subprogram_Body then
Error_Msg_NE -- CODEFIX
- ("(style) missing OVERRIDING indicator in body of&", N, E);
+ ("(style) missing OVERRIDING indicator in body of&?O?", N, E);
elsif Nkind (N) = N_Abstract_Subprogram_Declaration then
Error_Msg_NE -- CODEFIX
- ("(style) missing OVERRIDING indicator in declaration of&",
+ ("(style) missing OVERRIDING indicator in declaration of&?O?",
Specification (N), E);
else
Error_Msg_NE -- CODEFIX
- ("(style) missing OVERRIDING indicator in declaration of&",
+ ("(style) missing OVERRIDING indicator in declaration of&?O?",
Nod, E);
end if;
end if;
@@ -316,7 +316,7 @@ package body Style is
begin
if Style_Check_Order_Subprograms then
Error_Msg_N -- CODEFIX
- ("(style) subprogram body& not in alphabetical order", Name);
+ ("(style) subprogram body& not in alphabetical order?o?", Name);
end if;
end Subprogram_Not_In_Alpha_Order;
end Style;
diff --git a/gcc/ada/styleg.adb b/gcc/ada/styleg.adb
index 045842bd7b0..0bb406fb9bb 100644
--- a/gcc/ada/styleg.adb
+++ b/gcc/ada/styleg.adb
@@ -173,7 +173,7 @@ package body Styleg is
if Style_Check_Attribute_Casing then
if Determine_Token_Casing /= Mixed_Case then
Error_Msg_SC -- CODEFIX
- ("(style) bad capitalization, mixed case required");
+ ("(style) bad capitalization, mixed case required?a?");
end if;
end if;
end Check_Attribute_Name;
@@ -263,10 +263,10 @@ package body Styleg is
elsif Nkind (Orig) = N_Op_And then
Error_Msg -- CODEFIX
- ("(style) `AND THEN` required", Sloc (Orig));
+ ("(style) `AND THEN` required?B?", Sloc (Orig));
else
Error_Msg -- CODEFIX
- ("(style) `OR ELSE` required", Sloc (Orig));
+ ("(style) `OR ELSE` required?B?", Sloc (Orig));
end if;
end;
end if;
@@ -506,7 +506,7 @@ package body Styleg is
and then Source (Scan_Ptr - 1) > ' '
then
Error_Msg_S -- CODEFIX
- ("(style) space required");
+ ("(style) space required?c?");
end if;
end if;
@@ -520,7 +520,7 @@ package body Styleg is
and then not Is_Special_Character (Source (Scan_Ptr + 2))
then
Error_Msg -- CODEFIX
- ("(style) space required", Scan_Ptr + 2);
+ ("(style) space required?c?", Scan_Ptr + 2);
end if;
end if;
@@ -537,7 +537,7 @@ package body Styleg is
and then not Same_Column_As_Previous_Line
then
Error_Msg_S -- CODEFIX
- ("(style) bad column");
+ ("(style) bad column?0?");
end if;
return;
@@ -583,7 +583,7 @@ package body Styleg is
Error_Space_Required (Scan_Ptr + 2);
else
Error_Msg -- CODEFIX
- ("(style) two spaces required", Scan_Ptr + 2);
+ ("(style) two spaces required?c?", Scan_Ptr + 2);
end if;
return;
@@ -624,7 +624,7 @@ package body Styleg is
| All_Upper_Case
=>
Error_Msg_SC -- CODEFIX
- ("(style) bad capitalization, mixed case required");
+ ("(style) bad capitalization, mixed case required?D?");
-- The Unknown case is something like A_B_C, which is both all
-- caps and mixed case.
@@ -665,12 +665,12 @@ package body Styleg is
if Blank_Lines = 2 then
Error_Msg -- CODEFIX
- ("(style) blank line not allowed at end of file",
+ ("(style) blank line not allowed at end of file?u?",
Blank_Line_Location);
elsif Blank_Lines >= 3 then
Error_Msg -- CODEFIX
- ("(style) blank lines not allowed at end of file",
+ ("(style) blank lines not allowed at end of file?u?",
Blank_Line_Location);
end if;
end if;
@@ -697,7 +697,7 @@ package body Styleg is
begin
if Style_Check_Horizontal_Tabs then
Error_Msg_S -- CODEFIX
- ("(style) horizontal tab not allowed");
+ ("(style) horizontal tab not allowed?h?");
end if;
end Check_HT;
@@ -716,7 +716,7 @@ package body Styleg is
and then Start_Column rem Style_Check_Indentation /= 0
then
Error_Msg_SC -- CODEFIX
- ("(style) bad indentation");
+ ("(style) bad indentation?0?");
end if;
end if;
end Check_Indentation;
@@ -755,7 +755,7 @@ package body Styleg is
if Style_Check_Max_Line_Length then
if Len > Style_Max_Line_Length then
Error_Msg
- ("(style) this line is too long",
+ ("(style) this line is too long?M?",
Current_Line_Start + Source_Ptr (Style_Max_Line_Length));
end if;
end if;
@@ -792,10 +792,10 @@ package body Styleg is
if Style_Check_Form_Feeds then
if Source (Scan_Ptr) = ASCII.FF then
Error_Msg_S -- CODEFIX
- ("(style) form feed not allowed");
+ ("(style) form feed not allowed?f?");
elsif Source (Scan_Ptr) = ASCII.VT then
Error_Msg_S -- CODEFIX
- ("(style) vertical tab not allowed");
+ ("(style) vertical tab not allowed?f?");
end if;
end if;
@@ -813,7 +813,7 @@ package body Styleg is
-- Bad terminator if we don't have an LF
elsif Source (Scan_Ptr) /= LF then
- Error_Msg_S ("(style) incorrect line terminator");
+ Error_Msg_S ("(style) incorrect line terminator?d?");
end if;
end if;
@@ -829,7 +829,7 @@ package body Styleg is
if Style_Check_Blanks_At_End and then L < Len then
Error_Msg -- CODEFIX
- ("(style) trailing spaces not permitted", S);
+ ("(style) trailing spaces not permitted?b?", S);
end if;
-- Deal with empty (blank) line
@@ -851,7 +851,7 @@ package body Styleg is
else
if Style_Check_Blank_Lines and then Blank_Lines > 1 then
Error_Msg -- CODEFIX
- ("(style) multiple blank lines", Blank_Line_Location);
+ ("(style) multiple blank lines?u?", Blank_Line_Location);
end if;
-- And reset blank line count
@@ -873,7 +873,8 @@ package body Styleg is
or else Token_Ptr - Prev_Token_Ptr /= 4
then -- CODEFIX?
Error_Msg
- ("(style) single space must separate NOT and IN", Token_Ptr - 1);
+ ("(style) single space must separate NOT and IN?t?",
+ Token_Ptr - 1);
end if;
end if;
end Check_Not_In;
@@ -933,7 +934,7 @@ package body Styleg is
if Style_Check_Pragma_Casing then
if Determine_Token_Casing /= Mixed_Case then
Error_Msg_SC -- CODEFIX
- ("(style) bad capitalization, mixed case required");
+ ("(style) bad capitalization, mixed case required?p?");
end if;
end if;
end Check_Pragma_Name;
@@ -1043,10 +1044,10 @@ package body Styleg is
else
if Token = Tok_Then then
Error_Msg -- CODEFIX
- ("(style) no statements may follow THEN on same line", S);
+ ("(style) no statements may follow THEN on same line?S?", S);
else
Error_Msg
- ("(style) no statements may follow ELSE on same line", S);
+ ("(style) no statements may follow ELSE on same line?S?", S);
end if;
end if;
end Check_Separate_Stmt_Lines_Cont;
@@ -1071,7 +1072,7 @@ package body Styleg is
if If_Line = Then_Line then
null;
elsif Token_Ptr /= First_Non_Blank_Location then
- Error_Msg_SC ("(style) misplaced THEN");
+ Error_Msg_SC ("(style) misplaced THEN?i?");
end if;
end;
end if;
@@ -1121,7 +1122,7 @@ package body Styleg is
begin
if Style_Check_Xtra_Parens then
Error_Msg -- CODEFIX
- ("(style) redundant parentheses", Loc);
+ ("(style) redundant parentheses?x?", Loc);
end if;
end Check_Xtra_Parens;
@@ -1141,7 +1142,7 @@ package body Styleg is
procedure Error_Space_Not_Allowed (S : Source_Ptr) is
begin
Error_Msg -- CODEFIX
- ("(style) space not allowed", S);
+ ("(style) space not allowed?t?", S);
end Error_Space_Not_Allowed;
--------------------------
@@ -1151,7 +1152,7 @@ package body Styleg is
procedure Error_Space_Required (S : Source_Ptr) is
begin
Error_Msg -- CODEFIX
- ("(style) space required", S);
+ ("(style) space required?t?", S);
end Error_Space_Required;
--------------------
@@ -1184,7 +1185,7 @@ package body Styleg is
if Style_Check_End_Labels then
Error_Msg_Node_1 := Name;
Error_Msg_SP -- CODEFIX
- ("(style) `END &` required");
+ ("(style) `END &` required?e?");
end if;
end No_End_Name;
@@ -1200,7 +1201,7 @@ package body Styleg is
if Style_Check_End_Labels then
Error_Msg_Node_1 := Name;
Error_Msg_SP -- CODEFIX
- ("(style) `EXIT &` required");
+ ("(style) `EXIT &` required?e?");
end if;
end No_Exit_Name;
@@ -1216,7 +1217,7 @@ package body Styleg is
begin
if Style_Check_Keyword_Casing then
Error_Msg_SC -- CODEFIX
- ("(style) reserved words must be all lower case");
+ ("(style) reserved words must be all lower case?k?");
end if;
end Non_Lower_Case_Keyword;
--
2.40.0
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2023-05-16 8:40 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2023-05-16 8:40 [COMMITTED] ada: Add tags on style messages Marc Poulhiès
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).