ada: Add tags on style messages

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.

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;