Skip to content

R
riscv-gcc-1
Commit 3b8d33ef by Robert Dewar Committed by Arnaud Charlet
Options

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
parent 14f1ec15
Showing with 139 additions and 106 deletions
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) = '?'
......
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);
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment