case Token is
when Tok_Access |
- Tok_Not => -- Ada 0Y (AI-231)
+ Tok_Not => -- Ada 2005 (AI-231)
Typedef_Node := P_Access_Type_Definition;
TF_Semicolon;
exit;
-- LIMITED RECORD or LIMITED NULL RECORD
if Token = Tok_Record or else Token = Tok_Null then
- if Ada_83 then
+ if Ada_Version = Ada_83 then
Error_Msg_SP
("(Ada 83) limited record declaration not allowed!");
end if;
--------------------------------
-- SUBTYPE_DECLARATION ::=
- -- subtype DEFINING_IDENTIFIER is SUBTYPE_INDICATION;
+ -- subtype DEFINING_IDENTIFIER is [NULL_EXCLUSION] SUBTYPE_INDICATION;
-- The caller has checked that the initial token is SUBTYPE
Scan; -- past NEW
end if;
- if Extensions_Allowed then -- Ada 0Y (AI-231)
- Not_Null_Present := P_Null_Exclusion;
- Set_Null_Exclusion_Present (Decl_Node, Not_Null_Present);
- end if;
+ Not_Null_Present := P_Null_Exclusion; -- Ada 2005 (AI-231)
+ Set_Null_Exclusion_Present (Decl_Node, Not_Null_Present);
Set_Subtype_Indication
(Decl_Node, P_Subtype_Indication (Not_Null_Present));
return False;
else
- if not Extensions_Allowed then
+ if Ada_Version < Ada_05 then
Error_Msg_SP
- ("null-excluding access is an Ada 0Y extension");
- Error_Msg_SP ("\unit must be compiled with -gnatX switch");
+ ("null-excluding access is an Ada 2005 extension");
+ Error_Msg_SP ("\unit must be compiled with -gnat05 switch");
end if;
Scan; -- past NOT
if Token = Tok_Null then
Scan; -- past NULL
else
- Error_Msg_SP ("(Ada 0Y) missing NULL");
+ Error_Msg_SP ("NULL expected");
end if;
return True;
return Subtype_Mark;
else
if Not_Null_Present then
- Error_Msg_SP ("(Ada 0Y) constrained null-exclusion not allowed");
+ Error_Msg_SP ("constrained null-exclusion not allowed");
end if;
Indic_Node := New_Node (N_Subtype_Indication, Sloc (Subtype_Mark));
-- This routine scans out a declaration starting with an identifier:
-- OBJECT_DECLARATION ::=
- -- DEFINING_IDENTIFIER_LIST : [constant] [aliased]
- -- SUBTYPE_INDICATION [:= EXPRESSION];
- -- | DEFINING_IDENTIFIER_LIST : [constant] [aliased]
+ -- DEFINING_IDENTIFIER_LIST : [aliased] [constant]
+ -- [NULL_EXCLUSION] SUBTYPE_INDICATION [:= EXPRESSION];
+ -- | DEFINING_IDENTIFIER_LIST : [aliased] [constant]
-- ARRAY_TYPE_DEFINITION [:= EXPRESSION];
-- NUMBER_DECLARATION ::=
if Present (Init_Expr) then
if Not_Null_Present then
- Error_Msg_SP ("(Ada 0Y) null-exclusion not allowed in "
+ Error_Msg_SP ("null-exclusion not allowed in "
& "numeric expression");
end if;
else
Decl_Node := New_Node (N_Object_Declaration, Ident_Sloc);
- Set_Null_Exclusion_Present (Decl_Node, Not_Null_Present);
Set_Constant_Present (Decl_Node, True);
if Token_Name = Name_Aliased then
(Decl_Node, P_Array_Type_Definition);
else
- if Extensions_Allowed then -- Ada 0Y (AI-231)
- Not_Null_Present := P_Null_Exclusion;
- Set_Null_Exclusion_Present (Decl_Node, Not_Null_Present);
- end if;
+ Not_Null_Present := P_Null_Exclusion; -- Ada 2005 (AI-231)
+ Set_Null_Exclusion_Present (Decl_Node, Not_Null_Present);
Set_Object_Definition (Decl_Node,
P_Subtype_Indication (Not_Null_Present));
Scan; -- past ALIASED
Decl_Node := New_Node (N_Object_Declaration, Ident_Sloc);
Set_Aliased_Present (Decl_Node, True);
- Set_Null_Exclusion_Present (Decl_Node, Not_Null_Present);
if Token = Tok_Constant then
Scan; -- past CONSTANT
(Decl_Node, P_Array_Type_Definition);
else
- if Extensions_Allowed then -- Ada 0Y (AI-231)
- Not_Null_Present := P_Null_Exclusion;
- Set_Null_Exclusion_Present (Decl_Node, Not_Null_Present);
- end if;
-
+ Not_Null_Present := P_Null_Exclusion; -- Ada 2005 (AI-231)
+ Set_Null_Exclusion_Present (Decl_Node, Not_Null_Present);
Set_Object_Definition (Decl_Node,
P_Subtype_Indication (Not_Null_Present));
end if;
Decl_Node := New_Node (N_Object_Declaration, Ident_Sloc);
Set_Object_Definition (Decl_Node, P_Array_Type_Definition);
- -- Ada 0Y (AI-230): Access Definition case
+ -- Ada 2005 (AI-254)
+
+ elsif Token = Tok_Not then
+
+ -- OBJECT_DECLARATION ::=
+ -- DEFINING_IDENTIFIER_LIST : [aliased] [constant]
+ -- [NULL_EXCLUSION] SUBTYPE_INDICATION [:= EXPRESSION];
+
+ -- OBJECT_RENAMING_DECLARATION ::=
+ -- ...
+ -- | DEFINING_IDENTIFIER : ACCESS_DEFINITION renames object_NAME;
+
+ Not_Null_Present := P_Null_Exclusion; -- Ada 2005 (AI-231)
+
+ if Token = Tok_Access then
+ if Ada_Version < Ada_05 then
+ Error_Msg_SP
+ ("generalized use of anonymous access types " &
+ "is an Ada 2005 extension");
+ Error_Msg_SP ("\unit must be compiled with -gnat05 switch");
+ end if;
+
+ Acc_Node := P_Access_Definition (Not_Null_Present);
+
+ if Token /= Tok_Renames then
+ Error_Msg_SC ("'RENAMES' expected");
+ raise Error_Resync;
+ end if;
+
+ Scan; -- past renames
+ No_List;
+ Decl_Node :=
+ New_Node (N_Object_Renaming_Declaration, Ident_Sloc);
+ Set_Access_Definition (Decl_Node, Acc_Node);
+ Set_Name (Decl_Node, P_Name);
+
+ else
+ Type_Node := P_Subtype_Mark;
+
+ -- Object renaming declaration
+
+ if Token_Is_Renames then
+ Error_Msg_SP
+ ("null-exclusion not allowed in object renamings");
+ raise Error_Resync;
+
+ -- Object declaration
+
+ else
+ Decl_Node := New_Node (N_Object_Declaration, Ident_Sloc);
+ Set_Null_Exclusion_Present (Decl_Node, Not_Null_Present);
+ Set_Object_Definition
+ (Decl_Node,
+ P_Subtype_Indication (Type_Node, Not_Null_Present));
+
+ -- RENAMES at this point means that we had the combination
+ -- of a constraint on the Type_Node and renames, which is
+ -- illegal
+
+ if Token_Is_Renames then
+ Error_Msg_N ("constraint not allowed in object renaming "
+ & "declaration",
+ Constraint (Object_Definition (Decl_Node)));
+ raise Error_Resync;
+ end if;
+ end if;
+ end if;
+
+ -- Ada 2005 (AI-230): Access Definition case
elsif Token = Tok_Access then
- if not Extensions_Allowed then
+ if Ada_Version < Ada_05 then
Error_Msg_SP
("generalized use of anonymous access types " &
- "is an Ada 0Y extension");
- Error_Msg_SP ("\unit must be compiled with -gnatX switch");
+ "is an Ada 2005 extension");
+ Error_Msg_SP ("\unit must be compiled with -gnat05 switch");
end if;
- Acc_Node := P_Access_Definition;
+ Acc_Node := P_Access_Definition (Null_Exclusion_Present => False);
if Token /= Tok_Renames then
Error_Msg_SC ("'RENAMES' expected");
-- Subtype indication case
else
- if Extensions_Allowed then -- Ada 0Y (AI-231)
- Not_Null_Present := P_Null_Exclusion;
- end if;
-
Type_Node := P_Subtype_Mark;
-- Object renaming declaration
if Token_Is_Renames then
- if Not_Null_Present then
- Error_Msg_SP
- ("(Ada 0Y) null-exclusion not allowed in renamings");
- end if;
-
No_List;
Decl_Node :=
New_Node (N_Object_Renaming_Declaration, Ident_Sloc);
-------------------------------------------------------------------------
-- DERIVED_TYPE_DEFINITION ::=
- -- [abstract] new parent_SUBTYPE_INDICATION [RECORD_EXTENSION_PART]
+ -- [abstract] new [NULL_EXCLUSION] parent_SUBTYPE_INDICATION
+ -- [RECORD_EXTENSION_PART]
-- PRIVATE_EXTENSION_DECLARATION ::=
-- type DEFINING_IDENTIFIER [DISCRIMINANT_PART] is
Scan;
end if;
- if Extensions_Allowed then -- Ada 0Y (AI-231)
- Not_Null_Present := P_Null_Exclusion;
- Set_Null_Exclusion_Present (Typedef_Node, Not_Null_Present);
- end if;
-
+ Not_Null_Present := P_Null_Exclusion; -- Ada 2005 (AI-231)
+ Set_Null_Exclusion_Present (Typedef_Node, Not_Null_Present);
Set_Subtype_Indication (Typedef_Node,
P_Subtype_Indication (Not_Null_Present));
Typedef_Node : Node_Id;
begin
- if Ada_83 then
+ if Ada_Version = Ada_83 then
Error_Msg_SC ("(Ada 83): modular types not allowed");
end if;
Check_Simple_Expression_In_Ada_83 (Delta_Node);
if Token = Tok_Digits then
- if Ada_83 then
+ if Ada_Version = Ada_83 then
Error_Msg_SC ("(Ada 83) decimal fixed type not allowed!");
end if;
-- DISCRETE_SUBTYPE_INDICATION | RANGE
-- COMPONENT_DEFINITION ::=
- -- [aliased] SUBTYPE_INDICATION | ACCESS_DEFINITION
+ -- [aliased] [NULL_EXCLUSION] SUBTYPE_INDICATION | ACCESS_DEFINITION
-- The caller has checked that the initial token is ARRAY
Not_Null_Present : Boolean := False;
Subs_List : List_Id;
Scan_State : Saved_Scan_State;
+ Aliased_Present : Boolean := False;
begin
Array_Loc := Token_Ptr;
CompDef_Node := New_Node (N_Component_Definition, Token_Ptr);
- -- Ada 0Y (AI-230): Access Definition case
+ if Token_Name = Name_Aliased then
+ Check_95_Keyword (Tok_Aliased, Tok_Identifier);
+ end if;
+
+ if Token = Tok_Aliased then
+ Aliased_Present := True;
+ Scan; -- past ALIASED
+ end if;
+
+ Not_Null_Present := P_Null_Exclusion; -- Ada 2005 (AI-231/AI-254)
+
+ -- Ada 2005 (AI-230): Access Definition case
if Token = Tok_Access then
- if not Extensions_Allowed then
+ if Ada_Version < Ada_05 then
Error_Msg_SP
("generalized use of anonymous access types " &
- "is an Ada 0Y extension");
- Error_Msg_SP ("\unit must be compiled with -gnatX switch");
- end if;
-
- Set_Subtype_Indication (CompDef_Node, Empty);
- Set_Aliased_Present (CompDef_Node, False);
- Set_Access_Definition (CompDef_Node, P_Access_Definition);
- else
- Set_Access_Definition (CompDef_Node, Empty);
-
- if Token_Name = Name_Aliased then
- Check_95_Keyword (Tok_Aliased, Tok_Identifier);
+ "is an Ada 2005 extension");
+ Error_Msg_SP ("\unit must be compiled with -gnat05 switch");
end if;
- if Token = Tok_Aliased then
- Set_Aliased_Present (CompDef_Node, True);
- Scan; -- past ALIASED
+ if Aliased_Present then
+ Error_Msg_SP ("ALIASED not allowed here");
end if;
- if Extensions_Allowed then -- Ada 0Y (AI-231)
- Not_Null_Present := P_Null_Exclusion;
- Set_Null_Exclusion_Present (CompDef_Node, Not_Null_Present);
- end if;
+ Set_Subtype_Indication (CompDef_Node, Empty);
+ Set_Aliased_Present (CompDef_Node, False);
+ Set_Access_Definition (CompDef_Node,
+ P_Access_Definition (Not_Null_Present));
+ else
- Set_Subtype_Indication (CompDef_Node,
- P_Subtype_Indication (Not_Null_Present));
+ Set_Access_Definition (CompDef_Node, Empty);
+ Set_Aliased_Present (CompDef_Node, Aliased_Present);
+ Set_Null_Exclusion_Present (CompDef_Node, Not_Null_Present);
+ Set_Subtype_Indication (CompDef_Node,
+ P_Subtype_Indication (Not_Null_Present));
end if;
Set_Component_Definition (Def_Node, CompDef_Node);
Scan; -- past the left paren
if Token = Tok_Box then
- if Ada_83 then
+ if Ada_Version = Ada_83 then
Error_Msg_SC ("(Ada 83) unknown discriminant not allowed!");
end if;
-- (DISCRIMINANT_SPECIFICATION {; DISCRIMINANT_SPECIFICATION})
-- DISCRIMINANT_SPECIFICATION ::=
- -- DEFINING_IDENTIFIER_LIST : SUBTYPE_MARK
+ -- DEFINING_IDENTIFIER_LIST : [NULL_EXCLUSION] SUBTYPE_MARK
-- [:= DEFAULT_EXPRESSION]
-- | DEFINING_IDENTIFIER_LIST : ACCESS_DEFINITION
-- [:= DEFAULT_EXPRESSION]
Specification_Node :=
New_Node (N_Discriminant_Specification, Ident_Sloc);
Set_Defining_Identifier (Specification_Node, Idents (Ident));
-
- Not_Null_Present := P_Null_Exclusion; -- Ada 0Y (AI-231)
+ Not_Null_Present := P_Null_Exclusion; -- Ada 2005 (AI-231)
if Token = Tok_Access then
- if Ada_83 then
+ if Ada_Version = Ada_83 then
Error_Msg_SC
("(Ada 83) access discriminant not allowed!");
end if;
Set_Discriminant_Type
- (Specification_Node, P_Access_Definition);
- Set_Null_Exclusion_Present -- Ada 0Y (AI-231)
- (Discriminant_Type (Specification_Node),
- Not_Null_Present);
+ (Specification_Node,
+ P_Access_Definition (Not_Null_Present));
else
+
Set_Discriminant_Type
(Specification_Node, P_Subtype_Mark);
No_Constraint;
- Set_Null_Exclusion_Present -- Ada 0Y (AI-231)
+ Set_Null_Exclusion_Present -- Ada 2005 (AI-231)
(Specification_Node, Not_Null_Present);
end if;
-- [:= DEFAULT_EXPRESSION];
-- COMPONENT_DEFINITION ::=
- -- [aliased] SUBTYPE_INDICATION | ACCESS_DEFINITION
+ -- [aliased] [NULL_EXCLUSION] SUBTYPE_INDICATION | ACCESS_DEFINITION
-- Error recovery: cannot raise Error_Resync, if an error occurs,
-- the scan is positioned past the following semicolon.
-- items, do we need to add this capability sometime in the future ???
procedure P_Component_Items (Decls : List_Id) is
+ Aliased_Present : Boolean := False;
CompDef_Node : Node_Id;
Decl_Node : Node_Id;
Scan_State : Saved_Scan_State;
CompDef_Node := New_Node (N_Component_Definition, Token_Ptr);
+ if Token_Name = Name_Aliased then
+ Check_95_Keyword (Tok_Aliased, Tok_Identifier);
+ end if;
+
+ if Token = Tok_Aliased then
+ Aliased_Present := True;
+ Scan; -- past ALIASED
+ end if;
+
+ Not_Null_Present := P_Null_Exclusion; -- Ada 2005 (AI-231/AI-254)
+
+ -- Ada 2005 (AI-230): Access Definition case
+
if Token = Tok_Access then
- if not Extensions_Allowed then
+ if Ada_Version < Ada_05 then
Error_Msg_SP
- ("Generalized use of anonymous access types " &
- "is an Ada 0Y extension");
- Error_Msg_SP ("\unit must be compiled with -gnatX switch");
+ ("generalized use of anonymous access types " &
+ "is an Ada 2005 extension");
+ Error_Msg_SP ("\unit must be compiled with -gnat05 switch");
+ end if;
+
+ if Aliased_Present then
+ Error_Msg_SP ("ALIASED not allowed here");
end if;
Set_Subtype_Indication (CompDef_Node, Empty);
Set_Aliased_Present (CompDef_Node, False);
- Set_Access_Definition (CompDef_Node, P_Access_Definition);
+ Set_Access_Definition (CompDef_Node,
+ P_Access_Definition (Not_Null_Present));
else
- Set_Access_Definition (CompDef_Node, Empty);
-
- if Token_Name = Name_Aliased then
- Check_95_Keyword (Tok_Aliased, Tok_Identifier);
- end if;
-
- if Token = Tok_Aliased then
- Scan; -- past ALIASED
- Set_Aliased_Present (CompDef_Node, True);
- end if;
+ Set_Access_Definition (CompDef_Node, Empty);
+ Set_Aliased_Present (CompDef_Node, Aliased_Present);
+ Set_Null_Exclusion_Present (CompDef_Node, Not_Null_Present);
if Token = Tok_Array then
Error_Msg_SC
raise Error_Resync;
end if;
- if Extensions_Allowed then -- Ada 0Y (AI-231)
- Not_Null_Present := P_Null_Exclusion;
- Set_Null_Exclusion_Present (CompDef_Node, Not_Null_Present);
- end if;
-
Set_Subtype_Indication (CompDef_Node,
- P_Subtype_Indication (Not_Null_Present));
+ P_Subtype_Indication (Not_Null_Present));
end if;
Set_Component_Definition (Decl_Node, CompDef_Node);
-- | ACCESS_TO_SUBPROGRAM_DEFINITION
-- ACCESS_TO_OBJECT_DEFINITION ::=
- -- access [GENERAL_ACCESS_MODIFIER] SUBTYPE_INDICATION
+ -- [NULL_EXCLUSION] access [GENERAL_ACCESS_MODIFIER] SUBTYPE_INDICATION
-- GENERAL_ACCESS_MODIFIER ::= all | constant
-- ACCESS_TO_SUBPROGRAM_DEFINITION
- -- access [protected] procedure PARAMETER_PROFILE
- -- | access [protected] function PARAMETER_AND_RESULT_PROFILE
+ -- [NULL_EXCLUSION] access [protected] procedure PARAMETER_PROFILE
+ -- | [NULL_EXCLUSION] access [protected] function
+ -- PARAMETER_AND_RESULT_PROFILE
-- PARAMETER_PROFILE ::= [FORMAL_PART]
-- PARAMETER_AND_RESULT_PROFILE ::= [FORMAL_PART] RETURN SUBTYPE_MARK
- -- The caller has checked that the initial token is ACCESS
+ -- Ada 2005 (AI-254): If Header_Already_Parsed then the caller has already
+ -- parsed the null_exclusion part and has also removed the ACCESS token;
+ -- otherwise the caller has just checked that the initial token is ACCESS
-- Error recovery: can raise Error_Resync
- function P_Access_Type_Definition return Node_Id is
- Prot_Flag : Boolean;
- Access_Loc : Source_Ptr;
- Not_Null_Present : Boolean := False;
- Type_Def_Node : Node_Id;
+ function P_Access_Type_Definition
+ (Header_Already_Parsed : Boolean := False) return Node_Id is
+ Access_Loc : constant Source_Ptr := Token_Ptr;
+ Prot_Flag : Boolean;
+ Not_Null_Present : Boolean := False;
+ Type_Def_Node : Node_Id;
procedure Check_Junk_Subprogram_Name;
-- Used in access to subprogram definition cases to check for an
-- Start of processing for P_Access_Type_Definition
begin
- if Extensions_Allowed then -- Ada 0Y (AI-231)
- Not_Null_Present := P_Null_Exclusion;
+ if not Header_Already_Parsed then
+ Not_Null_Present := P_Null_Exclusion; -- Ada 2005 (AI-231)
+ Scan; -- past ACCESS
end if;
- Access_Loc := Token_Ptr;
- Scan; -- past ACCESS
-
if Token_Name = Name_Protected then
Check_95_Keyword (Tok_Protected, Tok_Procedure);
Check_95_Keyword (Tok_Protected, Tok_Function);
end if;
if Token = Tok_Procedure then
- if Ada_83 then
+ if Ada_Version = Ada_83 then
Error_Msg_SC ("(Ada 83) access to procedure not allowed!");
end if;
Set_Protected_Present (Type_Def_Node, Prot_Flag);
elsif Token = Tok_Function then
- if Ada_83 then
+ if Ada_Version = Ada_83 then
Error_Msg_SC ("(Ada 83) access to function not allowed!");
end if;
Set_Null_Exclusion_Present (Type_Def_Node, Not_Null_Present);
if Token = Tok_All or else Token = Tok_Constant then
- if Ada_83 then
+ if Ada_Version = Ada_83 then
Error_Msg_SC ("(Ada 83) access modifier not allowed!");
end if;
-- 3.10 Access Definition --
-----------------------------
- -- ACCESS_DEFINITION ::= access SUBTYPE_MARK
+ -- ACCESS_DEFINITION ::=
+ -- [NULL_EXCLUSION] access [GENERAL_ACCESS_MODIFIER] SUBTYPE_MARK
+ -- | ACCESS_TO_SUBPROGRAM_DEFINITION
+ --
+ -- ACCESS_TO_SUBPROGRAM_DEFINITION
+ -- [NULL_EXCLUSION] access [protected] procedure PARAMETER_PROFILE
+ -- | [NULL_EXCLUSION] access [protected] function
+ -- PARAMETER_AND_RESULT_PROFILE
- -- The caller has checked that the initial token is ACCESS
+ -- The caller has parsed the null-exclusion part and it has also checked
+ -- that the next token is ACCESS
-- Error recovery: cannot raise Error_Resync
- function P_Access_Definition return Node_Id is
- Def_Node : Node_Id;
+ function P_Access_Definition
+ (Null_Exclusion_Present : Boolean) return Node_Id is
+ Def_Node : Node_Id;
+ Subp_Node : Node_Id;
begin
Def_Node := New_Node (N_Access_Definition, Token_Ptr);
Scan; -- past ACCESS
- -- Ada 0Y (AI-231): ACCESS [general_access_modifier] subtype_mark
+ -- Ada 2005 (AI-254/AI-231)
- if Extensions_Allowed then
- if Token = Tok_All then
- Scan; -- past ALL
- Set_All_Present (Def_Node);
+ if Ada_Version >= Ada_05 then
- elsif Token = Tok_Constant then
- Scan; -- past CONSTANT
- Set_Constant_Present (Def_Node);
+ -- Ada 2005 (AI-254): Access_To_Subprogram_Definition
+
+ if Token = Tok_Protected
+ or else Token = Tok_Procedure
+ or else Token = Tok_Function
+ then
+ Subp_Node :=
+ P_Access_Type_Definition (Header_Already_Parsed => True);
+ Set_Null_Exclusion_Present (Subp_Node, Null_Exclusion_Present);
+ Set_Access_To_Subprogram_Definition (Def_Node, Subp_Node);
+
+ -- Ada 2005 (AI-231)
+ -- [NULL_EXCLUSION] access [GENERAL_ACCESS_MODIFIER] SUBTYPE_MARK
+
+ else
+ Set_Null_Exclusion_Present (Def_Node, Null_Exclusion_Present);
+
+ if Token = Tok_All then
+ Scan; -- past ALL
+ Set_All_Present (Def_Node);
+
+ elsif Token = Tok_Constant then
+ Scan; -- past CONSTANT
+ Set_Constant_Present (Def_Node);
+ end if;
+
+ Set_Subtype_Mark (Def_Node, P_Subtype_Mark);
+ No_Constraint;
end if;
+
+ -- Ada 95
+
+ else
+ -- Ada 2005 (AI-254): The null-exclusion present is never present
+ -- in Ada 83 and Ada 95
+
+ pragma Assert (Null_Exclusion_Present = False);
+
+ Set_Null_Exclusion_Present (Def_Node, False);
+ Set_Subtype_Mark (Def_Node, P_Subtype_Mark);
+ No_Constraint;
end if;
- Set_Subtype_Mark (Def_Node, P_Subtype_Mark);
- No_Constraint;
return Def_Node;
end P_Access_Definition;
OSDN Git Service
