mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-05 05:10:33 +08:00
Code Issues Packages Projects Releases Wiki Activity

par.adb (Check_No_Right_Paren): Removed no longer used

Browse Source 
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
This commit is contained in:
Robert Dewar 2008-03-26 08:37:49 +01:00 committed by Arnaud Charlet
parent 14f1ec15bd
commit 3b8d33ef1d
10 changed files with 139 additions and 106 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
gcc/ada/erroutc.adb
View File

@ -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) = '?'

12
gcc/ada/par-ch10.adb
View File

@ -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);

8
gcc/ada/par-ch3.adb
View File

@ -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

27
gcc/ada/par-ch4.adb
View File

@ -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);

14
gcc/ada/par-ch5.adb
View File

@ -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

32
gcc/ada/par-ch6.adb
View File

@ -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;

34
gcc/ada/par-ch9.adb
View File

@ -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;

56
gcc/ada/par-tchk.adb
View File

@ -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

44
gcc/ada/par-util.adb
View File

@ -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);

12
gcc/ada/par.adb
View File

@ -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);