-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2012, 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- --
elsif Nkind_In (N, N_In, N_Not_In)
and then Paren_Count (N) = 0
then
- Error_Msg_N
- ("|this expression must be parenthesized in Ada 2012 mode!", N);
+ Error_Msg_N ("|this expression must be parenthesized!", N);
end if;
end Check_Restricted_Expression;
-- we set Force_Msg to True, since we want at least one message for each
-- separate declaration (but not use) of a reserved identifier.
- if Token = Tok_Identifier then
-
- -- Ada 2005 (AI-284): Compiling in Ada95 mode we warn that INTERFACE,
- -- OVERRIDING, and SYNCHRONIZED are new reserved words. Note that
- -- in the case where these keywords are misused in Ada 95 mode,
- -- this routine will generally not be called at all.
+ -- Duplication should be removed, common code should be factored???
- if Ada_Version = Ada_95
- and then Warn_On_Ada_2005_Compatibility
- then
- if Token_Name = Name_Overriding
- or else Token_Name = Name_Synchronized
- or else (Token_Name = Name_Interface
- and then Prev_Token /= Tok_Pragma)
- then
- Error_Msg_N ("& is a reserved word in Ada 2005?", Token_Node);
- end if;
- end if;
+ if Token = Tok_Identifier then
+ Check_Future_Keyword;
-- If we have a reserved identifier, manufacture an identifier with
-- a corresponding name after posting an appropriate error message
-- and we need to fix it.
if Nkind (Ident_Node) = N_Defining_Identifier then
- Ident_Node :=
- Make_Identifier (Sloc (Ident_Node),
- Chars => Chars (Ident_Node));
+ Ident_Node := Make_Identifier (Sloc (Ident_Node), Chars (Ident_Node));
end if;
-- Change identifier to defining identifier if not in error
-- | PRIVATE_EXTENSION_DECLARATION
-- FULL_TYPE_DECLARATION ::=
- -- type DEFINING_IDENTIFIER [KNOWN_DISCRIMINANT_PART] is TYPE_DEFINITION;
+ -- type DEFINING_IDENTIFIER [KNOWN_DISCRIMINANT_PART] is TYPE_DEFINITION
+ -- [ASPECT_SPECIFICATIONS];
-- | CONCURRENT_TYPE_DECLARATION
-- INCOMPLETE_TYPE_DECLARATION ::=
-- Error recovery: can raise Error_Resync
- -- Note: The processing for full type declaration, incomplete type
- -- declaration, private type declaration and type definition is
- -- included in this function. The processing for concurrent type
- -- declarations is NOT here, but rather in chapter 9 (i.e. this
- -- function handles only declarations starting with TYPE).
+ -- The processing for full type declarations, incomplete type declarations,
+ -- private type declarations and type definitions is included in this
+ -- function. The processing for concurrent type declarations is NOT here,
+ -- but rather in chapter 9 (this function handles only declarations
+ -- starting with TYPE).
function P_Type_Declaration return Node_Id is
Abstract_Present : Boolean := False;
Type_Start_Col : Column_Number;
Unknown_Dis : Boolean;
- Typedef_Node : Node_Id;
+ Typedef_Node : Node_Id;
-- Normally holds type definition, except in the case of a private
-- extension declaration, in which case it holds the declaration itself
when Tok_Access |
Tok_Not => -- Ada 2005 (AI-231)
Typedef_Node := P_Access_Type_Definition;
- TF_Semicolon;
exit;
when Tok_Array =>
Typedef_Node := P_Array_Type_Definition;
- TF_Semicolon;
exit;
when Tok_Delta =>
Typedef_Node := P_Fixed_Point_Definition;
- TF_Semicolon;
exit;
when Tok_Digits =>
Typedef_Node := P_Floating_Point_Definition;
- TF_Semicolon;
exit;
when Tok_In =>
when Tok_Integer_Literal =>
T_Range;
Typedef_Node := P_Signed_Integer_Type_Definition;
- TF_Semicolon;
exit;
when Tok_Null =>
Typedef_Node := P_Record_Definition;
- TF_Semicolon;
exit;
when Tok_Left_Paren =>
Typedef_Node := P_Enumeration_Type_Definition;
- End_Labl :=
- Make_Identifier (Token_Ptr,
- Chars => Chars (Ident_Node));
+ End_Labl := Make_Identifier (Token_Ptr, Chars (Ident_Node));
Set_Comes_From_Source (End_Labl, False);
Set_End_Label (Typedef_Node, End_Labl);
- TF_Semicolon;
exit;
when Tok_Mod =>
Typedef_Node := P_Modular_Type_Definition;
- TF_Semicolon;
exit;
when Tok_New =>
if Nkind (Typedef_Node) = N_Derived_Type_Definition
and then Present (Record_Extension_Part (Typedef_Node))
then
- End_Labl :=
- Make_Identifier (Token_Ptr,
- Chars => Chars (Ident_Node));
+ End_Labl := Make_Identifier (Token_Ptr, Chars (Ident_Node));
Set_Comes_From_Source (End_Labl, False);
Set_End_Label
(Record_Extension_Part (Typedef_Node), End_Labl);
end if;
- TF_Semicolon;
exit;
when Tok_Range =>
Typedef_Node := P_Signed_Integer_Type_Definition;
- TF_Semicolon;
exit;
when Tok_Record =>
Typedef_Node := P_Record_Definition;
- End_Labl :=
- Make_Identifier (Token_Ptr,
- Chars => Chars (Ident_Node));
+ End_Labl := Make_Identifier (Token_Ptr, Chars (Ident_Node));
Set_Comes_From_Source (End_Labl, False);
Set_End_Label (Typedef_Node, End_Labl);
- TF_Semicolon;
exit;
when Tok_Tagged =>
Set_Limited_Present (Typedef_Node, True);
End_Labl :=
- Make_Identifier (Token_Ptr,
- Chars => Chars (Ident_Node));
+ Make_Identifier (Token_Ptr, Chars (Ident_Node));
Set_Comes_From_Source (End_Labl, False);
Set_End_Label (Typedef_Node, End_Labl);
Set_Tagged_Present (Typedef_Node, True);
End_Labl :=
- Make_Identifier (Token_Ptr,
- Chars => Chars (Ident_Node));
+ Make_Identifier (Token_Ptr, Chars (Ident_Node));
Set_Comes_From_Source (End_Labl, False);
Set_End_Label (Typedef_Node, End_Labl);
end if;
end if;
- TF_Semicolon;
exit;
when Tok_Limited =>
Error_Msg_SP
("(Ada 83) limited record declaration not allowed!");
- -- In Ada2005, "abstract limited" can appear before "new",
+ -- In Ada 2005, "abstract limited" can appear before "new",
-- but it cannot be part of an untagged record declaration.
elsif Abstract_Present
and then Present (Record_Extension_Part (Typedef_Node))
then
End_Labl :=
- Make_Identifier (Token_Ptr,
- Chars => Chars (Ident_Node));
+ Make_Identifier (Token_Ptr, Chars (Ident_Node));
Set_Comes_From_Source (End_Labl, False);
Set_End_Label
T_Private; -- past PRIVATE (or complain if not there!)
end if;
- TF_Semicolon;
exit;
-- Here we have an identifier after the IS, which is certainly
if not Token_Is_At_Start_Of_Line then
Typedef_Node := P_Derived_Type_Def_Or_Private_Ext_Decl;
- TF_Semicolon;
-- If the identifier is at the start of the line, and is in the
-- same column as the type declaration itself then we consider
else
Typedef_Node := P_Record_Definition;
- TF_Semicolon;
end if;
exit;
when Tok_Interface =>
Typedef_Node := P_Interface_Type_Definition (Abstract_Present);
Abstract_Present := True;
- TF_Semicolon;
exit;
when Tok_Private =>
Decl_Node := New_Node (N_Private_Type_Declaration, Type_Loc);
Scan; -- past PRIVATE
- TF_Semicolon;
+
+ -- Check error cases of private [abstract] tagged
+
+ if Token = Tok_Abstract then
+ Error_Msg_SC ("`ABSTRACT TAGGED` must come before PRIVATE");
+ Scan; -- past ABSTRACT
+
+ if Token = Tok_Tagged then
+ Scan; -- past TAGGED
+ end if;
+
+ elsif Token = Tok_Tagged then
+ Error_Msg_SC ("TAGGED must come before PRIVATE");
+ Scan; -- past TAGGED
+ end if;
+
exit;
-- Ada 2005 (AI-345): Protected, synchronized or task interface
end if;
end;
- TF_Semicolon;
exit;
-- Anything else is an error
Set_Defining_Identifier (Decl_Node, Ident_Node);
Set_Discriminant_Specifications (Decl_Node, Discr_List);
+ P_Aspect_Specifications (Decl_Node);
return Decl_Node;
end P_Type_Declaration;
--------------------------------
-- SUBTYPE_DECLARATION ::=
- -- subtype DEFINING_IDENTIFIER is [NULL_EXCLUSION] SUBTYPE_INDICATION;
+ -- subtype DEFINING_IDENTIFIER is [NULL_EXCLUSION] SUBTYPE_INDICATION
+ -- {ASPECT_SPECIFICATIONS];
-- The caller has checked that the initial token is SUBTYPE
Set_Subtype_Indication
(Decl_Node, P_Subtype_Indication (Not_Null_Present));
- TF_Semicolon;
+ P_Aspect_Specifications (Decl_Node);
return Decl_Node;
end P_Subtype_Declaration;
begin
Constr_Node := P_Constraint_Opt;
- if No (Constr_Node) then
+ if No (Constr_Node)
+ or else
+ (Nkind (Constr_Node) = N_Range_Constraint
+ and then Nkind (Range_Expression (Constr_Node)) = N_Error)
+ then
return Subtype_Mark;
else
if Not_Null_Present then
-- OBJECT_DECLARATION ::=
-- DEFINING_IDENTIFIER_LIST : [aliased] [constant]
- -- [NULL_EXCLUSION] SUBTYPE_INDICATION [:= EXPRESSION];
+ -- [NULL_EXCLUSION] SUBTYPE_INDICATION [:= EXPRESSION]
+ -- [ASPECT_SPECIFICATIONS];
-- | DEFINING_IDENTIFIER_LIST : [aliased] [constant]
- -- ACCESS_DEFINITION [:= EXPRESSION];
+ -- ACCESS_DEFINITION [:= EXPRESSION]
+ -- [ASPECT_SPECIFICATIONS];
-- | DEFINING_IDENTIFIER_LIST : [aliased] [constant]
- -- ARRAY_TYPE_DEFINITION [:= EXPRESSION];
+ -- ARRAY_TYPE_DEFINITION [:= EXPRESSION]
+ -- [ASPECT_SPECIFICATIONS];
-- NUMBER_DECLARATION ::=
-- DEFINING_IDENTIFIER_LIST : constant ::= static_EXPRESSION;
-- DEFINING_IDENTIFIER : exception renames exception_NAME;
-- EXCEPTION_DECLARATION ::=
- -- DEFINING_IDENTIFIER_LIST : exception;
+ -- DEFINING_IDENTIFIER_LIST : exception
+ -- [ASPECT_SPECIFICATIONS];
-- Note that the ALIASED indication in an object declaration is
-- marked by a flag in the parent node.
end if;
end if;
- TF_Semicolon;
Set_Defining_Identifier (Decl_Node, Idents (Ident));
+ P_Aspect_Specifications (Decl_Node);
if List_OK then
if Ident < Num_Idents then
-- missing in the case of "type X is new Y record ..." or in the
-- case of "type X is new Y null record".
- if Token = Tok_With
+ -- First make sure we don't have an aspect specification. If we do
+ -- return now, so that our caller can check it (the WITH here is not
+ -- part of a type extension).
+
+ if Aspect_Specifications_Present then
+ return Typedef_Node;
+
+ -- OK, not an aspect specification, so continue test for extension
+
+ elsif Token = Tok_With
or else Token = Tok_Record
or else Token = Tok_Null
then
Scan; -- past RANGE
end if;
- Expr_Node := P_Expression;
- Check_Simple_Expression (Expr_Node);
- Set_Low_Bound (Typedef_Node, Expr_Node);
- T_Dot_Dot;
- Expr_Node := P_Expression;
- Check_Simple_Expression (Expr_Node);
- Set_High_Bound (Typedef_Node, Expr_Node);
+ Expr_Node := P_Expression_Or_Range_Attribute;
+
+ -- Range case (not permitted by the grammar, this is surprising but
+ -- the grammar in the RM is as quoted above, and does not allow Range).
+
+ if Expr_Form = EF_Range_Attr then
+ Error_Msg_N
+ ("Range attribute not allowed here, use First .. Last", Expr_Node);
+ Set_Low_Bound (Typedef_Node, Expr_Node);
+ Set_Attribute_Name (Expr_Node, Name_First);
+ Set_High_Bound (Typedef_Node, Copy_Separate_Tree (Expr_Node));
+ Set_Attribute_Name (High_Bound (Typedef_Node), Name_Last);
+
+ -- Normal case of explicit range
+
+ else
+ Check_Simple_Expression (Expr_Node);
+ Set_Low_Bound (Typedef_Node, Expr_Node);
+ T_Dot_Dot;
+ Expr_Node := P_Expression;
+ Check_Simple_Expression (Expr_Node);
+ Set_High_Bound (Typedef_Node, Expr_Node);
+ end if;
+
return Typedef_Node;
end P_Signed_Integer_Type_Definition;
-- Note: this is an obsolescent feature in Ada 95 (I.3)
-- Note: in Ada 83, the EXPRESSION must be a SIMPLE_EXPRESSION
+ -- (also true in formal modes).
-- The caller has checked that the initial token is DELTA
Scan; -- past DELTA
Expr_Node := P_Expression;
Check_Simple_Expression_In_Ada_83 (Expr_Node);
+
Set_Delta_Expression (Constraint_Node, Expr_Node);
if Token = Tok_Range then
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;
+ -- AI95-406 makes "aliased" legal (and useless) in this context so
+ -- followintg code which used to be needed is commented out.
+
+ -- 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_High_Bound (Range_Node, Expr_Node);
return Range_Node;
- -- Otherwise we must have a subtype mark
+ -- Otherwise we must have a subtype mark, or an Ada 2012 iterator
elsif Expr_Form = EF_Simple_Name then
return Expr_Node;
+ -- The domain of iteration must be a name. Semantics will determine that
+ -- the expression has the proper form.
+
+ elsif Ada_Version >= Ada_2012 then
+ return Expr_Node;
+
-- If incorrect, complain that we expect ..
else
-- COMPONENT_DECLARATION ::=
-- DEFINING_IDENTIFIER_LIST : COMPONENT_DEFINITION
- -- [:= DEFAULT_EXPRESSION];
+ -- [:= DEFAULT_EXPRESSION]
+ -- [ASPECT_SPECIFICATIONS];
-- COMPONENT_DEFINITION ::=
-- [aliased] [NULL_EXCLUSION] SUBTYPE_INDICATION | ACCESS_DEFINITION
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;
+ -- AI95-406 makes "aliased" legal (and useless) here, so the
+ -- following code which used to be required is commented out.
+
+ -- 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);
Ident := Ident + 1;
Restore_Scan_State (Scan_State);
T_Colon;
-
end loop Ident_Loop;
- TF_Semicolon;
+ P_Aspect_Specifications (Decl_Node);
end P_Component_Items;
--------------------------------
else
-- In Ada 2012 mode, the expression must be a simple
- -- expression. The resaon for this restriction (i.e. going
+ -- expression. The reason for this restriction (i.e. going
-- back to the Ada 83 rule) is to avoid ambiguities when set
-- membership operations are allowed, consider the
-- following:
-- when A in 1 .. 10 | 12 =>
-- This is ambiguous without parentheses, so we require one
- -- of the following two parenthesized forms to disambuguate:
+ -- of the following two parenthesized forms to disambiguate:
-- one of the following:
end if;
if Token = Tok_Comma then
- Error_Msg_SC -- CODEFIX
- (""","" should be ""'|""");
+ Scan; -- past comma
+
+ if Token = Tok_Vertical_Bar then
+ Error_Msg_SP -- CODEFIX
+ ("|extra "","" ignored");
+ Scan; -- past |
+
+ else
+ Error_Msg_SP -- CODEFIX
+ (""","" should be ""'|""");
+ end if;
+
else
exit when Token /= Tok_Vertical_Bar;
+ Scan; -- past |
end if;
- Scan; -- past | or comma
end loop;
return Choices;
-- Ada 2005 (AI-345): In case of interfaces with a null list of
-- interfaces we build a record_definition node.
- if Token = Tok_Semicolon then
+ if Token = Tok_Semicolon or else Aspect_Specifications_Present then
Typedef_Node := New_Node (N_Record_Definition, Token_Ptr);
Set_Abstract_Present (Typedef_Node);
P_Identifier_Declarations (Decls, Done, In_Spec);
end if;
- -- Ada2005: A subprogram declaration can start with "not" or
+ -- Ada 2005: A subprogram declaration can start with "not" or
-- "overriding". In older versions, "overriding" is handled
-- like an identifier, with the appropriate messages.
when Tok_With =>
Check_Bad_Layout;
- Error_Msg_SC ("WITH can only appear in context clause");
- raise Error_Resync;
+
+ if Aspect_Specifications_Present then
+
+ -- If we are after a semicolon, complain that it was ignored.
+ -- But we don't really ignore it, since we dump the aspects,
+ -- so we make the error message a normal fatal message which
+ -- will inhibit semantic analysis anyway).
+
+ if Prev_Token = Tok_Semicolon then
+ Error_Msg_SP -- CODEFIX
+ ("extra "";"" ignored");
+
+ -- If not just past semicolon, just complain that aspects are
+ -- not allowed at this point.
+
+ else
+ Error_Msg_SC ("aspect specifications not allowed here");
+ end if;
+
+ declare
+ Dummy_Node : constant Node_Id :=
+ New_Node (N_Package_Specification, Token_Ptr);
+ pragma Warnings (Off, Dummy_Node);
+ -- Dummy node to attach aspect specifications to. We will
+ -- then throw them away.
+
+ begin
+ P_Aspect_Specifications (Dummy_Node, Semicolon => True);
+ end;
+
+ -- Here if not aspect specifications case
+
+ else
+ Error_Msg_SC ("WITH can only appear in context clause");
+ raise Error_Resync;
+ end if;
-- BEGIN terminates the scan of a sequence of declarations unless
-- there is a missing subprogram body, see section on handling