-- --
-- 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. --
Scan; -- past GENERIC
if Token = Tok_Private then
- Error_Msg_SC ("PRIVATE goes before GENERIC, not after");
+ Error_Msg_SC -- CODEFIX
+ ("PRIVATE goes before GENERIC, not after");
Scan; -- past junk PRIVATE token
end if;
Append (P_Formal_Subprogram_Declaration, Decls);
else
- Error_Msg_BC
+ Error_Msg_BC -- CODEFIX
("FUNCTION, PROCEDURE or PACKAGE expected here");
Resync_Past_Semicolon;
end if;
begin
Generic_Assoc_Node := New_Node (N_Generic_Association, Token_Ptr);
+ -- Ada2005: an association can be given by: others => <>
+
+ if Token = Tok_Others then
+ if Ada_Version < Ada_05 then
+ Error_Msg_SP
+ ("partial parametrization of formal packages" &
+ " is an Ada 2005 extension");
+ Error_Msg_SP
+ ("\unit must be compiled with -gnat05 switch");
+ end if;
+
+ Scan; -- past OTHERS
+
+ if Token /= Tok_Arrow then
+ Error_Msg_BC ("expect arrow after others");
+ else
+ Scan; -- past arrow
+ end if;
+
+ if Token /= Tok_Box then
+ Error_Msg_BC ("expect Box after arrow");
+ else
+ Scan; -- past box
+ end if;
+
+ -- Source position of the others choice is beginning of construct
+
+ return New_Node (N_Others_Choice, Sloc (Generic_Assoc_Node));
+ end if;
+
if Token in Token_Class_Desig then
Param_Name_Node := Token_Node;
Save_Scan_State (Scan_State); -- at designator
end if;
end if;
- Set_Explicit_Generic_Actual_Parameter (Generic_Assoc_Node, P_Expression);
+ -- In Ada 2005 the actual can be a box
+
+ if Token = Tok_Box then
+ Scan;
+ Set_Box_Present (Generic_Assoc_Node);
+ Set_Explicit_Generic_Actual_Parameter (Generic_Assoc_Node, Empty);
+
+ else
+ Set_Explicit_Generic_Actual_Parameter
+ (Generic_Assoc_Node, P_Expression);
+ end if;
+
return Generic_Assoc_Node;
end P_Generic_Association;
-- FORMAL_OBJECT_DECLARATION ::=
-- DEFINING_IDENTIFIER_LIST :
- -- MODE SUBTYPE_MARK [:= DEFAULT_EXPRESSION];
+ -- MODE [NULL_EXCLUSION] SUBTYPE_MARK [:= DEFAULT_EXPRESSION];
+ -- | DEFINING_IDENTIFIER_LIST :
+ -- MODE ACCESS_DEFINITION [:= DEFAULT_EXPRESSION];
-- The caller has checked that the initial token is an identifier
-- Error recovery: cannot raise Error_Resync
procedure P_Formal_Object_Declarations (Decls : List_Id) is
- Decl_Node : Node_Id;
- Scan_State : Saved_Scan_State;
- Num_Idents : Nat;
- Ident : Nat;
+ Decl_Node : Node_Id;
+ Ident : Nat;
+ Not_Null_Present : Boolean := False;
+ Num_Idents : Nat;
+ Scan_State : Saved_Scan_State;
Idents : array (Int range 1 .. 4096) of Entity_Id;
-- This array holds the list of defining identifiers. The upper bound
Decl_Node := New_Node (N_Formal_Object_Declaration, Token_Ptr);
Set_Defining_Identifier (Decl_Node, Idents (Ident));
P_Mode (Decl_Node);
- Set_Subtype_Mark (Decl_Node, P_Subtype_Mark_Resync);
+
+ Not_Null_Present := P_Null_Exclusion; -- Ada 2005 (AI-423)
+
+ -- Ada 2005 (AI-423): Formal object with an access definition
+
+ if Token = Tok_Access then
+
+ -- The access definition is still parsed and set even though
+ -- the compilation may not use the proper switch. This action
+ -- ensures the required local error recovery.
+
+ Set_Access_Definition (Decl_Node,
+ P_Access_Definition (Not_Null_Present));
+
+ if Ada_Version < Ada_05 then
+ Error_Msg_SP
+ ("access definition not allowed in formal object " &
+ "declaration");
+ Error_Msg_SP ("\unit must be compiled with -gnat05 switch");
+ end if;
+
+ -- Formal object with a subtype mark
+
+ else
+ Set_Null_Exclusion_Present (Decl_Node, Not_Null_Present);
+ Set_Subtype_Mark (Decl_Node, P_Subtype_Mark_Resync);
+ end if;
+
No_Constraint;
- Set_Expression (Decl_Node, Init_Expr_Opt);
+ Set_Default_Expression (Decl_Node, Init_Expr_Opt);
if Ident > 1 then
Set_Prev_Ids (Decl_Node, True);
-- exception is ABSTRACT, where we have to scan ahead to see if we
-- have a formal derived type or a formal private type definition.
+ -- In addition, in Ada 2005 LIMITED may appear after abstract, so
+ -- that the lookahead must be extended by one more token.
+
when Tok_Abstract =>
Save_Scan_State (Scan_State);
Scan; -- past ABSTRACT
Restore_Scan_State (Scan_State); -- to ABSTRACT
return P_Formal_Derived_Type_Definition;
+ elsif Token = Tok_Limited then
+ Scan; -- past LIMITED
+
+ if Token = Tok_New then
+ Restore_Scan_State (Scan_State); -- to ABSTRACT
+ return P_Formal_Derived_Type_Definition;
+
+ else
+ Restore_Scan_State (Scan_State); -- to ABSTRACT
+ return P_Formal_Private_Type_Definition;
+ end if;
+
+ -- Ada 2005 (AI-443): Abstract synchronized formal derived type
+
+ elsif Token = Tok_Synchronized then
+ Restore_Scan_State (Scan_State); -- to ABSTRACT
+ return P_Formal_Derived_Type_Definition;
+
else
Restore_Scan_State (Scan_State); -- to ABSTRACT
return P_Formal_Private_Type_Definition;
return P_Formal_Floating_Point_Definition;
when Tok_Interface => -- Ada 2005 (AI-251)
- return P_Interface_Type_Definition (Is_Synchronized => False);
+ return P_Interface_Type_Definition (Abstract_Present => False);
when Tok_Left_Paren =>
return P_Formal_Discrete_Type_Definition;
Scan; -- past LIMITED
if Token = Tok_Interface then
- Typedef_Node := P_Interface_Type_Definition
- (Is_Synchronized => False);
+ Typedef_Node :=
+ P_Interface_Type_Definition (Abstract_Present => False);
Set_Limited_Present (Typedef_Node);
return Typedef_Node;
+ elsif Token = Tok_New then
+ Restore_Scan_State (Scan_State); -- to LIMITED
+ return P_Formal_Derived_Type_Definition;
+
else
+ if Token = Tok_Abstract then
+ Error_Msg_SC -- CODEFIX
+ ("ABSTRACT must come before LIMITED");
+ Scan; -- past improper ABSTRACT
+
+ if Token = Tok_New then
+ Restore_Scan_State (Scan_State); -- to LIMITED
+ return P_Formal_Derived_Type_Definition;
+
+ else
+ Restore_Scan_State (Scan_State);
+ return P_Formal_Private_Type_Definition;
+ end if;
+ end if;
+
Restore_Scan_State (Scan_State);
return P_Formal_Private_Type_Definition;
end if;
when Tok_New =>
return P_Formal_Derived_Type_Definition;
+ when Tok_Not =>
+ if P_Null_Exclusion then
+ Typedef_Node := P_Access_Type_Definition;
+ Set_Null_Exclusion_Present (Typedef_Node);
+ return Typedef_Node;
+
+ else
+ Error_Msg_SC ("expect valid formal access definition!");
+ Resync_Past_Semicolon;
+ return Error;
+ end if;
+
when Tok_Private |
Tok_Tagged =>
return P_Formal_Private_Type_Definition;
Discard_Junk_Node (P_Record_Definition);
return Error;
- -- Ada 2005 (AI-345)
+ -- Ada 2005 (AI-345): Task, Protected or Synchronized interface or
+ -- (AI-443): Synchronized formal derived type declaration.
when Tok_Protected |
Tok_Synchronized |
Tok_Task =>
- Scan; -- past TASK, PROTECTED or SYNCHRONIZED
-
declare
- Saved_Token : constant Token_Type := Token;
+ Saved_Token : constant Token_Type := Token;
begin
- Typedef_Node := P_Interface_Type_Definition
- (Is_Synchronized => True);
+ Scan; -- past TASK, PROTECTED or SYNCHRONIZED
- case Saved_Token is
- when Tok_Task =>
- Set_Task_Present (Typedef_Node);
+ -- Synchronized derived type
- when Tok_Protected =>
- Set_Protected_Present (Typedef_Node);
+ if Token = Tok_New then
+ Typedef_Node := P_Formal_Derived_Type_Definition;
- when Tok_Synchronized =>
+ if Saved_Token = Tok_Synchronized then
Set_Synchronized_Present (Typedef_Node);
+ else
+ Error_Msg_SC ("invalid kind of formal derived type");
+ end if;
+
+ -- Interface
+
+ else
+ Typedef_Node :=
+ P_Interface_Type_Definition (Abstract_Present => False);
+
+ case Saved_Token is
+ when Tok_Task =>
+ Set_Task_Present (Typedef_Node);
- when others =>
- null;
- end case;
+ when Tok_Protected =>
+ Set_Protected_Present (Typedef_Node);
+
+ when Tok_Synchronized =>
+ Set_Synchronized_Present (Typedef_Node);
+
+ when others =>
+ null;
+ end case;
+ end if;
return Typedef_Node;
end;
Scan; -- past LIMITED
end if;
+ if Token = Tok_Abstract then
+ if Prev_Token = Tok_Tagged then
+ Error_Msg_SC -- CODEFIX
+ ("ABSTRACT must come before TAGGED");
+ elsif Prev_Token = Tok_Limited then
+ Error_Msg_SC -- CODEFIX
+ ("ABSTRACT must come before LIMITED");
+ end if;
+
+ Resync_Past_Semicolon;
+
+ elsif Token = Tok_Tagged then
+ Error_Msg_SC -- CODEFIX
+ ("TAGGED must come before LIMITED");
+ Resync_Past_Semicolon;
+ end if;
+
Set_Sloc (Def_Node, Token_Ptr);
T_Private;
return Def_Node;
--------------------------------------------
-- FORMAL_DERIVED_TYPE_DEFINITION ::=
- -- [abstract] new SUBTYPE_MARK [[AND interface_list] with private]
+ -- [abstract] [limited | synchronized]
+ -- new SUBTYPE_MARK [[and INTERFACE_LIST] with private]
- -- The caller has checked the initial token(s) is/are NEW or ASTRACT NEW
+ -- The caller has checked the initial token(s) is/are NEW, ABSTRACT NEW,
+ -- or LIMITED NEW, ABSTRACT LIMITED NEW, SYNCHRONIZED NEW or ABSTRACT
+ -- SYNCHRONIZED NEW.
-- Error recovery: cannot raise Error_Resync
Scan; -- past ABSTRACT
end if;
+ if Token = Tok_Limited then
+ Set_Limited_Present (Def_Node);
+ Scan; -- past LIMITED
+
+ if Ada_Version < Ada_05 then
+ Error_Msg_SP
+ ("LIMITED in derived type is an Ada 2005 extension");
+ Error_Msg_SP
+ ("\unit must be compiled with -gnat05 switch");
+ end if;
+
+ elsif Token = Tok_Synchronized then
+ Set_Synchronized_Present (Def_Node);
+ Scan; -- past SYNCHRONIZED
+
+ if Ada_Version < Ada_05 then
+ Error_Msg_SP
+ ("SYNCHRONIZED in derived type is an Ada 2005 extension");
+ Error_Msg_SP
+ ("\unit must be compiled with -gnat05 switch");
+ end if;
+ end if;
+
+ if Token = Tok_Abstract then
+ Scan; -- past ABSTRACT, diagnosed already in caller.
+ end if;
+
Scan; -- past NEW;
Set_Subtype_Mark (Def_Node, P_Subtype_Mark);
No_Constraint;
-- The caller has checked that the initial tokens are WITH FUNCTION or
-- WITH PROCEDURE, and the initial WITH has been scanned out.
- -- A null default is an Ada 2005 feature.
+ -- A null default is an Ada 2005 feature
-- Error recovery: cannot raise Error_Resync
-- is new generic_package_NAME FORMAL_PACKAGE_ACTUAL_PART;
-- FORMAL_PACKAGE_ACTUAL_PART ::=
- -- (<>) | [GENERIC_ACTUAL_PART]
+ -- ([OTHERS =>] <>) |
+ -- [GENERIC_ACTUAL_PART]
+ -- (FORMAL_PACKAGE_ASSOCIATION {, FORMAL_PACKAGE_ASSOCIATION}
+ -- [, OTHERS => <>)
+
+ -- FORMAL_PACKAGE_ASSOCIATION ::=
+ -- GENERIC_ASSOCIATION
+ -- | GENERIC_FORMAL_PARAMETER_SELECTOR_NAME => <>
-- The caller has checked that the initial tokens are WITH PACKAGE,
-- and the initial WITH has been scanned out (so Token = Tok_Package).
OSDN Git Service
