-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2009, 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- --
--- ware Foundation; either version 2, or (at your option) any later ver- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
--- Public License distributed with GNAT; see file COPYING. If not, write --
--- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
--- Boston, MA 02110-1301, USA. --
+-- Public License distributed with GNAT; see file COPYING3. If not, go to --
+-- http://www.gnu.org/licenses for a complete copy of the license. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
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;
Scope.Table (Scope.Last).Ecol := Start_Column;
Scope.Table (Scope.Last).Lreq := False;
- -- Ada2005: scan leading overriding indicator
+ -- Ada2005: scan leading NOT OVERRIDING indicator
if Token = Tok_Not then
Scan; -- past NOT
if Token = Tok_Overriding then
Scan; -- past OVERRIDING
Not_Overriding := True;
+
+ -- Overriding keyword used in non Ada 2005 mode
+
+ elsif Token = Tok_Identifier
+ and then Token_Name = Name_Overriding
+ then
+ Error_Msg_SC ("overriding indicator is an Ada 2005 extension");
+ Error_Msg_SC ("\unit must be compiled with -gnat05 switch");
+ Scan; -- past Overriding
+ Not_Overriding := True;
+
else
Error_Msg_SC ("OVERRIDING expected!");
end if;
+ -- Ada 2005: scan leading OVERRIDING indicator
+
+ -- Note: in the case of OVERRIDING keyword used in Ada 95 mode, the
+ -- declaration circuit already gave an error message and changed the
+ -- token to Tok_Overriding.
+
elsif Token = Tok_Overriding then
Scan; -- past OVERRIDING
Is_Overriding := True;
end if;
if (Is_Overriding or else Not_Overriding) then
- if Ada_Version < Ada_05 then
- Error_Msg_SP (" overriding indicator is an Ada 2005 extension");
- Error_Msg_SP ("\unit must be compiled with -gnat05 switch");
+
+ -- Note that if we are not in Ada_05 mode, error messages have
+ -- already been given, so no need to give another message here.
-- An overriding indicator is allowed for subprogram declarations,
- -- bodies, renamings, stubs, and instantiations.
+ -- bodies, renamings, stubs, and instantiations. The test against
+ -- Pf_Decl_Pbod is added to account for the case of subprograms
+ -- declared in a protected type, where only subprogram declarations
+ -- and bodies can occur.
- elsif Pf_Flags /= Pf_Decl_Gins_Pbod_Rnam_Stub then
+ if Pf_Flags /= Pf_Decl_Gins_Pbod_Rnam_Stub
+ and then
+ Pf_Flags /= Pf_Decl_Pbod
+ then
Error_Msg_SC ("overriding indicator not allowed here!");
- elsif Token /= Tok_Function
- and then Token /= Tok_Procedure
- then
- Error_Msg_SC ("FUNCTION or PROCEDURE expected!");
+ elsif Token /= Tok_Function and then Token /= Tok_Procedure then
+ Error_Msg_SC -- CODEFIX
+ ("FUNCTION or PROCEDURE expected!");
end if;
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
if Token = Tok_New then
if not Pf_Flags.Gins then
- Error_Msg_SC ("generic instantation not allowed here!");
+ Error_Msg_SC ("generic instantiation not allowed here!");
end if;
Scan; -- past NEW
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;
Ident : Nat;
Ident_Sloc : Source_Ptr;
Not_Null_Present : Boolean := False;
+ Not_Null_Sloc : Source_Ptr;
Idents : array (Int range 1 .. 4096) of Entity_Id;
-- This array holds the list of defining identifiers. The upper bound
Specification_Loop : loop
begin
if Token = Tok_Pragma then
- P_Pragmas_Misplaced;
+ Error_Msg_SC ("pragma not allowed in formal part");
+ Discard_Junk_Node (P_Pragma (Skipping => True));
end if;
Ignore (Tok_Left_Paren);
-- Scan possible NOT NULL for Ada 2005 (AI-231, AI-447)
+ Not_Null_Sloc := Token_Ptr;
Not_Null_Present :=
P_Null_Exclusion (Allow_Anonymous_In_95 => True);
else
if Token = Tok_In or else Token = Tok_Out then
if Not_Null_Present then
- Error_Msg_SC
- ("ACCESS must be placed after the parameter mode");
+ Error_Msg
+ ("`NOT NULL` can only be used with `ACCESS`",
+ Not_Null_Sloc);
+
+ if Token = Tok_In then
+ Error_Msg
+ ("\`IN` not allowed together with `ACCESS`",
+ Not_Null_Sloc);
+ else
+ Error_Msg
+ ("\`OUT` not allowed together with `ACCESS`",
+ Not_Null_Sloc);
+ end if;
end if;
P_Mode (Specification_Node);
-- 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;
end if;
if Token = Tok_In then
- Error_Msg_SC ("IN must preceed OUT in parameter mode");
+ Error_Msg_SC -- CODEFIX ???
+ ("IN must precede OUT in parameter mode");
Scan; -- past IN
Set_In_Present (Node, True);
end if;
Set_Constant_Present (Decl_Node);
if Token = Tok_Aliased then
- Error_Msg_SC ("ALIASED should be before CONSTANT");
+ Error_Msg_SC -- CODEFIX
+ ("ALIASED should be before CONSTANT");
Scan; -- past ALIASED
Set_Aliased_Present (Decl_Node);
end if;
begin
Scan; -- past RETURN
- -- Simple_return_statement, no expression, return an N_Return_Statement
- -- node with the expression field left Empty.
+ -- Simple_return_statement, no expression, return an
+ -- N_Simple_Return_Statement node with the expression field left Empty.
if Token = Tok_Semicolon then
Scan; -- past ;
- Return_Node := New_Node (N_Return_Statement, Return_Sloc);
+ Return_Node := New_Node (N_Simple_Return_Statement, Return_Sloc);
- -- Non-simple case
+ -- Non-trivial case
else
-- Simple_return_statement with expression
-- message is probably that we have a missing semicolon.
if Is_Simple then
- Return_Node := New_Node (N_Return_Statement, Return_Sloc);
+ Return_Node := New_Node (N_Simple_Return_Statement, Return_Sloc);
if Token not in Token_Class_Eterm then
Set_Expression (Return_Node, P_Expression_No_Right_Paren);