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) = '?'
-- --
-- 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- --
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);
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;
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);
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
-- 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);
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
-- 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
separate (Par)
package body Ch4 is
- ---------------
- -- Local map --
- ---------------
+ -- Attributes that cannot have arguments
Is_Parameterless_Attribute : constant Attribute_Class_Array :=
(Attribute_Body_Version => True,
-- 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 --
-----------------------
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
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
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;
return P_Identifier;
elsif Prev_Token = Tok_Comma then
- Error_Msg_SP ("extra "","" ignored");
+ Error_Msg_SP ("|extra "","" ignored");
raise Error_Resync;
else
begin
if Token = Tok_Box then
- Error_Msg_SC ("""'<'>"" should be ""/=""");
+ Error_Msg_SC ("|""'<'>"" should be ""/=""");
end if;
Op_Kind := Relop_Node (Token);
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
-- 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
-- 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;
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
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;
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
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
-- 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
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
-- 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;
-- 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;
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
Name_Node : Node_Id;
Protected_Node : Node_Id;
Protected_Sloc : Source_Ptr;
+ Scan_State : Saved_Scan_State;
begin
Push_Scope_Stack;
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)
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;
-- 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
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
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;
if Token = Tok_Right_Paren then
Scan;
else
- Error_Msg_AP ("missing "")""");
+ Error_Msg_AP ("|missing "")""");
end if;
end T_Right_Paren;
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;
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
if Token = Tok_Right_Paren then
Scan;
else
- Error_Msg_AP ("missing "")""!");
+ Error_Msg_AP ("|missing "")""!");
end if;
end U_Right_Paren;
Scan;
if Token = T then
- Error_Msg_SP ("extra "";"" ignored");
+ Error_Msg_SP ("|extra "";"" ignored");
Scan;
else
Error_Msg_SP (M);
Scan;
if Token = T then
- Error_Msg_SP ("extra "","" ignored");
+ Error_Msg_SP ("|extra "","" ignored");
Scan;
else
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;
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 --
-----------------------------
<<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;
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;
----------------------------
declare
Ident_Casing : constant Casing_Type :=
Identifier_Casing (Current_Source_File);
-
Key_Casing : constant Casing_Type :=
Keyword_Casing (Current_Source_File);
-- --
-- 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- --
-- 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
-- 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);
projects / gcc.git / commitdiff