From 3b8d33ef1d3979b83e0085ab8a87b06b48399441 Mon Sep 17 00:00:00 2001 From: Robert Dewar Date: Wed, 26 Mar 2008 08:37:49 +0100 Subject: [PATCH] par.adb (Check_No_Right_Paren): Removed no longer used 2008-03-26 Robert Dewar * 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 | 6 ++++- gcc/ada/par-ch10.adb | 12 ++++------ gcc/ada/par-ch3.adb | 8 +++---- gcc/ada/par-ch4.adb | 27 +++++++++++++-------- gcc/ada/par-ch5.adb | 14 ++++------- gcc/ada/par-ch6.adb | 32 +++++++++++++++---------- gcc/ada/par-ch9.adb | 34 +++++++++++++++++++++++++-- gcc/ada/par-tchk.adb | 56 +++++++++++++++++++++++++++----------------- gcc/ada/par-util.adb | 44 ++++++++++------------------------ gcc/ada/par.adb | 12 ++++------ 10 files changed, 139 insertions(+), 106 deletions(-) diff --git a/gcc/ada/erroutc.adb b/gcc/ada/erroutc.adb index 6f928b02c28..383f0189bc3 100644 --- a/gcc/ada/erroutc.adb +++ b/gcc/ada/erroutc.adb @@ -1201,7 +1201,11 @@ package body Erroutc is Is_Style_Msg := (Msg'Length > 7 - and then Msg (Msg'First .. Msg'First + 6) = "(style)"); + 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) = '?' diff --git a/gcc/ada/par-ch10.adb b/gcc/ada/par-ch10.adb index 8fad13e3532..0a31616351e 100644 --- a/gcc/ada/par-ch10.adb +++ b/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); diff --git a/gcc/ada/par-ch3.adb b/gcc/ada/par-ch3.adb index 10c3c85ff44..7889cd85a93 100644 --- a/gcc/ada/par-ch3.adb +++ b/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 diff --git a/gcc/ada/par-ch4.adb b/gcc/ada/par-ch4.adb index 0db6d20a2ba..93c8f9ea988 100644 --- a/gcc/ada/par-ch4.adb +++ b/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); diff --git a/gcc/ada/par-ch5.adb b/gcc/ada/par-ch5.adb index 577a6c0d93b..a2318406a7e 100644 --- a/gcc/ada/par-ch5.adb +++ b/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 diff --git a/gcc/ada/par-ch6.adb b/gcc/ada/par-ch6.adb index b2ae242c517..2fc0ace4945 100644 --- a/gcc/ada/par-ch6.adb +++ b/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; diff --git a/gcc/ada/par-ch9.adb b/gcc/ada/par-ch9.adb index 453b9ab69f8..241b2db54ef 100644 --- a/gcc/ada/par-ch9.adb +++ b/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; diff --git a/gcc/ada/par-tchk.adb b/gcc/ada/par-tchk.adb index 3d45932c49f..3ec1a2bea06 100644 --- a/gcc/ada/par-tchk.adb +++ b/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 diff --git a/gcc/ada/par-util.adb b/gcc/ada/par-util.adb index e4b690f1788..98f66c66ab8 100644 --- a/gcc/ada/par-util.adb +++ b/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 <> 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); diff --git a/gcc/ada/par.adb b/gcc/ada/par.adb index e75051002eb..016d5024846 100644 --- a/gcc/ada/par.adb +++ b/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); -- 2.30.2