par.adb (Check_No_Right_Paren): Removed no longer used

2008-03-26  Robert Dewar  <dewar@adacore.com>

	* par.adb (Check_No_Right_Paren): Removed no longer used

	* par-ch10.adb (N_Pragma): Chars field removed, use Chars
	(Pragma_Identifier (..  instead.

	* par-ch10.adb (P_Subunit): Improvement in error recovery and message

	* par-tchk.adb, par-ch5.adb, par-ch6.adb, par-ch3.adb,
	par-ch4.adb: Minor improvements in error recovery and messages.

	* erroutc.adb (Test_Style_Warning_Serious_Msg): Treat style msgs as
	non-serious

	* par-ch9.adb: Minor improvements in error recovery and messages
	(P_Protected): Better error recovery for "protected type x;"

	* par-util.adb: Minor improvements in error recovery and messages
	(Check_No_Right_Paren): Removed no longer used

From-SVN: r133557

gcc/ada/erroutc.adb

@@ -1203,6 +1203,10 @@ package body Erroutc is
         (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) /= ''')

gcc/ada/par-ch10.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2008, 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- --
@@ -150,7 +150,7 @@ package body Ch10 is
          Item := P_Pragma;
 
          if Item = Error
-           or else Chars (Item) /= Name_Source_Reference
+           or else Pragma_Name (Item) /= Name_Source_Reference
          then
             Restore_Scan_State (Scan_State);
 
@@ -180,7 +180,8 @@ package body Ch10 is
          Item := P_Pragma;
 
          if Item = Error
-           or else not Is_Configuration_Pragma_Name (Chars (Item))
+           or else not
+             Is_Configuration_Pragma_Name (Pragma_Name (Item))
          then
             Restore_Scan_State (Scan_State);
             exit;
@@ -1024,10 +1025,7 @@ package body Ch10 is
       Set_Name (Subunit_Node, P_Qualified_Simple_Name);
       U_Right_Paren;
 
-      if Token = Tok_Semicolon then
-         Error_Msg_SC ("unexpected semicolon ignored");
-         Scan;
-      end if;
+      Ignore (Tok_Semicolon);
 
       if Token = Tok_Function or else Token = Tok_Procedure then
          Body_Node := P_Subprogram (Pf_Pbod);

gcc/ada/par-ch3.adb

@@ -1316,7 +1316,7 @@ package body Ch3 is
             Check_Misspelling_Of (Tok_Renames);
 
             if Token = Tok_Renames then
-               Error_Msg_SP ("extra "":"" ignored");
+               Error_Msg_SP ("|extra "":"" ignored");
                Scan; -- past RENAMES
                return True;
             else
@@ -2290,7 +2290,7 @@ package body Ch3 is
       --  Handle decimal fixed-point defn with DIGITS/DELTA in wrong order
 
       if Token = Tok_Delta then
-         Error_Msg_SC ("DELTA must come before DIGITS");
+         Error_Msg_SC ("|DELTA must come before DIGITS");
          Def_Node := New_Node (N_Decimal_Fixed_Point_Definition, Digits_Loc);
          Scan; -- past DELTA
          Set_Delta_Expression (Def_Node, P_Expression_No_Right_Paren);
@@ -3542,7 +3542,7 @@ package body Ch3 is
          else
             begin
                Expr_Node := P_Expression_Or_Range_Attribute;
-               Check_No_Right_Paren;
+               Ignore (Tok_Right_Paren);
 
                if Token = Tok_Colon
                  and then Nkind (Expr_Node) = N_Identifier
@@ -4176,7 +4176,7 @@ package body Ch3 is
                   --  Otherwise we saved the semicolon position, so complain
 
                   else
-                     Error_Msg (""";"" should be IS", SIS_Semicolon_Sloc);
+                     Error_Msg ("|"";"" should be IS", SIS_Semicolon_Sloc);
                   end if;
 
                   --  The next job is to fix up any declarations that occurred

gcc/ada/par-ch4.adb

@@ -32,9 +32,7 @@ with Stringt; use Stringt;
 separate (Par)
 package body Ch4 is
 
-   ---------------
-   -- Local map --
-   ---------------
+   --  Attributes that cannot have arguments
 
    Is_Parameterless_Attribute : constant Attribute_Class_Array :=
      (Attribute_Body_Version => True,
@@ -51,6 +49,14 @@ package body Ch4 is
    --  list because it may denote a slice operation (X'Img (1 .. 2)) or
    --  a type conversion (X'Class (Y)).
 
+   --  Note that this map designates the minimum set of attributes where a
+   --  construct in parentheses that is not an argument can appear right
+   --  after the attribute. For attributes like 'Size, we do not put them
+   --  in the map. If someone writes X'Size (3), that's illegal in any case,
+   --  but we get a better error message by parsing the (3) as an illegal
+   --  argument to the attribute, rather than some meaningless junk that
+   --  follows the attribute.
+
    -----------------------
    -- Local Subprograms --
    -----------------------
@@ -405,7 +411,7 @@ package body Ch4 is
             begin
                if Token_Is_At_Start_Of_Line then
                   Restore_Scan_State (Scan_State); -- to apostrophe
-                  Error_Msg_SC ("""''"" should be "";""");
+                  Error_Msg_SC ("|""''"" should be "";""");
                   Token := Tok_Semicolon;
                   return True;
                else
@@ -501,11 +507,12 @@ package body Ch4 is
             Set_Prefix (Name_Node, Prefix_Node);
             Set_Attribute_Name (Name_Node, Attr_Name);
 
-            --  Scan attribute arguments/designator
+            --  Scan attribute arguments/designator. We skip this if we know
+            --  that the attribute cannot have an argument.
 
             if Token = Tok_Left_Paren
-                 and then
-               not Is_Parameterless_Attribute (Get_Attribute_Id (Attr_Name))
+              and then not
+                Is_Parameterless_Attribute (Get_Attribute_Id (Attr_Name))
             then
                Set_Expressions (Name_Node, New_List);
                Scan; -- past left paren
@@ -1599,7 +1606,7 @@ package body Ch4 is
    function P_Expression_No_Right_Paren return Node_Id is
       Expr : constant Node_Id := P_Expression;
    begin
-      Check_No_Right_Paren;
+      Ignore (Tok_Right_Paren);
       return Expr;
    end P_Expression_No_Right_Paren;
 
@@ -2332,7 +2339,7 @@ package body Ch4 is
                   return P_Identifier;
 
                elsif Prev_Token = Tok_Comma then
-                  Error_Msg_SP ("extra "","" ignored");
+                  Error_Msg_SP ("|extra "","" ignored");
                   raise Error_Resync;
 
                else
@@ -2430,7 +2437,7 @@ package body Ch4 is
 
    begin
       if Token = Tok_Box then
-         Error_Msg_SC ("""'<'>"" should be ""/=""");
+         Error_Msg_SC ("|""'<'>"" should be ""/=""");
       end if;
 
       Op_Kind := Relop_Node (Token);

gcc/ada/par-ch5.adb

@@ -203,10 +203,7 @@ package body Ch5 is
       Statement_Required := SS_Flags.Sreq;
 
       loop
-         while Token = Tok_Semicolon loop
-            Error_Msg_SC ("unexpected semicolon ignored");
-            Scan; -- past junk semicolon
-         end loop;
+         Ignore (Tok_Semicolon);
 
          begin
             if Style_Check then
@@ -565,10 +562,7 @@ package body Ch5 is
 
                      --  Skip junk right parens in this context
 
-                     while Token = Tok_Right_Paren loop
-                        Error_Msg_SC ("extra right paren");
-                        Scan; -- past )
-                     end loop;
+                     Ignore (Tok_Right_Paren);
 
                      --  Check context following call
 
@@ -2200,7 +2194,7 @@ package body Ch5 is
       --  What we are interested in is whether it was a case of a bad IS.
 
       if Scope.Table (Scope.Last + 1).Etyp = E_Bad_Is then
-         Error_Msg ("IS should be "";""", Scope.Table (Scope.Last + 1).S_Is);
+         Error_Msg ("|IS should be "";""", Scope.Table (Scope.Last + 1).S_Is);
          Set_Bad_Is_Detected (Parent, True);
       end if;
 
@@ -2235,7 +2229,7 @@ package body Ch5 is
 
       if Token = Tok_And or else Token = Tok_Or then
          Error_Msg_SC ("unexpected logical operator");
-         Scan;
+         Scan; -- past logical operator
 
          if (Prev_Token = Tok_And and then Token = Tok_Then)
               or else

gcc/ada/par-ch6.adb

@@ -64,9 +64,8 @@ package body Ch6 is
 
          if Token = Tok_Return then
             Restore_Scan_State (Scan_State);
-            Error_Msg_SC ("unexpected semicolon ignored");
+            Error_Msg_SC ("|extra "";"" ignored");
             Scan; -- rescan past junk semicolon
-
          else
             Restore_Scan_State (Scan_State);
          end if;
@@ -265,11 +264,7 @@ package body Ch6 is
       end if;
 
       Scope.Table (Scope.Last).Labl := Name_Node;
-
-      if Token = Tok_Colon then
-         Error_Msg_SC ("redundant colon ignored");
-         Scan; -- past colon
-      end if;
+      Ignore (Tok_Colon);
 
       --  Deal with generic instantiation, the one case in which we do not
       --  have a subprogram specification as part of whatever we are parsing
@@ -411,6 +406,19 @@ package body Ch6 is
          Discard_Junk_Node (P_Expression);
       end if;
 
+      --  Deal with semicolon followed by IS. We want to treat this as IS
+
+      if Token = Tok_Semicolon then
+         Save_Scan_State (Scan_State);
+         Scan; -- past semicolon
+
+         if Token = Tok_Is then
+            Error_Msg_SP ("extra "";"" ignored");
+         else
+            Restore_Scan_State (Scan_State);
+         end if;
+      end if;
+
       --  Deal with case of semicolon ending a subprogram declaration
 
       if Token = Tok_Semicolon then
@@ -424,8 +432,8 @@ package body Ch6 is
          --  semicolon, and go process the body.
 
          if Token = Tok_Is then
-            Error_Msg_SP ("unexpected semicolon ignored");
-            T_Is; -- ignroe redundant IS's
+            Error_Msg_SP ("|extra "";"" ignored");
+            T_Is; -- scan past IS
             goto Subprogram_Body;
 
          --  If BEGIN follows in an appropriate column, we immediately
@@ -436,7 +444,7 @@ package body Ch6 is
          elsif Token = Tok_Begin
             and then Start_Column >= Scope.Table (Scope.Last).Ecol
          then
-            Error_Msg_SP (""";"" should be IS!");
+            Error_Msg_SP ("|"";"" should be IS!");
             goto Subprogram_Body;
 
          else
@@ -540,7 +548,7 @@ package body Ch6 is
          --  semicolon which should really be an IS
 
          else
-            Error_Msg_AP ("missing "";""");
+            Error_Msg_AP ("|missing "";""");
             SIS_Missing_Semicolon_Message := Get_Msg_Id;
             goto Subprogram_Declaration;
          end if;
@@ -1203,7 +1211,7 @@ package body Ch6 is
             --  that semicolon should have been a right parenthesis and exit
 
             if Token = Tok_Is or else Token = Tok_Return then
-               Error_Msg_SP ("expected "")"" in place of "";""");
+               Error_Msg_SP ("|"";"" should be "")""");
                exit Specification_Loop;
             end if;
 

gcc/ada/par-ch9.adb

@@ -154,7 +154,7 @@ package body Ch9 is
             Scan; -- past semicolon
 
             if Token = Tok_Entry then
-               Error_Msg_SP (""";"" should be IS");
+               Error_Msg_SP ("|"";"" should be IS");
                Set_Task_Definition (Task_Node, P_Task_Definition);
             else
                Pop_Scope_Stack; -- Remove unused entry
@@ -371,6 +371,7 @@ package body Ch9 is
       Name_Node      : Node_Id;
       Protected_Node : Node_Id;
       Protected_Sloc : Source_Ptr;
+      Scan_State     : Saved_Scan_State;
 
    begin
       Push_Scope_Stack;
@@ -439,6 +440,35 @@ package body Ch9 is
             Scope.Table (Scope.Last).Labl := Name_Node;
          end if;
 
+         --  Check for semicolon not followed by IS, this is something like
+
+         --    protected type r;
+
+         --  where we want
+
+         --    protected type r IS END;
+
+         if Token = Tok_Semicolon then
+            Save_Scan_State (Scan_State); -- at semicolon
+            Scan; -- past semicolon
+
+            if Token /= Tok_Is then
+               Restore_Scan_State (Scan_State);
+               Error_Msg_SC ("missing IS");
+               Set_Protected_Definition (Protected_Node,
+                 Make_Protected_Definition (Token_Ptr,
+                   Visible_Declarations => Empty_List,
+                   End_Label           => Empty));
+
+               SIS_Entry_Active := False;
+               End_Statements (Protected_Definition (Protected_Node));
+               Scan; -- past semicolon
+               return Protected_Node;
+            end if;
+
+            Error_Msg_SP ("|extra ""("" ignored");
+         end if;
+
          T_Is;
 
          --  Ada 2005 (AI-345)
@@ -1081,7 +1111,7 @@ package body Ch9 is
          Bnode := P_Expression_No_Right_Paren;
 
          if Token = Tok_Colon_Equal then
-            Error_Msg_SC (""":="" should be ""=""");
+            Error_Msg_SC ("|"":="" should be ""=""");
             Scan;
             Bnode := P_Expression_No_Right_Paren;
          end if;

gcc/ada/par-tchk.adb

@@ -83,11 +83,11 @@ package body Tchk is
       --  A little recovery helper, accept then in place of =>
 
       elsif Token = Tok_Then then
-         Error_Msg_BC ("missing ""='>""");
+         Error_Msg_BC ("|THEN should be ""='>""");
          Scan; -- past THEN used in place of =>
 
       elsif Token = Tok_Colon_Equal then
-         Error_Msg_SC (""":="" should be ""='>""");
+         Error_Msg_SC ("|"":="" should be ""='>""");
          Scan; -- past := used in place of =>
 
       else
@@ -149,15 +149,15 @@ package body Tchk is
          Scan;
 
       elsif Token = Tok_Equal then
-         Error_Msg_SC ("""="" should be "":=""");
+         Error_Msg_SC ("|""="" should be "":=""");
          Scan;
 
       elsif Token = Tok_Colon then
-         Error_Msg_SC (""":"" should be "":=""");
+         Error_Msg_SC ("|"":"" should be "":=""");
          Scan;
 
       elsif Token = Tok_Is then
-         Error_Msg_SC ("IS should be "":=""");
+         Error_Msg_SC ("|IS should be "":=""");
          Scan;
 
       else
@@ -257,25 +257,39 @@ package body Tchk is
 
    procedure T_Is is
    begin
+      Ignore (Tok_Semicolon);
+
+      --  If we have IS scan past it
+
       if Token = Tok_Is then
          Scan;
 
+         --  And ignore any following semicolons
+
          Ignore (Tok_Semicolon);
 
       --  Allow OF, => or = to substitute for IS with complaint
 
-      elsif Token = Tok_Arrow
-        or else Token = Tok_Of
-        or else Token = Tok_Equal
-      then
-         Error_Msg_SC ("missing IS");
-         Scan; -- token used in place of IS
+      elsif Token = Tok_Arrow then
+         Error_Msg_SC ("|""=>"" should be IS");
+         Scan; -- past =>
+
+      elsif Token = Tok_Of then
+         Error_Msg_SC ("|OF should be IS");
+         Scan; -- past OF
+
+      elsif Token = Tok_Equal then
+         Error_Msg_SC ("|""="" should be IS");
+         Scan; -- past =
+
       else
          Wrong_Token (Tok_Is, AP);
       end if;
 
+      --  Ignore extra IS keywords
+
       while Token = Tok_Is loop
-         Error_Msg_SC ("extra IS ignored");
+         Error_Msg_SC ("|extra IS ignored");
          Scan;
       end loop;
    end T_Is;
@@ -379,7 +393,7 @@ package body Tchk is
       if Token = Tok_Right_Paren then
          Scan;
       else
-         Error_Msg_AP ("missing "")""");
+         Error_Msg_AP ("|missing "")""");
       end if;
    end T_Right_Paren;
 
@@ -394,24 +408,24 @@ package body Tchk is
          Scan;
 
          if Token = Tok_Semicolon then
-            Error_Msg_SC ("extra "";"" ignored");
+            Error_Msg_SC ("|extra "";"" ignored");
             Scan;
          end if;
 
          return;
 
       elsif Token = Tok_Colon then
-         Error_Msg_SC (""":"" should be "";""");
+         Error_Msg_SC ("|"":"" should be "";""");
          Scan;
          return;
 
       elsif Token = Tok_Comma then
-         Error_Msg_SC (""","" should be "";""");
+         Error_Msg_SC ("|"","" should be "";""");
          Scan;
          return;
 
       elsif Token = Tok_Dot then
-         Error_Msg_SC ("""."" should be "";""");
+         Error_Msg_SC ("|""."" should be "";""");
          Scan;
          return;
 
@@ -434,7 +448,7 @@ package body Tchk is
          return;
 
       --  Deal with pragma. If pragma is not at start of line, it is considered
-      --  misplaced otherwise we treat it as a normal missing semicolong case.
+      --  misplaced otherwise we treat it as a normal missing semicolon case.
 
       elsif Token = Tok_Pragma
         and then not Token_Is_At_Start_Of_Line
@@ -812,7 +826,7 @@ package body Tchk is
       if Token = Tok_Right_Paren then
          Scan;
       else
-         Error_Msg_AP ("missing "")""!");
+         Error_Msg_AP ("|missing "")""!");
       end if;
    end U_Right_Paren;
 
@@ -831,7 +845,7 @@ package body Tchk is
          Scan;
 
          if Token = T then
-            Error_Msg_SP ("extra "";"" ignored");
+            Error_Msg_SP ("|extra "";"" ignored");
             Scan;
          else
             Error_Msg_SP (M);
@@ -841,7 +855,7 @@ package body Tchk is
          Scan;
 
          if Token = T then
-            Error_Msg_SP ("extra "","" ignored");
+            Error_Msg_SP ("|extra "","" ignored");
             Scan;
 
          else

gcc/ada/par-util.adb

@@ -109,7 +109,7 @@ package body Util is
         and then S = Name_Buffer (1 .. SL)
       then
          Scan_Ptr := Token_Ptr + S'Length;
-         Error_Msg_S ("missing space");
+         Error_Msg_S ("|missing space");
          Token := T;
          return True;
       end if;
@@ -176,18 +176,6 @@ package body Util is
       end if;
    end Check_Misspelling_Of;
 
-   --------------------------
-   -- Check_No_Right_Paren --
-   --------------------------
-
-   procedure Check_No_Right_Paren is
-   begin
-      if Token = Tok_Right_Paren then
-         Error_Msg_SC ("unexpected right parenthesis");
-         Scan; -- past unexpected right paren
-      end if;
-   end Check_No_Right_Paren;
-
    -----------------------------
    -- Check_Simple_Expression --
    -----------------------------
@@ -343,7 +331,7 @@ package body Util is
 
          <<Assume_Comma>>
             Restore_Scan_State (Scan_State);
-            Error_Msg_SC (""";"" illegal here, replaced by "",""");
+            Error_Msg_SC ("|"";"" should be "",""");
             Scan; -- past the semicolon
             return True;
 
@@ -391,38 +379,33 @@ package body Util is
 
    procedure Ignore (T : Token_Type) is
    begin
-      if Token = T then
+      while Token = T loop
          if T = Tok_Comma then
-            Error_Msg_SC ("unexpected "","" ignored");
+            Error_Msg_SC ("|extra "","" ignored");
 
          elsif T = Tok_Left_Paren then
-            Error_Msg_SC ("unexpected ""("" ignored");
+            Error_Msg_SC ("|extra ""("" ignored");
 
          elsif T = Tok_Right_Paren then
-            Error_Msg_SC ("unexpected "")"" ignored");
+            Error_Msg_SC ("|extra "")"" ignored");
 
          elsif T = Tok_Semicolon then
-            Error_Msg_SC ("unexpected "";"" ignored");
+            Error_Msg_SC ("|extra "";"" ignored");
+
+         elsif T = Tok_Colon then
+            Error_Msg_SC ("|extra "":"" ignored");
 
          else
             declare
                Tname : constant String := Token_Type'Image (Token);
-               Msg   : String := "unexpected keyword ????????????????????????";
-
             begin
-               --  Loop to copy characters of keyword name (ignoring Tok_)
-
-               for J in 5 .. Tname'Last loop
-                  Msg (J + 14) := Fold_Upper (Tname (J));
-               end loop;
-
-               Msg (Tname'Last + 15 .. Tname'Last + 22) := " ignored";
-               Error_Msg_SC (Msg (1 .. Tname'Last + 22));
+               Error_Msg_SC
+                 ("|extra " & Tname (5 .. Tname'Last) & "ignored");
             end;
          end if;
 
          Scan; -- Scan past ignored token
-      end if;
+      end loop;
    end Ignore;
 
    ----------------------------
@@ -438,7 +421,6 @@ package body Util is
          declare
             Ident_Casing : constant Casing_Type :=
                              Identifier_Casing (Current_Source_File);
-
             Key_Casing   : constant Casing_Type :=
                              Keyword_Casing (Current_Source_File);
 

gcc/ada/par.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2008, 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- --
@@ -1050,10 +1050,6 @@ is
       --  it is returned unchanged. Otherwise an error message is issued
       --  and Error is returned.
 
-      procedure Check_No_Right_Paren;
-      --  Called to check that the current token is not a right paren. If it
-      --  is, then an error is given, and the right parenthesis is scanned out.
-
       function Comma_Present return Boolean;
       --  Used in comma delimited lists to determine if a comma is present, or
       --  can reasonably be assumed to have been present (an error message is
@@ -1256,10 +1252,10 @@ begin
 
                   --  Give error if bad pragma
 
-                  if not Is_Configuration_Pragma_Name (Chars (P_Node))
-                    and then Chars (P_Node) /= Name_Source_Reference
+                  if not Is_Configuration_Pragma_Name (Pragma_Name (P_Node))
+                    and then Pragma_Name (P_Node) /= Name_Source_Reference
                   then
-                     if Is_Pragma_Name (Chars (P_Node)) then
+                     if Is_Pragma_Name (Pragma_Name (P_Node)) then
                         Error_Msg_N
                           ("only configuration pragmas allowed " &
                            "in configuration file", P_Node);