-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2005 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, 59 Temple Place - Suite 330, Boston, --
--- MA 02111-1307, 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. --
------------------------------------------------------------------------------
pragma Style_Checks (All_Checks);
--- Turn off subprogram body ordering check. Subprograms are in order
--- by RM section rather than alphabetical
+-- Turn off subprogram body ordering check. Subprograms are in order by RM
+-- section rather than alphabetical.
separate (Par)
package body Ch9 is
-- [is [new INTERFACE_LIST with] TASK_DEFINITION];
-- SINGLE_TASK_DECLARATION ::=
- -- task DEFINING_IDENTIFIER [is TASK_DEFINITION];
+ -- task DEFINING_IDENTIFIER
+ -- [is [new INTERFACE_LIST with] TASK_DEFINITION];
-- TASK_BODY ::=
-- task body DEFINING_IDENTIFIER 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
-- is [new INTERFACE_LIST with] PROTECTED_DEFINITION;
-- SINGLE_PROTECTED_DECLARATION ::=
- -- protected DEFINING_IDENTIFIER is PROTECTED_DEFINITION;
+ -- protected DEFINING_IDENTIFIER
+ -- is [new INTERFACE_LIST with] PROTECTED_DEFINITION;
-- PROTECTED_BODY ::=
-- protected body DEFINING_IDENTIFIER is
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)
Scan; -- past NEW
if Ada_Version < Ada_05 then
- Error_Msg_SP ("task interface is an Ada 2005 extension");
+ Error_Msg_SP ("protected interface is an Ada 2005 extension");
Error_Msg_SP ("\unit must be compiled with -gnat05 switch");
end if;
end if;
Scan; -- past WITH
-
- if Token = Tok_Private then
- Error_Msg_SP
- ("PRIVATE not allowed in protected type declaration");
- end if;
end if;
Set_Protected_Definition (Protected_Node, P_Protected_Definition);
Append (Item_Node, Visible_Declarations (Def_Node));
end loop;
- -- Deal with PRIVATE part (including graceful handling
- -- of multiple PRIVATE parts).
+ -- Deal with PRIVATE part (including graceful handling of multiple
+ -- PRIVATE parts).
Private_Loop : while Token = Tok_Private loop
if No (Private_Declarations (Def_Node)) then
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 ("overriding indicator is an Ada 2005 extension");
Error_Msg_SP ("\unit must be compiled with -gnat05 switch");
elsif Token = Tok_Entry then
Set_Must_Not_Override (Specification (Decl), Not_Overriding);
else
- Error_Msg_SC ("ENTRY, FUNCTION or PROCEDURE expected!");
+ Error_Msg_SC -- CODEFIX
+ ("ENTRY, FUNCTION or PROCEDURE expected!");
end if;
end if;
if Token = Tok_Entry or else Bad_Spelling_Of (Tok_Entry) then
Append (P_Entry_Body, Item_List);
+ -- If the operation starts with procedure, function, or an overriding
+ -- indicator ("overriding" or "not overriding"), parse a subprogram.
+
elsif Token = Tok_Function or else Bad_Spelling_Of (Tok_Function)
or else
Token = Tok_Procedure or else Bad_Spelling_Of (Tok_Procedure)
+ or else
+ Token = Tok_Overriding or else Bad_Spelling_Of (Tok_Overriding)
+ or else
+ Token = Tok_Not or else Bad_Spelling_Of (Tok_Not)
then
Append (P_Subprogram (Pf_Decl_Pbod), Item_List);
Not_Overriding : Boolean := False;
begin
- -- Ada 2005 (AI-397): Scan leading overriding indicator.
+ -- Ada 2005 (AI-397): Scan leading overriding indicator
if Token = Tok_Not then
Scan; -- past NOT
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 ("overriding indicator is an Ada 2005 extension");
Error_Msg_SP ("\unit must be compiled with -gnat05 switch");
elsif Token /= Tok_Entry then
Restore_Scan_State (Scan_State); -- to Id
Set_Parameter_Specifications (Decl_Node, P_Formal_Part);
- -- Else if Id wi no comma or colon, must be discrete subtype defn
+ -- Else if Id without comma or colon, must be discrete subtype
+ -- defn
else
Restore_Scan_State (Scan_State); -- to Id
TF_Semicolon;
return Decl_Node;
+
+ exception
+ when Error_Resync =>
+ Resync_Past_Semicolon;
+ return Error;
end P_Entry_Declaration;
-----------------------------
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;
Ecall_Node := P_Name;
-- ?? The following two clauses exactly parallel code in ch5
- -- and should be commoned sometime
+ -- and should be combined sometime
if Nkind (Ecall_Node) = N_Indexed_Component then
declare
elsif Nkind (Ecall_Node) = N_Identifier
or else Nkind (Ecall_Node) = N_Selected_Component
then
- -- Case of a call to a parameterless entry.
+ -- Case of a call to a parameterless entry
declare
C_Node : constant Node_Id :=
End_Statements;
- -- Here we have a selective accept or an an asynchronous select (first
+ -- Here we have a selective accept or an asynchronous select (first
-- token after SELECT is other than a designator token).
else
else
Error_Msg_SC
- ("Select alternative (ACCEPT, ABORT, DELAY) expected");
+ ("select alternative (ACCEPT, ABORT, DELAY) expected");
Alternative := Error;
if Token = Tok_Semicolon then
-- Note: the reason that we accept THEN ABORT as a terminator for
-- the sequence of statements is for error recovery which allows
- -- for misuse of an accept statement as a triggering statememt.
+ -- for misuse of an accept statement as a triggering statement.
Set_Statements
(Accept_Alt_Node, P_Sequence_Of_Statements (SS_Eltm_Ortm_Tatm));
-- Note: the reason that we accept THEN ABORT as a terminator for
-- the sequence of statements is for error recovery which allows
- -- for misuse of an accept statement as a triggering statememt.
+ -- for misuse of an accept statement as a triggering statement.
Set_Statements
(Delay_Alt_Node, P_Sequence_Of_Statements (SS_Eltm_Ortm_Tatm));
OSDN Git Service
