--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/gcc/ada/par-ch3.adb	Fri Oct 27 22:46:09 2017 +0900
@@ -0,0 +1,4894 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                              P A R . C H 3                               --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--          Copyright (C) 1992-2017, 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 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 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.
+
+with Sinfo.CN; use Sinfo.CN;
+
+separate (Par)
+
+---------
+-- Ch3 --
+---------
+
+package body Ch3 is
+
+   -----------------------
+   -- Local Subprograms --
+   -----------------------
+
+   function P_Component_List                               return Node_Id;
+   function P_Defining_Character_Literal                   return Node_Id;
+   function P_Delta_Constraint                             return Node_Id;
+   function P_Derived_Type_Def_Or_Private_Ext_Decl         return Node_Id;
+   function P_Digits_Constraint                            return Node_Id;
+   function P_Discriminant_Association                     return Node_Id;
+   function P_Enumeration_Literal_Specification            return Node_Id;
+   function P_Enumeration_Type_Definition                  return Node_Id;
+   function P_Fixed_Point_Definition                       return Node_Id;
+   function P_Floating_Point_Definition                    return Node_Id;
+   function P_Index_Or_Discriminant_Constraint             return Node_Id;
+   function P_Real_Range_Specification_Opt                 return Node_Id;
+   function P_Subtype_Declaration                          return Node_Id;
+   function P_Type_Declaration                             return Node_Id;
+   function P_Modular_Type_Definition                      return Node_Id;
+   function P_Variant                                      return Node_Id;
+   function P_Variant_Part                                 return Node_Id;
+
+   procedure Check_Restricted_Expression (N : Node_Id);
+   --  Check that the expression N meets the Restricted_Expression syntax.
+   --  The syntax is as follows:
+   --
+   --    RESTRICTED_EXPRESSION ::=
+   --        RESTRICTED_RELATION {and RESTRICTED_RELATION}
+   --      | RESTRICTED_RELATION {and then RESTRICTED_RELATION}
+   --      | RESTRICTED_RELATION {or RESTRICTED_RELATION}
+   --      | RESTRICTED_RELATION {or else RESTRICTED_RELATION}
+   --      | RESTRICTED_RELATION {xor RESTRICTED_RELATION}
+   --
+   --    RESTRICTED_RELATION ::=
+   --       SIMPLE_EXPRESSION [RELATIONAL_OPERATOR SIMPLE_EXPRESSION]
+   --
+   --  This syntax is used for choices when extensions (and set notations)
+   --  are enabled, to remove the ambiguity of "when X in A | B". We consider
+   --  it very unlikely that this will ever arise in practice.
+
+   procedure P_Declarative_Items
+     (Decls   : List_Id;
+      Done    : out Boolean;
+      In_Spec : Boolean);
+   --  Scans out a single declarative item, or, in the case of a declaration
+   --  with a list of identifiers, a list of declarations, one for each of the
+   --  identifiers in the list. The declaration or declarations scanned are
+   --  appended to the given list. Done indicates whether or not there may be
+   --  additional declarative items to scan. If Done is True, then a decision
+   --  has been made that there are no more items to scan. If Done is False,
+   --  then there may be additional declarations to scan. In_Spec is true if
+   --  we are scanning a package declaration, and is used to generate an
+   --  appropriate message if a statement is encountered in such a context.
+
+   procedure P_Identifier_Declarations
+     (Decls   : List_Id;
+      Done    : out Boolean;
+      In_Spec : Boolean);
+   --  Scans out a set of declarations for an identifier or list of
+   --  identifiers, and appends them to the given list. The parameters have
+   --  the same significance as for P_Declarative_Items.
+
+   procedure Statement_When_Declaration_Expected
+     (Decls   : List_Id;
+      Done    : out Boolean;
+      In_Spec : Boolean);
+   --  Called when a statement is found at a point where a declaration was
+   --  expected. The parameters are as described for P_Declarative_Items.
+
+   procedure Set_Declaration_Expected;
+   --  Posts a "declaration expected" error messages at the start of the
+   --  current token, and if this is the first such message issued, saves
+   --  the message id in Missing_Begin_Msg, for possible later replacement.
+
+   ---------------------------------
+   -- Check_Restricted_Expression --
+   ---------------------------------
+
+   procedure Check_Restricted_Expression (N : Node_Id) is
+   begin
+      if Nkind_In (N, N_Op_And, N_Op_Or, N_Op_Xor, N_And_Then, N_Or_Else) then
+         Check_Restricted_Expression (Left_Opnd (N));
+         Check_Restricted_Expression (Right_Opnd (N));
+
+      elsif Nkind_In (N, N_In, N_Not_In)
+        and then Paren_Count (N) = 0
+      then
+         Error_Msg_N ("|this expression must be parenthesized!", N);
+      end if;
+   end Check_Restricted_Expression;
+
+   -------------------
+   -- Init_Expr_Opt --
+   -------------------
+
+   function Init_Expr_Opt (P : Boolean := False) return Node_Id is
+   begin
+      --  For colon, assume it means := unless it is at the end of
+      --  a line, in which case guess that it means a semicolon.
+
+      if Token = Tok_Colon then
+         if Token_Is_At_End_Of_Line then
+            T_Semicolon;
+            return Empty;
+         end if;
+
+      --  Here if := or something that we will take as equivalent
+
+      elsif Token = Tok_Colon_Equal
+        or else Token = Tok_Equal
+        or else Token = Tok_Is
+      then
+         null;
+
+      --  Another possibility. If we have a literal followed by a semicolon,
+      --  we assume that we have a missing colon-equal.
+
+      elsif Token in Token_Class_Literal then
+         declare
+            Scan_State : Saved_Scan_State;
+
+         begin
+            Save_Scan_State (Scan_State);
+            Scan; -- past literal or identifier
+
+            if Token = Tok_Semicolon then
+               Restore_Scan_State (Scan_State);
+            else
+               Restore_Scan_State (Scan_State);
+               return Empty;
+            end if;
+         end;
+
+      --  Otherwise we definitely have no initialization expression
+
+      else
+         return Empty;
+      end if;
+
+      --  Merge here if we have an initialization expression
+
+      T_Colon_Equal;
+
+      if P then
+         return P_Expression;
+      else
+         return P_Expression_No_Right_Paren;
+      end if;
+   end Init_Expr_Opt;
+
+   ----------------------------
+   -- 3.1  Basic Declaration --
+   ----------------------------
+
+   --  Parsed by P_Basic_Declarative_Items (3.9)
+
+   ------------------------------
+   -- 3.1  Defining Identifier --
+   ------------------------------
+
+   --  DEFINING_IDENTIFIER ::= IDENTIFIER
+
+   --  Error recovery: can raise Error_Resync
+
+   function P_Defining_Identifier (C : Id_Check := None) return Node_Id is
+      Ident_Node : Node_Id;
+
+   begin
+      --  Scan out the identifier. Note that this code is essentially identical
+      --  to P_Identifier, except that in the call to Scan_Reserved_Identifier
+      --  we set Force_Msg to True, since we want at least one message for each
+      --  separate declaration (but not use) of a reserved identifier.
+
+      --  Duplication should be removed, common code should be factored???
+
+      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
+
+      elsif Is_Reserved_Identifier (C) then
+         Scan_Reserved_Identifier (Force_Msg => True);
+
+      --  Otherwise we have junk that cannot be interpreted as an identifier
+
+      else
+         T_Identifier; -- to give message
+         raise Error_Resync;
+      end if;
+
+      Ident_Node := Token_Node;
+      Scan; -- past the reserved identifier
+
+      --  If we already have a defining identifier, clean it out and make
+      --  a new clean identifier. This situation arises in some error cases
+      --  and we need to fix it.
+
+      if Nkind (Ident_Node) = N_Defining_Identifier then
+         Ident_Node := Make_Identifier (Sloc (Ident_Node), Chars (Ident_Node));
+      end if;
+
+      --  Change identifier to defining identifier if not in error
+
+      if Ident_Node /= Error then
+         Change_Identifier_To_Defining_Identifier (Ident_Node);
+
+         --  Warn if standard redefinition, except that we never warn on a
+         --  record field definition (since this is always a harmless case).
+
+         if not Inside_Record_Definition then
+            Warn_If_Standard_Redefinition (Ident_Node);
+         end if;
+      end if;
+
+      return Ident_Node;
+   end P_Defining_Identifier;
+
+   -----------------------------
+   -- 3.2.1  Type Declaration --
+   -----------------------------
+
+   --  TYPE_DECLARATION ::=
+   --    FULL_TYPE_DECLARATION
+   --  | INCOMPLETE_TYPE_DECLARATION
+   --  | PRIVATE_TYPE_DECLARATION
+   --  | PRIVATE_EXTENSION_DECLARATION
+
+   --  FULL_TYPE_DECLARATION ::=
+   --    type DEFINING_IDENTIFIER [KNOWN_DISCRIMINANT_PART] is TYPE_DEFINITION
+   --      [ASPECT_SPECIFICATIONS];
+   --  | CONCURRENT_TYPE_DECLARATION
+
+   --  INCOMPLETE_TYPE_DECLARATION ::=
+   --    type DEFINING_IDENTIFIER [DISCRIMINANT_PART] [is tagged];
+
+   --  PRIVATE_TYPE_DECLARATION ::=
+   --    type DEFINING_IDENTIFIER [DISCRIMINANT_PART]
+   --      is [abstract] [tagged] [limited] private
+   --        [ASPECT_SPECIFICATIONS];
+
+   --  PRIVATE_EXTENSION_DECLARATION ::=
+   --    type DEFINING_IDENTIFIER [DISCRIMINANT_PART] is
+   --      [abstract] [limited | synchronized]
+   --        new ancestor_SUBTYPE_INDICATION [and INTERFACE_LIST]
+   --          with private [ASPECT_SPECIFICATIONS];
+
+   --  TYPE_DEFINITION ::=
+   --    ENUMERATION_TYPE_DEFINITION  | INTEGER_TYPE_DEFINITION
+   --  | REAL_TYPE_DEFINITION         | ARRAY_TYPE_DEFINITION
+   --  | RECORD_TYPE_DEFINITION       | ACCESS_TYPE_DEFINITION
+   --  | DERIVED_TYPE_DEFINITION      | INTERFACE_TYPE_DEFINITION
+
+   --  INTEGER_TYPE_DEFINITION ::=
+   --    SIGNED_INTEGER_TYPE_DEFINITION
+   --    MODULAR_TYPE_DEFINITION
+
+   --  INTERFACE_TYPE_DEFINITION ::=
+   --    [limited | task | protected | synchronized ] interface
+   --      [and INTERFACE_LIST]
+
+   --  Error recovery: can raise Error_Resync
+
+   --  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;
+      Abstract_Loc     : Source_Ptr := No_Location;
+      Decl_Node        : Node_Id;
+      Discr_List       : List_Id;
+      Discr_Sloc       : Source_Ptr;
+      End_Labl         : Node_Id;
+      Ident_Node       : Node_Id;
+      Is_Derived_Iface : Boolean := False;
+      Type_Loc         : Source_Ptr;
+      Type_Start_Col   : Column_Number;
+      Unknown_Dis      : Boolean;
+
+      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
+
+   begin
+      Type_Loc := Token_Ptr;
+      Type_Start_Col := Start_Column;
+
+      --  If we have TYPE, then proceed ahead and scan identifier
+
+      if Token = Tok_Type then
+         Type_Token_Location := Type_Loc;
+         Scan; -- past TYPE
+         Ident_Node := P_Defining_Identifier (C_Is);
+
+      --  Otherwise this is an error case
+
+      else
+         T_Type;
+         Type_Token_Location := Type_Loc;
+         Ident_Node := P_Defining_Identifier (C_Is);
+      end if;
+
+      Discr_Sloc := Token_Ptr;
+
+      if P_Unknown_Discriminant_Part_Opt then
+         Unknown_Dis := True;
+         Discr_List := No_List;
+      else
+         Unknown_Dis := False;
+         Discr_List := P_Known_Discriminant_Part_Opt;
+      end if;
+
+      --  Incomplete type declaration. We complete the processing for this
+      --  case here and return the resulting incomplete type declaration node
+
+      if Token = Tok_Semicolon then
+         Scan; -- past ;
+         Decl_Node := New_Node (N_Incomplete_Type_Declaration, Type_Loc);
+         Set_Defining_Identifier (Decl_Node, Ident_Node);
+         Set_Unknown_Discriminants_Present (Decl_Node, Unknown_Dis);
+         Set_Discriminant_Specifications (Decl_Node, Discr_List);
+         return Decl_Node;
+
+      else
+         Decl_Node := Empty;
+      end if;
+
+      --  Full type declaration or private type declaration, must have IS
+
+      if Token = Tok_Equal then
+         TF_Is;
+         Scan; -- past = used in place of IS
+
+      elsif Token = Tok_Renames then
+         Error_Msg_SC  -- CODEFIX
+           ("RENAMES should be IS");
+         Scan; -- past RENAMES used in place of IS
+
+      else
+         TF_Is;
+      end if;
+
+      --  First an error check, if we have two identifiers in a row, a likely
+      --  possibility is that the first of the identifiers is an incorrectly
+      --  spelled keyword.
+
+      if Token = Tok_Identifier then
+         declare
+            SS : Saved_Scan_State;
+            I2 : Boolean;
+
+         begin
+            Save_Scan_State (SS);
+            Scan; -- past initial identifier
+            I2 := (Token = Tok_Identifier);
+            Restore_Scan_State (SS);
+
+            if I2
+              and then
+                (Bad_Spelling_Of (Tok_Abstract) or else
+                 Bad_Spelling_Of (Tok_Access)   or else
+                 Bad_Spelling_Of (Tok_Aliased)  or else
+                 Bad_Spelling_Of (Tok_Constant))
+            then
+               null;
+            end if;
+         end;
+      end if;
+
+      --  Check for misuse of Ada 95 keyword abstract in Ada 83 mode
+
+      if Token_Name = Name_Abstract then
+         Check_95_Keyword (Tok_Abstract, Tok_Tagged);
+         Check_95_Keyword (Tok_Abstract, Tok_New);
+      end if;
+
+      --  Check cases of misuse of ABSTRACT
+
+      if Token = Tok_Abstract then
+         Abstract_Present := True;
+         Abstract_Loc     := Token_Ptr;
+         Scan; -- past ABSTRACT
+
+         --  Ada 2005 (AI-419): AARM 3.4 (2/2)
+
+         if (Ada_Version < Ada_2005 and then Token = Tok_Limited)
+           or else Token = Tok_Private
+           or else Token = Tok_Record
+           or else Token = Tok_Null
+         then
+            Error_Msg_AP ("TAGGED expected");
+         end if;
+      end if;
+
+      --  Check for misuse of Ada 95 keyword Tagged
+
+      if Token_Name = Name_Tagged then
+         Check_95_Keyword (Tok_Tagged, Tok_Private);
+         Check_95_Keyword (Tok_Tagged, Tok_Limited);
+         Check_95_Keyword (Tok_Tagged, Tok_Record);
+      end if;
+
+      --  Special check for misuse of Aliased
+
+      if Token = Tok_Aliased or else Token_Name = Name_Aliased then
+         Error_Msg_SC ("ALIASED not allowed in type definition");
+         Scan; -- past ALIASED
+      end if;
+
+      --  The following processing deals with either a private type declaration
+      --  or a full type declaration. In the private type case, we build the
+      --  N_Private_Type_Declaration node, setting its Tagged_Present and
+      --  Limited_Present flags, on encountering the Private keyword, and
+      --  leave Typedef_Node set to Empty. For the full type declaration
+      --  case, Typedef_Node gets set to the type definition.
+
+      Typedef_Node := Empty;
+
+      --  Switch on token following the IS. The loop normally runs once. It
+      --  only runs more than once if an error is detected, to try again after
+      --  detecting and fixing up the error.
+
+      loop
+         case Token is
+            when Tok_Access
+               | Tok_Not  --  Ada 2005 (AI-231)
+            =>
+               Typedef_Node := P_Access_Type_Definition;
+               exit;
+
+            when Tok_Array =>
+               Typedef_Node := P_Array_Type_Definition;
+               exit;
+
+            when Tok_Delta =>
+               Typedef_Node := P_Fixed_Point_Definition;
+               exit;
+
+            when Tok_Digits =>
+               Typedef_Node := P_Floating_Point_Definition;
+               exit;
+
+            when Tok_In =>
+               Ignore (Tok_In);
+
+            when Tok_Integer_Literal =>
+               T_Range;
+               Typedef_Node := P_Signed_Integer_Type_Definition;
+               exit;
+
+            when Tok_Null =>
+               Typedef_Node := P_Record_Definition;
+               exit;
+
+            when Tok_Left_Paren =>
+               Typedef_Node := P_Enumeration_Type_Definition;
+
+               End_Labl := Make_Identifier (Token_Ptr, Chars (Ident_Node));
+               Set_Comes_From_Source (End_Labl, False);
+
+               Set_End_Label (Typedef_Node, End_Labl);
+               exit;
+
+            when Tok_Mod =>
+               Typedef_Node := P_Modular_Type_Definition;
+               exit;
+
+            when Tok_New =>
+               Typedef_Node := P_Derived_Type_Def_Or_Private_Ext_Decl;
+
+               if Nkind (Typedef_Node) = N_Derived_Type_Definition
+                 and then Present (Record_Extension_Part (Typedef_Node))
+               then
+                  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;
+
+               exit;
+
+            when Tok_Range =>
+               Typedef_Node := P_Signed_Integer_Type_Definition;
+               exit;
+
+            when Tok_Record =>
+               Typedef_Node := P_Record_Definition;
+
+               End_Labl := Make_Identifier (Token_Ptr, Chars (Ident_Node));
+               Set_Comes_From_Source (End_Labl, False);
+
+               Set_End_Label (Typedef_Node, End_Labl);
+               exit;
+
+            when Tok_Tagged =>
+               Scan; -- past TAGGED
+
+               --  Ada 2005 (AI-326): If the words IS TAGGED appear, the type
+               --  is a tagged incomplete type.
+
+               if Ada_Version >= Ada_2005
+                 and then Token = Tok_Semicolon
+               then
+                  Scan; -- past ;
+
+                  Decl_Node :=
+                    New_Node (N_Incomplete_Type_Declaration, Type_Loc);
+                  Set_Defining_Identifier           (Decl_Node, Ident_Node);
+                  Set_Tagged_Present                (Decl_Node);
+                  Set_Unknown_Discriminants_Present (Decl_Node, Unknown_Dis);
+                  Set_Discriminant_Specifications   (Decl_Node, Discr_List);
+
+                  return Decl_Node;
+               end if;
+
+               if Token = Tok_Abstract then
+                  Error_Msg_SC -- CODEFIX
+                    ("ABSTRACT must come before TAGGED");
+                  Abstract_Present := True;
+                  Abstract_Loc := Token_Ptr;
+                  Scan; -- past ABSTRACT
+               end if;
+
+               if Token = Tok_Limited then
+                  Scan; -- past LIMITED
+
+                  --  TAGGED LIMITED PRIVATE case
+
+                  if Token = Tok_Private then
+                     Decl_Node :=
+                       New_Node (N_Private_Type_Declaration, Type_Loc);
+                     Set_Tagged_Present (Decl_Node, True);
+                     Set_Limited_Present (Decl_Node, True);
+                     Scan; -- past PRIVATE
+
+                  --  TAGGED LIMITED RECORD
+
+                  else
+                     Typedef_Node := P_Record_Definition;
+                     Set_Tagged_Present (Typedef_Node, True);
+                     Set_Limited_Present (Typedef_Node, True);
+
+                     End_Labl :=
+                       Make_Identifier (Token_Ptr, Chars (Ident_Node));
+                     Set_Comes_From_Source (End_Labl, False);
+
+                     Set_End_Label (Typedef_Node, End_Labl);
+                  end if;
+
+               else
+                  --  TAGGED PRIVATE
+
+                  if Token = Tok_Private then
+                     Decl_Node :=
+                       New_Node (N_Private_Type_Declaration, Type_Loc);
+                     Set_Tagged_Present (Decl_Node, True);
+                     Scan; -- past PRIVATE
+
+                  --  TAGGED RECORD
+
+                  else
+                     Typedef_Node := P_Record_Definition;
+                     Set_Tagged_Present (Typedef_Node, True);
+
+                     End_Labl :=
+                       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;
+
+               exit;
+
+            when Tok_Limited =>
+               Scan; -- past LIMITED
+
+               loop
+                  if Token = Tok_Tagged then
+                     Error_Msg_SC -- CODEFIX
+                       ("TAGGED must come before LIMITED");
+                     Scan; -- past TAGGED
+
+                  elsif Token = Tok_Abstract then
+                     Error_Msg_SC -- CODEFIX
+                       ("ABSTRACT must come before LIMITED");
+                     Scan; -- past ABSTRACT
+
+                  else
+                     exit;
+                  end if;
+               end loop;
+
+               --  LIMITED RECORD or LIMITED NULL RECORD
+
+               if Token = Tok_Record or else Token = Tok_Null then
+                  if Ada_Version = Ada_83 then
+                     Error_Msg_SP
+                       ("(Ada 83) limited record declaration not allowed!");
+
+                  --  In Ada 2005, "abstract limited" can appear before "new",
+                  --  but it cannot be part of an untagged record declaration.
+
+                  elsif Abstract_Present
+                    and then Prev_Token /= Tok_Tagged
+                  then
+                     Error_Msg_SP ("TAGGED expected");
+                  end if;
+
+                  Typedef_Node := P_Record_Definition;
+                  Set_Limited_Present (Typedef_Node, True);
+                  End_Labl := Make_Identifier (Token_Ptr, Chars (Ident_Node));
+                  Set_Comes_From_Source (End_Labl, False);
+
+                  Set_End_Label (Typedef_Node, End_Labl);
+
+               --  Ada 2005 (AI-251): LIMITED INTERFACE
+
+               --  If we are compiling in Ada 83 or Ada 95 mode, "interface"
+               --  is not a reserved word but we force its analysis to
+               --  generate the corresponding usage error.
+
+               elsif Token = Tok_Interface
+                 or else (Token = Tok_Identifier
+                           and then Chars (Token_Node) = Name_Interface)
+               then
+                  Typedef_Node :=
+                    P_Interface_Type_Definition (Abstract_Present);
+                  Abstract_Present := True;
+                  Set_Limited_Present (Typedef_Node);
+
+                  if Nkind (Typedef_Node) = N_Derived_Type_Definition then
+                     Is_Derived_Iface := True;
+                  end if;
+
+                  --  Ada 2005 (AI-419): LIMITED NEW
+
+               elsif Token = Tok_New then
+                  if Ada_Version < Ada_2005 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;
+
+                  Typedef_Node := P_Derived_Type_Def_Or_Private_Ext_Decl;
+                  Set_Limited_Present (Typedef_Node);
+
+                  if Nkind (Typedef_Node) = N_Derived_Type_Definition
+                    and then Present (Record_Extension_Part (Typedef_Node))
+                  then
+                     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;
+
+               --  LIMITED PRIVATE is the only remaining possibility here
+
+               else
+                  Decl_Node := New_Node (N_Private_Type_Declaration, Type_Loc);
+                  Set_Limited_Present (Decl_Node, True);
+                  T_Private; -- past PRIVATE (or complain if not there)
+               end if;
+
+               exit;
+
+            --  Here we have an identifier after the IS, which is certainly
+            --  wrong and which might be one of several different mistakes.
+
+            when Tok_Identifier =>
+
+               --  First case, if identifier is on same line, then probably we
+               --  have something like "type X is Integer .." and the best
+               --  diagnosis is a missing NEW. Note: the missing new message
+               --  will be posted by P_Derived_Type_Def_Or_Private_Ext_Decl.
+
+               if not Token_Is_At_Start_Of_Line then
+                  Typedef_Node := P_Derived_Type_Def_Or_Private_Ext_Decl;
+
+               --  If the identifier is at the start of the line, and is in the
+               --  same column as the type declaration itself then we consider
+               --  that we had a missing type definition on the previous line
+
+               elsif Start_Column <= Type_Start_Col then
+                  Error_Msg_AP ("type definition expected");
+                  Typedef_Node := Error;
+
+               --  If the identifier is at the start of the line, and is in
+               --  a column to the right of the type declaration line, then we
+               --  may have something like:
+
+               --    type x is
+               --       r : integer
+
+               --  and the best diagnosis is a missing record keyword
+
+               else
+                  Typedef_Node := P_Record_Definition;
+               end if;
+
+               exit;
+
+            --  Ada 2005 (AI-251): INTERFACE
+
+            when Tok_Interface =>
+               Typedef_Node := P_Interface_Type_Definition (Abstract_Present);
+               Abstract_Present := True;
+               exit;
+
+            when Tok_Private =>
+               Decl_Node := New_Node (N_Private_Type_Declaration, Type_Loc);
+               Scan; -- past PRIVATE
+
+               --  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
+            --  or Ada 2005 (AI-443): Synchronized private extension.
+
+            when Tok_Protected
+               | Tok_Synchronized
+               | Tok_Task
+            =>
+               declare
+                  Saved_Token : constant Token_Type := Token;
+
+               begin
+                  Scan; -- past TASK, PROTECTED or SYNCHRONIZED
+
+                  --  Synchronized private extension
+
+                  if Token = Tok_New then
+                     Typedef_Node := P_Derived_Type_Def_Or_Private_Ext_Decl;
+
+                     if Saved_Token = Tok_Synchronized then
+                        if Nkind (Typedef_Node) =
+                          N_Derived_Type_Definition
+                        then
+                           Error_Msg_N
+                             ("SYNCHRONIZED not allowed for record extension",
+                              Typedef_Node);
+                        else
+                           Set_Synchronized_Present (Typedef_Node);
+                        end if;
+
+                     else
+                        Error_Msg_SC ("invalid kind of private extension");
+                     end if;
+
+                  --  Interface
+
+                  else
+                     if Token /= Tok_Interface then
+                        Error_Msg_SC ("NEW or INTERFACE expected");
+                     end if;
+
+                     Typedef_Node :=
+                       P_Interface_Type_Definition (Abstract_Present);
+                     Abstract_Present := True;
+
+                     case Saved_Token is
+                        when Tok_Task =>
+                           Set_Task_Present         (Typedef_Node);
+
+                        when Tok_Protected =>
+                           Set_Protected_Present    (Typedef_Node);
+
+                        when Tok_Synchronized =>
+                           Set_Synchronized_Present (Typedef_Node);
+
+                        when others =>
+                           pragma Assert (False);
+                           null;
+                     end case;
+                  end if;
+               end;
+
+               exit;
+
+            --  Anything else is an error
+
+            when others =>
+               if Bad_Spelling_Of (Tok_Access)
+                    or else
+                  Bad_Spelling_Of (Tok_Array)
+                    or else
+                  Bad_Spelling_Of (Tok_Delta)
+                    or else
+                  Bad_Spelling_Of (Tok_Digits)
+                    or else
+                  Bad_Spelling_Of (Tok_Limited)
+                    or else
+                  Bad_Spelling_Of (Tok_Private)
+                    or else
+                  Bad_Spelling_Of (Tok_Range)
+                    or else
+                  Bad_Spelling_Of (Tok_Record)
+                    or else
+                  Bad_Spelling_Of (Tok_Tagged)
+               then
+                  null;
+
+               else
+                  Error_Msg_AP ("type definition expected");
+                  raise Error_Resync;
+               end if;
+         end case;
+      end loop;
+
+      --  For the private type declaration case, the private type declaration
+      --  node has been built, with the Tagged_Present and Limited_Present
+      --  flags set as needed, and Typedef_Node is left set to Empty.
+
+      if No (Typedef_Node) then
+         Set_Unknown_Discriminants_Present (Decl_Node, Unknown_Dis);
+         Set_Abstract_Present (Decl_Node, Abstract_Present);
+
+      --  For a private extension declaration, Typedef_Node contains the
+      --  N_Private_Extension_Declaration node, which we now complete. Note
+      --  that the private extension declaration, unlike a full type
+      --  declaration, does permit unknown discriminants.
+
+      elsif Nkind (Typedef_Node) = N_Private_Extension_Declaration then
+         Decl_Node := Typedef_Node;
+         Set_Sloc (Decl_Node, Type_Loc);
+         Set_Unknown_Discriminants_Present (Decl_Node, Unknown_Dis);
+         Set_Abstract_Present (Typedef_Node, Abstract_Present);
+
+      --  In the full type declaration case, Typedef_Node has the type
+      --  definition and here is where we build the full type declaration
+      --  node. This is also where we check for improper use of an unknown
+      --  discriminant part (not allowed for full type declaration).
+
+      else
+         if Nkind (Typedef_Node) = N_Record_Definition
+           or else (Nkind (Typedef_Node) = N_Derived_Type_Definition
+                      and then Present (Record_Extension_Part (Typedef_Node)))
+           or else Is_Derived_Iface
+         then
+            Set_Abstract_Present (Typedef_Node, Abstract_Present);
+
+         elsif Abstract_Present then
+            Error_Msg ("ABSTRACT not allowed here, ignored", Abstract_Loc);
+         end if;
+
+         Decl_Node := New_Node (N_Full_Type_Declaration, Type_Loc);
+         Set_Type_Definition (Decl_Node, Typedef_Node);
+
+         if Unknown_Dis then
+            Error_Msg
+              ("Full type declaration cannot have unknown discriminants",
+                Discr_Sloc);
+         end if;
+      end if;
+
+      --  Remaining processing is common for all three cases
+
+      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;
+
+   ----------------------------------
+   -- 3.2.1  Full Type Declaration --
+   ----------------------------------
+
+   --  Parsed by P_Type_Declaration (3.2.1)
+
+   ----------------------------
+   -- 3.2.1  Type Definition --
+   ----------------------------
+
+   --  Parsed by P_Type_Declaration (3.2.1)
+
+   --------------------------------
+   -- 3.2.2  Subtype Declaration --
+   --------------------------------
+
+   --  SUBTYPE_DECLARATION ::=
+   --    subtype DEFINING_IDENTIFIER is [NULL_EXCLUSION] SUBTYPE_INDICATION
+   --      [ASPECT_SPECIFICATIONS];
+
+   --  The caller has checked that the initial token is SUBTYPE
+
+   --  Error recovery: can raise Error_Resync
+
+   function P_Subtype_Declaration return Node_Id is
+      Decl_Node        : Node_Id;
+      Not_Null_Present : Boolean := False;
+
+   begin
+      Decl_Node := New_Node (N_Subtype_Declaration, Token_Ptr);
+      Scan; -- past SUBTYPE
+      Set_Defining_Identifier (Decl_Node, P_Defining_Identifier (C_Is));
+      TF_Is;
+
+      if Token = Tok_New then
+         Error_Msg_SC  -- CODEFIX
+           ("NEW ignored (only allowed in type declaration)");
+         Scan; -- past NEW
+      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));
+      P_Aspect_Specifications (Decl_Node);
+      return Decl_Node;
+   end P_Subtype_Declaration;
+
+   -------------------------------
+   -- 3.2.2  Subtype Indication --
+   -------------------------------
+
+   --  SUBTYPE_INDICATION ::=
+   --    [not null] SUBTYPE_MARK [CONSTRAINT]
+
+   --  Error recovery: can raise Error_Resync
+
+   function P_Null_Exclusion
+     (Allow_Anonymous_In_95 : Boolean := False) return Boolean
+   is
+      Not_Loc : constant Source_Ptr := Token_Ptr;
+      --  Source position of "not", if present
+
+   begin
+      if Token /= Tok_Not then
+         return False;
+
+      else
+         Scan; --  past NOT
+
+         if Token = Tok_Null then
+            Scan; --  past NULL
+
+            --  Ada 2005 (AI-441, AI-447): null_exclusion is illegal in Ada 95,
+            --  except in the case of anonymous access types.
+
+            --  Allow_Anonymous_In_95 will be True if we're parsing a formal
+            --  parameter or discriminant, which are the only places where
+            --  anonymous access types occur in Ada 95. "Formal : not null
+            --  access ..." is legal in Ada 95, whereas "Formal : not null
+            --  Named_Access_Type" is not.
+
+            if Ada_Version >= Ada_2005
+              or else (Ada_Version >= Ada_95
+                        and then Allow_Anonymous_In_95
+                        and then Token = Tok_Access)
+            then
+               null; -- OK
+
+            else
+               Error_Msg
+                 ("`NOT NULL` access type is an Ada 2005 extension", Not_Loc);
+               Error_Msg
+                 ("\unit should be compiled with -gnat05 switch", Not_Loc);
+            end if;
+
+         else
+            Error_Msg_SP ("NULL expected");
+         end if;
+
+         if Token = Tok_New then
+            Error_Msg ("`NOT NULL` comes after NEW, not before", Not_Loc);
+         end if;
+
+         return True;
+      end if;
+   end P_Null_Exclusion;
+
+   function P_Subtype_Indication
+     (Not_Null_Present : Boolean := False) return Node_Id
+   is
+      Type_Node : Node_Id;
+
+   begin
+      if Token = Tok_Identifier or else Token = Tok_Operator_Symbol then
+         Type_Node := P_Subtype_Mark;
+         return P_Subtype_Indication (Type_Node, Not_Null_Present);
+
+      else
+         --  Check for error of using record definition and treat it nicely,
+         --  otherwise things are really messed up, so resynchronize.
+
+         if Token = Tok_Record then
+            Error_Msg_SC ("anonymous record definitions are not permitted");
+            Discard_Junk_Node (P_Record_Definition);
+            return Error;
+
+         else
+            Error_Msg_AP ("subtype indication expected");
+            raise Error_Resync;
+         end if;
+      end if;
+   end P_Subtype_Indication;
+
+   --  The following function is identical except that it is called with
+   --  the subtype mark already scanned out, and it scans out the constraint
+
+   --  Error recovery: can raise Error_Resync
+
+   function P_Subtype_Indication
+     (Subtype_Mark     : Node_Id;
+      Not_Null_Present : Boolean := False) return Node_Id
+   is
+      Indic_Node  : Node_Id;
+      Constr_Node : Node_Id;
+
+   begin
+      Constr_Node := P_Constraint_Opt;
+
+      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
+            Error_Msg_SP ("`NOT NULL` not allowed if constraint given");
+         end if;
+
+         Indic_Node := New_Node (N_Subtype_Indication, Sloc (Subtype_Mark));
+         Set_Subtype_Mark (Indic_Node, Check_Subtype_Mark (Subtype_Mark));
+         Set_Constraint (Indic_Node, Constr_Node);
+         return Indic_Node;
+      end if;
+   end P_Subtype_Indication;
+
+   -------------------------
+   -- 3.2.2  Subtype Mark --
+   -------------------------
+
+   --  SUBTYPE_MARK ::= subtype_NAME;
+
+   --  Note: The subtype mark which appears after an IN or NOT IN
+   --  operator is parsed by P_Range_Or_Subtype_Mark (3.5)
+
+   --  Error recovery: cannot raise Error_Resync
+
+   function P_Subtype_Mark return Node_Id is
+   begin
+      return P_Subtype_Mark_Resync;
+   exception
+      when Error_Resync =>
+         return Error;
+   end P_Subtype_Mark;
+
+   --  This routine differs from P_Subtype_Mark in that it insists that an
+   --  identifier be present, and if it is not, it raises Error_Resync.
+
+   --  Error recovery: can raise Error_Resync
+
+   function P_Subtype_Mark_Resync return Node_Id is
+      Type_Node : Node_Id;
+
+   begin
+      if Token = Tok_Access then
+         Error_Msg_SC ("anonymous access type definition not allowed here");
+         Scan; -- past ACCESS
+      end if;
+
+      if Token = Tok_Array then
+         Error_Msg_SC ("anonymous array definition not allowed here");
+         Discard_Junk_Node (P_Array_Type_Definition);
+         return Error;
+
+      else
+         Type_Node := P_Qualified_Simple_Name_Resync;
+
+         --  Check for a subtype mark attribute. The only valid possibilities
+         --  are 'CLASS and 'BASE. Anything else is a definite error. We may
+         --  as well catch it here.
+
+         if Token = Tok_Apostrophe then
+            return P_Subtype_Mark_Attribute (Type_Node);
+         else
+            return Type_Node;
+         end if;
+      end if;
+   end P_Subtype_Mark_Resync;
+
+   --  The following function is called to scan out a subtype mark attribute.
+   --  The caller has already scanned out the subtype mark, which is passed in
+   --  as the argument, and has checked that the current token is apostrophe.
+
+   --  Only a special subclass of attributes, called type attributes
+   --  (see Snames package) are allowed in this syntactic position.
+
+   --  Note: if the apostrophe is followed by other than an identifier, then
+   --  the input expression is returned unchanged, and the scan pointer is
+   --  left pointing to the apostrophe.
+
+   --  Error recovery: can raise Error_Resync
+
+   function P_Subtype_Mark_Attribute (Type_Node : Node_Id) return Node_Id is
+      Attr_Node  : Node_Id := Empty;
+      Scan_State : Saved_Scan_State;
+      Prefix     : Node_Id;
+
+   begin
+      Prefix := Check_Subtype_Mark (Type_Node);
+
+      if Prefix = Error then
+         raise Error_Resync;
+      end if;
+
+      --  Loop through attributes appearing (more than one can appear as for
+      --  for example in X'Base'Class). We are at an apostrophe on entry to
+      --  this loop, and it runs once for each attribute parsed, with
+      --  Prefix being the current possible prefix if it is an attribute.
+
+      loop
+         Save_Scan_State (Scan_State); -- at Apostrophe
+         Scan; -- past apostrophe
+
+         if Token /= Tok_Identifier then
+            Restore_Scan_State (Scan_State); -- to apostrophe
+            return Prefix; -- no attribute after all
+
+         elsif not Is_Type_Attribute_Name (Token_Name) then
+            Error_Msg_N
+              ("attribute & may not be used in a subtype mark", Token_Node);
+            raise Error_Resync;
+
+         else
+            Attr_Node :=
+              Make_Attribute_Reference (Prev_Token_Ptr,
+                Prefix => Prefix,
+                Attribute_Name => Token_Name);
+            Scan; -- past type attribute identifier
+         end if;
+
+         exit when Token /= Tok_Apostrophe;
+         Prefix := Attr_Node;
+      end loop;
+
+      --  Fall through here after scanning type attribute
+
+      return Attr_Node;
+   end P_Subtype_Mark_Attribute;
+
+   -----------------------
+   -- 3.2.2  Constraint --
+   -----------------------
+
+   --  CONSTRAINT ::= SCALAR_CONSTRAINT | COMPOSITE_CONSTRAINT
+
+   --  SCALAR_CONSTRAINT ::=
+   --    RANGE_CONSTRAINT | DIGITS_CONSTRAINT | DELTA_CONSTRAINT
+
+   --  COMPOSITE_CONSTRAINT ::=
+   --    INDEX_CONSTRAINT | DISCRIMINANT_CONSTRAINT
+
+   --  If no constraint is present, this function returns Empty
+
+   --  Error recovery: can raise Error_Resync
+
+   function P_Constraint_Opt return Node_Id is
+   begin
+      if Token = Tok_Range or else Bad_Spelling_Of (Tok_Range) then
+         return P_Range_Constraint;
+
+      elsif Token = Tok_Digits or else Bad_Spelling_Of (Tok_Digits) then
+         return P_Digits_Constraint;
+
+      elsif Token = Tok_Delta or else Bad_Spelling_Of (Tok_Delta) then
+         return P_Delta_Constraint;
+
+      elsif Token = Tok_Left_Paren then
+         return P_Index_Or_Discriminant_Constraint;
+
+      elsif Token = Tok_In then
+         Ignore (Tok_In);
+         return P_Constraint_Opt;
+
+      --  One more possibility is e.g. 1 .. 10 (i.e. missing RANGE keyword)
+
+      elsif Token = Tok_Identifier      or else
+            Token = Tok_Integer_Literal or else
+            Token = Tok_Real_Literal
+      then
+         declare
+            Scan_State : Saved_Scan_State;
+
+         begin
+            Save_Scan_State (Scan_State); -- at identifier or literal
+            Scan; -- past identifier or literal
+
+            if Token = Tok_Dot_Dot then
+               Restore_Scan_State (Scan_State);
+               Error_Msg_BC ("missing RANGE keyword");
+               return P_Range_Constraint;
+            else
+               Restore_Scan_State (Scan_State);
+               return Empty;
+            end if;
+         end;
+
+      --  Nothing worked, no constraint there
+
+      else
+         return Empty;
+      end if;
+   end P_Constraint_Opt;
+
+   ------------------------------
+   -- 3.2.2  Scalar Constraint --
+   ------------------------------
+
+   --  Parsed by P_Constraint_Opt (3.2.2)
+
+   ---------------------------------
+   -- 3.2.2  Composite Constraint --
+   ---------------------------------
+
+   --  Parsed by P_Constraint_Opt (3.2.2)
+
+   --------------------------------------------------------
+   -- 3.3  Identifier Declarations (Also 7.4, 8.5, 11.1) --
+   --------------------------------------------------------
+
+   --  This routine scans out a declaration starting with an identifier:
+
+   --  OBJECT_DECLARATION ::=
+   --    DEFINING_IDENTIFIER_LIST : [aliased] [constant]
+   --      [NULL_EXCLUSION] SUBTYPE_INDICATION [:= EXPRESSION]
+   --        [ASPECT_SPECIFICATIONS];
+   --  | DEFINING_IDENTIFIER_LIST : [aliased] [constant]
+   --      ACCESS_DEFINITION [:= EXPRESSION]
+   --        [ASPECT_SPECIFICATIONS];
+   --  | DEFINING_IDENTIFIER_LIST : [aliased] [constant]
+   --      ARRAY_TYPE_DEFINITION [:= EXPRESSION]
+   --        [ASPECT_SPECIFICATIONS];
+
+   --  NUMBER_DECLARATION ::=
+   --    DEFINING_IDENTIFIER_LIST : constant ::= static_EXPRESSION;
+
+   --  OBJECT_RENAMING_DECLARATION ::=
+   --    DEFINING_IDENTIFIER :
+   --      [NULL_EXCLUSION] SUBTYPE_MARK renames object_NAME
+   --        [ASPECT_SPECIFICATIONS];
+   --  | DEFINING_IDENTIFIER :
+   --      ACCESS_DEFINITION renames object_NAME
+   --        [ASPECT_SPECIFICATIONS];
+
+   --  EXCEPTION_RENAMING_DECLARATION ::=
+   --    DEFINING_IDENTIFIER : exception renames exception_NAME
+   --      [ASPECT_SPECIFICATIONS];
+
+   --  EXCEPTION_DECLARATION ::=
+   --    DEFINING_IDENTIFIER_LIST : exception
+   --      [ASPECT_SPECIFICATIONS];
+
+   --  Note that the ALIASED indication in an object declaration is
+   --  marked by a flag in the parent node.
+
+   --  The caller has checked that the initial token is an identifier
+
+   --  The value returned is a list of declarations, one for each identifier
+   --  in the list (as described in Sinfo, we always split up multiple
+   --  declarations into the equivalent sequence of single declarations
+   --  using the More_Ids and Prev_Ids flags to preserve the source).
+
+   --  If the identifier turns out to be a probable statement rather than
+   --  an identifier, then the scan is left pointing to the identifier and
+   --  No_List is returned.
+
+   --  Error recovery: can raise Error_Resync
+
+   procedure P_Identifier_Declarations
+     (Decls   : List_Id;
+      Done    : out Boolean;
+      In_Spec : Boolean)
+   is
+      Acc_Node         : Node_Id;
+      Decl_Node        : Node_Id;
+      Type_Node        : Node_Id;
+      Ident_Sloc       : Source_Ptr;
+      Scan_State       : Saved_Scan_State;
+      List_OK          : Boolean := True;
+      Ident            : Nat;
+      Init_Expr        : Node_Id;
+      Init_Loc         : Source_Ptr;
+      Con_Loc          : Source_Ptr;
+      Not_Null_Present : Boolean := False;
+
+      Idents : array (Int range 1 .. 4096) of Entity_Id;
+      --  Used to save identifiers in the identifier list. The upper bound
+      --  of 4096 is expected to be infinite in practice, and we do not even
+      --  bother to check if this upper bound is exceeded.
+
+      Num_Idents : Nat := 1;
+      --  Number of identifiers stored in Idents
+
+      procedure No_List;
+      --  This procedure is called in renames cases to make sure that we do
+      --  not have more than one identifier. If we do have more than one
+      --  then an error message is issued (and the declaration is split into
+      --  multiple declarations)
+
+      function Token_Is_Renames return Boolean;
+      --  Checks if current token is RENAMES, and if so, scans past it and
+      --  returns True, otherwise returns False. Includes checking for some
+      --  common error cases.
+
+      -------------
+      -- No_List --
+      -------------
+
+      procedure No_List is
+      begin
+         if Num_Idents > 1 then
+            Error_Msg
+              ("identifier list not allowed for RENAMES",
+               Sloc (Idents (2)));
+         end if;
+
+         List_OK := False;
+      end No_List;
+
+      ----------------------
+      -- Token_Is_Renames --
+      ----------------------
+
+      function Token_Is_Renames return Boolean is
+         At_Colon : Saved_Scan_State;
+
+      begin
+         if Token = Tok_Colon then
+            Save_Scan_State (At_Colon);
+            Scan; -- past colon
+            Check_Misspelling_Of (Tok_Renames);
+
+            if Token = Tok_Renames then
+               Error_Msg_SP -- CODEFIX
+                 ("|extra "":"" ignored");
+               Scan; -- past RENAMES
+               return True;
+            else
+               Restore_Scan_State (At_Colon);
+               return False;
+            end if;
+
+         else
+            Check_Misspelling_Of (Tok_Renames);
+
+            if Token = Tok_Renames then
+               Scan; -- past RENAMES
+               return True;
+            else
+               return False;
+            end if;
+         end if;
+      end Token_Is_Renames;
+
+   --  Start of processing for P_Identifier_Declarations
+
+   begin
+      Ident_Sloc := Token_Ptr;
+      Save_Scan_State (Scan_State); -- at first identifier
+      Idents (1) := P_Defining_Identifier (C_Comma_Colon);
+
+      --  If we have a colon after the identifier, then we can assume that
+      --  this is in fact a valid identifier declaration and can steam ahead.
+
+      if Token = Tok_Colon then
+         Scan; -- past colon
+
+      --  If we have a comma, then scan out the list of identifiers
+
+      elsif Token = Tok_Comma then
+         while Comma_Present loop
+            Num_Idents := Num_Idents + 1;
+            Idents (Num_Idents) := P_Defining_Identifier (C_Comma_Colon);
+         end loop;
+
+         Save_Scan_State (Scan_State); -- at colon
+         T_Colon;
+
+      --  If we have identifier followed by := then we assume that what is
+      --  really meant is an assignment statement. The assignment statement
+      --  is scanned out and added to the list of declarations. An exception
+      --  occurs if the := is followed by the keyword constant, in which case
+      --  we assume it was meant to be a colon.
+
+      elsif Token = Tok_Colon_Equal then
+         Scan; -- past :=
+
+         if Token = Tok_Constant then
+            Error_Msg_SP ("colon expected");
+
+         else
+            Restore_Scan_State (Scan_State);
+
+            --  Reset Token_Node, because it already got changed from an
+            --  Identifier to a Defining_Identifier, and we don't want that
+            --  for a statement!
+
+            Token_Node :=
+              Make_Identifier (Sloc (Token_Node), Chars (Token_Node));
+
+            --  And now scan out one or more statements
+
+            Statement_When_Declaration_Expected (Decls, Done, In_Spec);
+            return;
+         end if;
+
+      --  If we have an IS keyword, then assume the TYPE keyword was missing
+
+      elsif Token = Tok_Is then
+         Restore_Scan_State (Scan_State);
+         Append_To (Decls, P_Type_Declaration);
+         Done := False;
+         return;
+
+      --  Otherwise we have an error situation
+
+      else
+         Restore_Scan_State (Scan_State);
+
+         --  First case is possible misuse of PROTECTED in Ada 83 mode. If
+         --  so, fix the keyword and return to scan the protected declaration.
+
+         if Token_Name = Name_Protected then
+            Check_95_Keyword (Tok_Protected, Tok_Identifier);
+            Check_95_Keyword (Tok_Protected, Tok_Type);
+            Check_95_Keyword (Tok_Protected, Tok_Body);
+
+            if Token = Tok_Protected then
+               Done := False;
+               return;
+            end if;
+
+         --  Check misspelling possibilities. If so, correct the misspelling
+         --  and return to scan out the resulting declaration.
+
+         elsif Bad_Spelling_Of (Tok_Function)
+           or else Bad_Spelling_Of (Tok_Procedure)
+           or else Bad_Spelling_Of (Tok_Package)
+           or else Bad_Spelling_Of (Tok_Pragma)
+           or else Bad_Spelling_Of (Tok_Protected)
+           or else Bad_Spelling_Of (Tok_Generic)
+           or else Bad_Spelling_Of (Tok_Subtype)
+           or else Bad_Spelling_Of (Tok_Type)
+           or else Bad_Spelling_Of (Tok_Task)
+           or else Bad_Spelling_Of (Tok_Use)
+           or else Bad_Spelling_Of (Tok_For)
+         then
+            Done := False;
+            return;
+
+         --  Otherwise we definitely have an ordinary identifier with a junk
+         --  token after it.
+
+         else
+            --  If in -gnatd.2 mode, try for statements
+
+            if Debug_Flag_Dot_2 then
+               Restore_Scan_State (Scan_State);
+
+               --  Reset Token_Node, because it already got changed from an
+               --  Identifier to a Defining_Identifier, and we don't want that
+               --  for a statement!
+
+               Token_Node :=
+                 Make_Identifier (Sloc (Token_Node), Chars (Token_Node));
+
+               --  And now scan out one or more statements
+
+               Statement_When_Declaration_Expected (Decls, Done, In_Spec);
+               return;
+
+            --  Normal case, just complain and skip to semicolon
+
+            else
+               Set_Declaration_Expected;
+               Resync_Past_Semicolon;
+               Done := False;
+               return;
+            end if;
+         end if;
+      end if;
+
+      --  Come here with an identifier list and colon scanned out. We now
+      --  build the nodes for the declarative items. One node is built for
+      --  each identifier in the list, with the type information being
+      --  repeated by rescanning the appropriate section of source.
+
+      --  First an error check, if we have two identifiers in a row, a likely
+      --  possibility is that the first of the identifiers is an incorrectly
+      --  spelled keyword.
+
+      if Token = Tok_Identifier then
+         declare
+            SS : Saved_Scan_State;
+            I2 : Boolean;
+
+         begin
+            Save_Scan_State (SS);
+            Scan; -- past initial identifier
+            I2 := (Token = Tok_Identifier);
+            Restore_Scan_State (SS);
+
+            if I2
+              and then
+                (Bad_Spelling_Of (Tok_Access)   or else
+                 Bad_Spelling_Of (Tok_Aliased)  or else
+                 Bad_Spelling_Of (Tok_Constant))
+            then
+               null;
+            end if;
+         end;
+      end if;
+
+      --  Loop through identifiers
+
+      Ident := 1;
+      Ident_Loop : loop
+
+         --  Check for some cases of misused Ada 95 keywords
+
+         if Token_Name = Name_Aliased then
+            Check_95_Keyword (Tok_Aliased, Tok_Array);
+            Check_95_Keyword (Tok_Aliased, Tok_Identifier);
+            Check_95_Keyword (Tok_Aliased, Tok_Constant);
+         end if;
+
+         --  Constant cases
+
+         if Token = Tok_Constant then
+            Con_Loc := Token_Ptr;
+            Scan; -- past CONSTANT
+
+            --  Number declaration, initialization required
+
+            Init_Expr := Init_Expr_Opt;
+
+            if Present (Init_Expr) then
+               if Not_Null_Present then
+                  Error_Msg_SP
+                    ("`NOT NULL` not allowed in numeric expression");
+               end if;
+
+               Decl_Node := New_Node (N_Number_Declaration, Ident_Sloc);
+               Set_Expression (Decl_Node, Init_Expr);
+
+            --  Constant object declaration
+
+            else
+               Decl_Node := New_Node (N_Object_Declaration, Ident_Sloc);
+               Set_Constant_Present (Decl_Node, True);
+
+               if Token_Name = Name_Aliased then
+                  Check_95_Keyword (Tok_Aliased, Tok_Array);
+                  Check_95_Keyword (Tok_Aliased, Tok_Identifier);
+               end if;
+
+               if Token = Tok_Aliased then
+                  Error_Msg_SC -- CODEFIX
+                    ("ALIASED should be before CONSTANT");
+                  Scan; -- past ALIASED
+                  Set_Aliased_Present (Decl_Node, True);
+               end if;
+
+               if Token = Tok_Array then
+                  Set_Object_Definition
+                    (Decl_Node, P_Array_Type_Definition);
+
+               else
+                  Not_Null_Present := P_Null_Exclusion; --  Ada 2005 (AI-231)
+                  Set_Null_Exclusion_Present (Decl_Node, Not_Null_Present);
+
+                  if Token = Tok_Access then
+                     if Ada_Version < Ada_2005 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;
+
+                     Set_Object_Definition
+                       (Decl_Node, P_Access_Definition (Not_Null_Present));
+                  else
+                     Set_Object_Definition
+                       (Decl_Node, P_Subtype_Indication (Not_Null_Present));
+                  end if;
+               end if;
+
+               if Token = Tok_Renames then
+                  Error_Msg
+                    ("CONSTANT not permitted in renaming declaration",
+                     Con_Loc);
+                  Scan; -- Past renames
+                  Discard_Junk_Node (P_Name);
+               end if;
+            end if;
+
+         --  Exception cases
+
+         elsif Token = Tok_Exception then
+            Scan; -- past EXCEPTION
+
+            if Token_Is_Renames then
+               No_List;
+               Decl_Node :=
+                 New_Node (N_Exception_Renaming_Declaration, Ident_Sloc);
+               Set_Name (Decl_Node, P_Qualified_Simple_Name_Resync);
+               No_Constraint;
+            else
+               Decl_Node := New_Node (N_Exception_Declaration, Prev_Token_Ptr);
+            end if;
+
+         --  Aliased case (note that an object definition is required)
+
+         elsif Token = Tok_Aliased then
+            Scan; -- past ALIASED
+            Decl_Node := New_Node (N_Object_Declaration, Ident_Sloc);
+            Set_Aliased_Present (Decl_Node, True);
+
+            if Token = Tok_Constant then
+               Scan; -- past CONSTANT
+               Set_Constant_Present (Decl_Node, True);
+            end if;
+
+            if Token = Tok_Array then
+               Set_Object_Definition
+                 (Decl_Node, P_Array_Type_Definition);
+
+            else
+               Not_Null_Present := P_Null_Exclusion; --  Ada 2005 (AI-231)
+               Set_Null_Exclusion_Present (Decl_Node, Not_Null_Present);
+
+               --  Access definition (AI-406) or subtype indication
+
+               if Token = Tok_Access then
+                  if Ada_Version < Ada_2005 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;
+
+                  Set_Object_Definition
+                    (Decl_Node, P_Access_Definition (Not_Null_Present));
+               else
+                  Set_Object_Definition
+                    (Decl_Node, P_Subtype_Indication (Not_Null_Present));
+               end if;
+            end if;
+
+         --  Array case
+
+         elsif Token = Tok_Array then
+            Decl_Node := New_Node (N_Object_Declaration, Ident_Sloc);
+            Set_Object_Definition (Decl_Node, P_Array_Type_Definition);
+
+         --  Ada 2005 (AI-254, AI-406)
+
+         elsif Token = Tok_Not then
+
+            --  OBJECT_DECLARATION ::=
+            --    DEFINING_IDENTIFIER_LIST : [aliased] [constant]
+            --      [NULL_EXCLUSION] SUBTYPE_INDICATION [:= EXPRESSION]
+            --        [ASPECT_SPECIFICATIONS];
+            --  | DEFINING_IDENTIFIER_LIST : [aliased] [constant]
+            --      ACCESS_DEFINITION [:= EXPRESSION]
+            --        [ASPECT_SPECIFICATIONS];
+
+            --  OBJECT_RENAMING_DECLARATION ::=
+            --    DEFINING_IDENTIFIER :
+            --      [NULL_EXCLUSION] SUBTYPE_MARK renames object_NAME
+            --        [ASPECT_SPECIFICATIONS];
+            --  | DEFINING_IDENTIFIER :
+            --      ACCESS_DEFINITION renames object_NAME
+            --        [ASPECT_SPECIFICATIONS];
+
+            Not_Null_Present := P_Null_Exclusion;  --  Ada 2005 (AI-231/423)
+
+            if Token = Tok_Access then
+               if Ada_Version < Ada_2005 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
+                  Decl_Node := New_Node (N_Object_Declaration, Ident_Sloc);
+                  Set_Object_Definition (Decl_Node, Acc_Node);
+
+               else
+                  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);
+               end if;
+
+            else
+               Type_Node := P_Subtype_Mark;
+
+               --  Object renaming declaration
+
+               if Token_Is_Renames then
+                  if Ada_Version < Ada_2005 then
+                     Error_Msg_SP
+                       ("`NOT NULL` not allowed in object renaming");
+                     raise Error_Resync;
+
+                  --  Ada 2005 (AI-423): Object renaming declaration with
+                  --  a null exclusion.
+
+                  else
+                     No_List;
+                     Decl_Node :=
+                       New_Node (N_Object_Renaming_Declaration, Ident_Sloc);
+                     Set_Null_Exclusion_Present (Decl_Node, Not_Null_Present);
+                     Set_Subtype_Mark (Decl_Node, Type_Node);
+                     Set_Name (Decl_Node, P_Name);
+                  end if;
+
+               --  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 Ada_Version < Ada_2005 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 (Null_Exclusion_Present => False);
+
+            --  Object declaration with access definition, or renaming
+
+            if Token /= Tok_Renames then
+               Decl_Node := New_Node (N_Object_Declaration, Ident_Sloc);
+               Set_Object_Definition (Decl_Node, Acc_Node);
+
+            else
+               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);
+            end if;
+
+         --  Subtype indication case
+
+         else
+            Type_Node := P_Subtype_Mark;
+
+            --  Object renaming declaration
+
+            if Token_Is_Renames then
+               No_List;
+               Decl_Node :=
+                 New_Node (N_Object_Renaming_Declaration, Ident_Sloc);
+               Set_Subtype_Mark (Decl_Node, Type_Node);
+               Set_Name (Decl_Node, P_Name);
+
+            --  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;
+
+         --  Scan out initialization, allowed only for object declaration
+
+         Init_Loc := Token_Ptr;
+         Init_Expr := Init_Expr_Opt;
+
+         if Present (Init_Expr) then
+            if Nkind (Decl_Node) = N_Object_Declaration then
+               Set_Expression (Decl_Node, Init_Expr);
+               Set_Has_Init_Expression (Decl_Node);
+            else
+               Error_Msg ("initialization not allowed here", Init_Loc);
+            end if;
+         end if;
+
+         Set_Defining_Identifier (Decl_Node, Idents (Ident));
+         P_Aspect_Specifications (Decl_Node, Semicolon => False);
+
+         --  Allow initialization expression to follow aspects (note that in
+         --  this case P_Aspect_Specifications already issued an error msg).
+
+         if Token = Tok_Colon_Equal then
+            if Is_Non_Empty_List (Aspect_Specifications (Decl_Node)) then
+               Error_Msg
+                 ("aspect specifications must come after initialization "
+                  & "expression",
+                  Sloc (First (Aspect_Specifications (Decl_Node))));
+
+            else
+               --  In any case, the assignment symbol doesn't belong.
+
+               Error_Msg ("misplaced assignment symbol", Scan_Ptr);
+            end if;
+
+            Set_Expression (Decl_Node, Init_Expr_Opt);
+            Set_Has_Init_Expression (Decl_Node);
+         end if;
+
+         --  Now scan out the semicolon, which we deferred above
+
+         T_Semicolon;
+
+         if List_OK then
+            if Ident < Num_Idents then
+               Set_More_Ids (Decl_Node, True);
+            end if;
+
+            if Ident > 1 then
+               Set_Prev_Ids (Decl_Node, True);
+            end if;
+         end if;
+
+         Append (Decl_Node, Decls);
+         exit Ident_Loop when Ident = Num_Idents;
+         Restore_Scan_State (Scan_State);
+         T_Colon;
+         Ident := Ident + 1;
+      end loop Ident_Loop;
+
+      Done := False;
+   end P_Identifier_Declarations;
+
+   -------------------------------
+   -- 3.3.1  Object Declaration --
+   -------------------------------
+
+   --  OBJECT DECLARATION ::=
+   --    DEFINING_IDENTIFIER_LIST : [aliased] [constant]
+   --      SUBTYPE_INDICATION [:= EXPRESSION];
+   --  | DEFINING_IDENTIFIER_LIST : [aliased] [constant]
+   --      ARRAY_TYPE_DEFINITION [:= EXPRESSION];
+   --  | SINGLE_TASK_DECLARATION
+   --  | SINGLE_PROTECTED_DECLARATION
+
+   --  Cases starting with TASK are parsed by P_Task (9.1)
+   --  Cases starting with PROTECTED are parsed by P_Protected (9.4)
+   --  All other cases are parsed by P_Identifier_Declarations (3.3)
+
+   -------------------------------------
+   -- 3.3.1  Defining Identifier List --
+   -------------------------------------
+
+   --  DEFINING_IDENTIFIER_LIST ::=
+   --    DEFINING_IDENTIFIER {, DEFINING_IDENTIFIER}
+
+   --  Always parsed by the construct in which it appears. See special
+   --  section on "Handling of Defining Identifier Lists" in this unit.
+
+   -------------------------------
+   -- 3.3.2  Number Declaration --
+   -------------------------------
+
+   --  Parsed by P_Identifier_Declarations (3.3)
+
+   -------------------------------------------------------------------------
+   -- 3.4  Derived Type Definition or Private Extension Declaration (7.3) --
+   -------------------------------------------------------------------------
+
+   --  DERIVED_TYPE_DEFINITION ::=
+   --    [abstract] [limited] new [NULL_EXCLUSION] parent_SUBTYPE_INDICATION
+   --    [[and INTERFACE_LIST] RECORD_EXTENSION_PART]
+
+   --  PRIVATE_EXTENSION_DECLARATION ::=
+   --     type DEFINING_IDENTIFIER [DISCRIMINANT_PART] is
+   --       [abstract] [limited | synchronized]
+   --          new ancestor_SUBTYPE_INDICATION [and INTERFACE_LIST]
+   --            with private [ASPECT_SPECIFICATIONS];
+
+   --  RECORD_EXTENSION_PART ::= with RECORD_DEFINITION
+
+   --  The caller has already scanned out the part up to the NEW, and Token
+   --  either contains Tok_New (or ought to, if it doesn't this procedure
+   --  will post an appropriate "NEW expected" message).
+
+   --  Note: the caller is responsible for filling in the Sloc field of
+   --  the returned node in the private extension declaration case as
+   --  well as the stuff relating to the discriminant part.
+
+   --  Error recovery: can raise Error_Resync;
+
+   function P_Derived_Type_Def_Or_Private_Ext_Decl return Node_Id is
+      Typedef_Node     : Node_Id;
+      Typedecl_Node    : Node_Id;
+      Not_Null_Present : Boolean := False;
+
+   begin
+      Typedef_Node := New_Node (N_Derived_Type_Definition, Token_Ptr);
+
+      if Ada_Version < Ada_2005
+        and then Token = Tok_Identifier
+        and then Token_Name = Name_Interface
+      then
+         Error_Msg_SP
+           ("abstract interface is an Ada 2005 extension");
+         Error_Msg_SP ("\unit must be compiled with -gnat05 switch");
+      else
+         T_New;
+      end if;
+
+      if Token = Tok_Abstract then
+         Error_Msg_SC -- CODEFIX
+           ("ABSTRACT must come before NEW, not after");
+         Scan;
+      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));
+
+      --  Ada 2005 (AI-251): Deal with interfaces
+
+      if Token = Tok_And then
+         Scan; -- past AND
+
+         if Ada_Version < Ada_2005 then
+            Error_Msg_SP
+              ("abstract interface is an Ada 2005 extension");
+            Error_Msg_SP ("\unit must be compiled with -gnat05 switch");
+         end if;
+
+         Set_Interface_List (Typedef_Node, New_List);
+
+         loop
+            Append (P_Qualified_Simple_Name, Interface_List (Typedef_Node));
+            exit when Token /= Tok_And;
+            Scan; -- past AND
+         end loop;
+
+         if Token /= Tok_With then
+            Error_Msg_SC ("WITH expected");
+            raise Error_Resync;
+         end if;
+      end if;
+
+      --  Deal with record extension, note that we assume that a WITH is
+      --  missing in the case of "type X is new Y record ..." or in the
+      --  case of "type X is new Y null record".
+
+      --  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
+         T_With; -- past WITH or give error message
+
+         if Token = Tok_Limited then
+            Error_Msg_SC ("LIMITED keyword not allowed in private extension");
+            Scan; -- ignore LIMITED
+         end if;
+
+         --  Private extension declaration
+
+         if Token = Tok_Private then
+            Scan; -- past PRIVATE
+
+            --  Throw away the type definition node and build the type
+            --  declaration node. Note the caller must set the Sloc,
+            --  Discriminant_Specifications, Unknown_Discriminants_Present,
+            --  and Defined_Identifier fields in the returned node.
+
+            Typedecl_Node :=
+              Make_Private_Extension_Declaration (No_Location,
+                Defining_Identifier => Empty,
+                Subtype_Indication  => Subtype_Indication (Typedef_Node),
+                Abstract_Present    => Abstract_Present (Typedef_Node),
+                Interface_List      => Interface_List (Typedef_Node));
+
+            return Typedecl_Node;
+
+         --  Derived type definition with record extension part
+
+         else
+            Set_Record_Extension_Part (Typedef_Node, P_Record_Definition);
+            return Typedef_Node;
+         end if;
+
+      --  Derived type definition with no record extension part
+
+      else
+         return Typedef_Node;
+      end if;
+   end P_Derived_Type_Def_Or_Private_Ext_Decl;
+
+   ---------------------------
+   -- 3.5  Range Constraint --
+   ---------------------------
+
+   --  RANGE_CONSTRAINT ::= range RANGE
+
+   --  The caller has checked that the initial token is RANGE or some
+   --  misspelling of it, or it may be absent completely (and a message
+   --  has already been issued).
+
+   --  Error recovery: cannot raise Error_Resync
+
+   function P_Range_Constraint return Node_Id is
+      Range_Node : Node_Id;
+
+   begin
+      Range_Node := New_Node (N_Range_Constraint, Token_Ptr);
+
+      --  Skip range keyword if present
+
+      if Token = Tok_Range or else Bad_Spelling_Of (Tok_Range) then
+         Scan; -- past RANGE
+      end if;
+
+      Set_Range_Expression (Range_Node, P_Range);
+      return Range_Node;
+   end P_Range_Constraint;
+
+   ----------------
+   -- 3.5  Range --
+   ----------------
+
+   --  RANGE ::=
+   --    RANGE_ATTRIBUTE_REFERENCE | SIMPLE_EXPRESSION .. SIMPLE_EXPRESSION
+
+   --  Note: the range that appears in a membership test is parsed by
+   --  P_Range_Or_Subtype_Mark (3.5).
+
+   --  Error recovery: cannot raise Error_Resync
+
+   function P_Range return Node_Id is
+      Expr_Node  : Node_Id;
+      Range_Node : Node_Id;
+
+   begin
+      Expr_Node := P_Simple_Expression_Or_Range_Attribute;
+
+      if Expr_Form = EF_Range_Attr then
+         return Expr_Node;
+
+      elsif Token = Tok_Dot_Dot then
+         Range_Node := New_Node (N_Range, Token_Ptr);
+         Set_Low_Bound (Range_Node, Expr_Node);
+         Scan; -- past ..
+         Expr_Node := P_Expression;
+         Check_Simple_Expression (Expr_Node);
+         Set_High_Bound (Range_Node, Expr_Node);
+         return Range_Node;
+
+      --  Anything else is an error
+
+      else
+         T_Dot_Dot; -- force missing .. message
+         return Error;
+      end if;
+   end P_Range;
+
+   ----------------------------------
+   -- 3.5  P_Range_Or_Subtype_Mark --
+   ----------------------------------
+
+   --  RANGE ::=
+   --    RANGE_ATTRIBUTE_REFERENCE
+   --  | SIMPLE_EXPRESSION .. SIMPLE_EXPRESSION
+
+   --  This routine scans out the range or subtype mark that forms the right
+   --  operand of a membership test (it is not used in any other contexts, and
+   --  error messages are specialized with this knowledge in mind).
+
+   --  Note: as documented in the Sinfo interface, although the syntax only
+   --  allows a subtype mark, we in fact allow any simple expression to be
+   --  returned from this routine. The semantics is responsible for issuing
+   --  an appropriate message complaining if the argument is not a name.
+   --  This simplifies the coding and error recovery processing in the
+   --  parser, and in any case it is preferable not to consider this a
+   --  syntax error and to continue with the semantic analysis.
+
+   --  Error recovery: cannot raise Error_Resync
+
+   function P_Range_Or_Subtype_Mark
+     (Allow_Simple_Expression : Boolean := False) return Node_Id
+   is
+      Expr_Node  : Node_Id;
+      Range_Node : Node_Id;
+      Save_Loc   : Source_Ptr;
+
+   --  Start of processing for P_Range_Or_Subtype_Mark
+
+   begin
+      --  Save location of possible junk parentheses
+
+      Save_Loc := Token_Ptr;
+
+      --  Scan out either a simple expression or a range (this accepts more
+      --  than is legal here, but as explained above, we like to allow more
+      --  with a proper diagnostic, and in the case of a membership operation
+      --  where sets are allowed, a simple expression is permissible anyway.
+
+      Expr_Node := P_Simple_Expression_Or_Range_Attribute;
+
+      --  Range attribute
+
+      if Expr_Form = EF_Range_Attr then
+         return Expr_Node;
+
+      --  Simple_Expression .. Simple_Expression
+
+      elsif Token = Tok_Dot_Dot then
+         Check_Simple_Expression (Expr_Node);
+         Range_Node := New_Node (N_Range, Token_Ptr);
+         Set_Low_Bound (Range_Node, Expr_Node);
+         Scan; -- past ..
+         Set_High_Bound (Range_Node, P_Simple_Expression);
+         return Range_Node;
+
+      --  Case of subtype mark (optionally qualified simple name or an
+      --  attribute whose prefix is an optionally qualified simple name)
+
+      elsif Expr_Form = EF_Simple_Name
+        or else Nkind (Expr_Node) = N_Attribute_Reference
+      then
+         --  Check for error of range constraint after a subtype mark
+
+         if Token = Tok_Range then
+            Error_Msg_SC ("range constraint not allowed in membership test");
+            Scan; -- past RANGE
+            raise Error_Resync;
+
+         --  Check for error of DIGITS or DELTA after a subtype mark
+
+         elsif Token = Tok_Digits or else Token = Tok_Delta then
+            Error_Msg_SC
+              ("accuracy definition not allowed in membership test");
+            Scan; -- past DIGITS or DELTA
+            raise Error_Resync;
+
+         --  Attribute reference, may or may not be OK, but in any case we
+         --  will scan it out
+
+         elsif Token = Tok_Apostrophe then
+            return P_Subtype_Mark_Attribute (Expr_Node);
+
+         --  OK case of simple name, just return it
+
+         else
+            return Expr_Node;
+         end if;
+
+      --  Simple expression case
+
+      elsif Expr_Form = EF_Simple and then Allow_Simple_Expression then
+         return Expr_Node;
+
+      --  Here we have some kind of error situation. Check for junk parens
+      --  then return what we have, caller will deal with other errors.
+
+      else
+         if Nkind (Expr_Node) in N_Subexpr
+           and then Paren_Count (Expr_Node) /= 0
+         then
+            Error_Msg ("|parentheses not allowed for subtype mark", Save_Loc);
+            Set_Paren_Count (Expr_Node, 0);
+         end if;
+
+         return Expr_Node;
+      end if;
+   end P_Range_Or_Subtype_Mark;
+
+   ----------------------------------------
+   -- 3.5.1  Enumeration Type Definition --
+   ----------------------------------------
+
+   --  ENUMERATION_TYPE_DEFINITION ::=
+   --    (ENUMERATION_LITERAL_SPECIFICATION
+   --      {, ENUMERATION_LITERAL_SPECIFICATION})
+
+   --  The caller has already scanned out the TYPE keyword
+
+   --  Error recovery: can raise Error_Resync;
+
+   function P_Enumeration_Type_Definition return Node_Id is
+      Typedef_Node : Node_Id;
+
+   begin
+      Typedef_Node := New_Node (N_Enumeration_Type_Definition, Token_Ptr);
+      Set_Literals (Typedef_Node, New_List);
+
+      T_Left_Paren;
+
+      loop
+         Append (P_Enumeration_Literal_Specification, Literals (Typedef_Node));
+         exit when not Comma_Present;
+      end loop;
+
+      T_Right_Paren;
+      return Typedef_Node;
+   end P_Enumeration_Type_Definition;
+
+   ----------------------------------------------
+   -- 3.5.1  Enumeration Literal Specification --
+   ----------------------------------------------
+
+   --  ENUMERATION_LITERAL_SPECIFICATION ::=
+   --    DEFINING_IDENTIFIER | DEFINING_CHARACTER_LITERAL
+
+   --  Error recovery: can raise Error_Resync
+
+   function P_Enumeration_Literal_Specification return Node_Id is
+   begin
+      if Token = Tok_Char_Literal then
+         return P_Defining_Character_Literal;
+      else
+         return P_Defining_Identifier (C_Comma_Right_Paren);
+      end if;
+   end P_Enumeration_Literal_Specification;
+
+   ---------------------------------------
+   -- 3.5.1  Defining_Character_Literal --
+   ---------------------------------------
+
+   --  DEFINING_CHARACTER_LITERAL ::= CHARACTER_LITERAL
+
+   --  Error recovery: cannot raise Error_Resync
+
+   --  The caller has checked that the current token is a character literal
+
+   function P_Defining_Character_Literal return Node_Id is
+      Literal_Node : Node_Id;
+   begin
+      Literal_Node := Token_Node;
+      Change_Character_Literal_To_Defining_Character_Literal (Literal_Node);
+      Scan; -- past character literal
+      return Literal_Node;
+   end P_Defining_Character_Literal;
+
+   ------------------------------------
+   -- 3.5.4  Integer Type Definition --
+   ------------------------------------
+
+   --  Parsed by P_Type_Declaration (3.2.1)
+
+   -------------------------------------------
+   -- 3.5.4  Signed Integer Type Definition --
+   -------------------------------------------
+
+   --  SIGNED_INTEGER_TYPE_DEFINITION ::=
+   --    range static_SIMPLE_EXPRESSION .. static_SIMPLE_EXPRESSION
+
+   --  Normally the initial token on entry is RANGE, but in some
+   --  error conditions, the range token was missing and control is
+   --  passed with Token pointing to first token of the first expression.
+
+   --  Error recovery: cannot raise Error_Resync
+
+   function P_Signed_Integer_Type_Definition return Node_Id is
+      Typedef_Node : Node_Id;
+      Expr_Node    : Node_Id;
+
+   begin
+      Typedef_Node := New_Node (N_Signed_Integer_Type_Definition, Token_Ptr);
+
+      if Token = Tok_Range then
+         Scan; -- past RANGE
+      end if;
+
+      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;
+
+   ------------------------------------
+   -- 3.5.4  Modular Type Definition --
+   ------------------------------------
+
+   --  MODULAR_TYPE_DEFINITION ::= mod static_EXPRESSION
+
+   --  The caller has checked that the initial token is MOD
+
+   --  Error recovery: cannot raise Error_Resync
+
+   function P_Modular_Type_Definition return Node_Id is
+      Typedef_Node : Node_Id;
+
+   begin
+      if Ada_Version = Ada_83 then
+         Error_Msg_SC ("(Ada 83): modular types not allowed");
+      end if;
+
+      Typedef_Node := New_Node (N_Modular_Type_Definition, Token_Ptr);
+      Scan; -- past MOD
+      Set_Expression (Typedef_Node, P_Expression_No_Right_Paren);
+
+      --  Handle mod L..R cleanly
+
+      if Token = Tok_Dot_Dot then
+         Error_Msg_SC ("range not allowed for modular type");
+         Scan; -- past ..
+         Set_Expression (Typedef_Node, P_Expression_No_Right_Paren);
+      end if;
+
+      return Typedef_Node;
+   end P_Modular_Type_Definition;
+
+   ---------------------------------
+   -- 3.5.6  Real Type Definition --
+   ---------------------------------
+
+   --  Parsed by P_Type_Declaration (3.2.1)
+
+   --------------------------------------
+   -- 3.5.7  Floating Point Definition --
+   --------------------------------------
+
+   --  FLOATING_POINT_DEFINITION ::=
+   --    digits static_EXPRESSION [REAL_RANGE_SPECIFICATION]
+
+   --  Note: In Ada-83, the EXPRESSION must be a SIMPLE_EXPRESSION
+
+   --  The caller has checked that the initial token is DIGITS
+
+   --  Error recovery: cannot raise Error_Resync
+
+   function P_Floating_Point_Definition return Node_Id is
+      Digits_Loc : constant Source_Ptr := Token_Ptr;
+      Def_Node   : Node_Id;
+      Expr_Node  : Node_Id;
+
+   begin
+      Scan; -- past DIGITS
+      Expr_Node := P_Expression_No_Right_Paren;
+      Check_Simple_Expression_In_Ada_83 (Expr_Node);
+
+      --  Handle decimal fixed-point defn with DIGITS/DELTA in wrong order
+
+      if Token = Tok_Delta then
+         Error_Msg_SC -- CODEFIX
+           ("|DELTA must come before DIGITS");
+         Def_Node := New_Node (N_Decimal_Fixed_Point_Definition, Digits_Loc);
+         Scan; -- past DELTA
+         Set_Delta_Expression (Def_Node, P_Expression_No_Right_Paren);
+
+      --  OK floating-point definition
+
+      else
+         Def_Node := New_Node (N_Floating_Point_Definition, Digits_Loc);
+      end if;
+
+      Set_Digits_Expression (Def_Node, Expr_Node);
+      Set_Real_Range_Specification (Def_Node, P_Real_Range_Specification_Opt);
+      return Def_Node;
+   end P_Floating_Point_Definition;
+
+   -------------------------------------
+   -- 3.5.7  Real Range Specification --
+   -------------------------------------
+
+   --  REAL_RANGE_SPECIFICATION ::=
+   --    range static_SIMPLE_EXPRESSION .. static_SIMPLE_EXPRESSION
+
+   --  Error recovery: cannot raise Error_Resync
+
+   function P_Real_Range_Specification_Opt return Node_Id is
+      Specification_Node : Node_Id;
+      Expr_Node          : Node_Id;
+
+   begin
+      if Token = Tok_Range then
+         Specification_Node :=
+           New_Node (N_Real_Range_Specification, Token_Ptr);
+         Scan; -- past RANGE
+         Expr_Node := P_Expression_No_Right_Paren;
+         Check_Simple_Expression (Expr_Node);
+         Set_Low_Bound (Specification_Node, Expr_Node);
+         T_Dot_Dot;
+         Expr_Node := P_Expression_No_Right_Paren;
+         Check_Simple_Expression (Expr_Node);
+         Set_High_Bound (Specification_Node, Expr_Node);
+         return Specification_Node;
+      else
+         return Empty;
+      end if;
+   end P_Real_Range_Specification_Opt;
+
+   -----------------------------------
+   -- 3.5.9  Fixed Point Definition --
+   -----------------------------------
+
+   --  FIXED_POINT_DEFINITION ::=
+   --    ORDINARY_FIXED_POINT_DEFINITION | DECIMAL_FIXED_POINT_DEFINITION
+
+   --  ORDINARY_FIXED_POINT_DEFINITION ::=
+   --    delta static_EXPRESSION REAL_RANGE_SPECIFICATION
+
+   --  DECIMAL_FIXED_POINT_DEFINITION ::=
+   --    delta static_EXPRESSION
+   --      digits static_EXPRESSION [REAL_RANGE_SPECIFICATION]
+
+   --  The caller has checked that the initial token is DELTA
+
+   --  Error recovery: cannot raise Error_Resync
+
+   function P_Fixed_Point_Definition return Node_Id is
+      Delta_Node : Node_Id;
+      Delta_Loc  : Source_Ptr;
+      Def_Node   : Node_Id;
+      Expr_Node  : Node_Id;
+
+   begin
+      Delta_Loc := Token_Ptr;
+      Scan; -- past DELTA
+      Delta_Node := P_Expression_No_Right_Paren;
+      Check_Simple_Expression_In_Ada_83 (Delta_Node);
+
+      if Token = Tok_Digits then
+         if Ada_Version = Ada_83 then
+            Error_Msg_SC ("(Ada 83) decimal fixed type not allowed!");
+         end if;
+
+         Def_Node := New_Node (N_Decimal_Fixed_Point_Definition, Delta_Loc);
+         Scan; -- past DIGITS
+         Expr_Node := P_Expression_No_Right_Paren;
+         Check_Simple_Expression_In_Ada_83 (Expr_Node);
+         Set_Digits_Expression (Def_Node, Expr_Node);
+
+      else
+         Def_Node := New_Node (N_Ordinary_Fixed_Point_Definition, Delta_Loc);
+
+         --  Range is required in ordinary fixed point case
+
+         if Token /= Tok_Range then
+            Error_Msg_AP ("range must be given for fixed-point type");
+            T_Range;
+         end if;
+      end if;
+
+      Set_Delta_Expression (Def_Node, Delta_Node);
+      Set_Real_Range_Specification (Def_Node, P_Real_Range_Specification_Opt);
+      return Def_Node;
+   end P_Fixed_Point_Definition;
+
+   --------------------------------------------
+   -- 3.5.9  Ordinary Fixed Point Definition --
+   --------------------------------------------
+
+   --  Parsed by P_Fixed_Point_Definition (3.5.9)
+
+   -------------------------------------------
+   -- 3.5.9  Decimal Fixed Point Definition --
+   -------------------------------------------
+
+   --  Parsed by P_Decimal_Point_Definition (3.5.9)
+
+   ------------------------------
+   -- 3.5.9  Digits Constraint --
+   ------------------------------
+
+   --  DIGITS_CONSTRAINT ::=
+   --    digits static_EXPRESSION [RANGE_CONSTRAINT]
+
+   --  Note: in Ada 83, the EXPRESSION must be a SIMPLE_EXPRESSION
+
+   --  The caller has checked that the initial token is DIGITS
+
+   function P_Digits_Constraint return Node_Id is
+      Constraint_Node : Node_Id;
+      Expr_Node : Node_Id;
+
+   begin
+      Constraint_Node := New_Node (N_Digits_Constraint, Token_Ptr);
+      Scan; -- past DIGITS
+      Expr_Node := P_Expression;
+      Check_Simple_Expression_In_Ada_83 (Expr_Node);
+      Set_Digits_Expression (Constraint_Node, Expr_Node);
+
+      if Token = Tok_Range then
+         Set_Range_Constraint (Constraint_Node, P_Range_Constraint);
+      end if;
+
+      return Constraint_Node;
+   end P_Digits_Constraint;
+
+   -----------------------------
+   -- 3.5.9  Delta Constraint --
+   -----------------------------
+
+   --  DELTA CONSTRAINT ::= DELTA STATIC_EXPRESSION [RANGE_CONSTRAINT]
+
+   --  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
+
+   --  Error recovery: cannot raise Error_Resync
+
+   function P_Delta_Constraint return Node_Id is
+      Constraint_Node : Node_Id;
+      Expr_Node : Node_Id;
+
+   begin
+      Constraint_Node := New_Node (N_Delta_Constraint, Token_Ptr);
+      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
+         Set_Range_Constraint (Constraint_Node, P_Range_Constraint);
+      end if;
+
+      return Constraint_Node;
+   end P_Delta_Constraint;
+
+   --------------------------------
+   -- 3.6  Array Type Definition --
+   --------------------------------
+
+   --  ARRAY_TYPE_DEFINITION ::=
+   --    UNCONSTRAINED_ARRAY_DEFINITION | CONSTRAINED_ARRAY_DEFINITION
+
+   --  UNCONSTRAINED_ARRAY_DEFINITION ::=
+   --    array (INDEX_SUBTYPE_DEFINITION {, INDEX_SUBTYPE_DEFINITION}) of
+   --      COMPONENT_DEFINITION
+
+   --  INDEX_SUBTYPE_DEFINITION ::= SUBTYPE_MARK range <>
+
+   --  CONSTRAINED_ARRAY_DEFINITION ::=
+   --    array (DISCRETE_SUBTYPE_DEFINITION {, DISCRETE_SUBTYPE_DEFINITION}) of
+   --      COMPONENT_DEFINITION
+
+   --  DISCRETE_SUBTYPE_DEFINITION ::=
+   --    DISCRETE_SUBTYPE_INDICATION | RANGE
+
+   --  COMPONENT_DEFINITION ::=
+   --    [aliased] [NULL_EXCLUSION] SUBTYPE_INDICATION | ACCESS_DEFINITION
+
+   --  The caller has checked that the initial token is ARRAY
+
+   --  Error recovery: can raise Error_Resync
+
+   function P_Array_Type_Definition return Node_Id is
+      Array_Loc        : Source_Ptr;
+      CompDef_Node     : Node_Id;
+      Def_Node         : Node_Id;
+      Not_Null_Present : Boolean := False;
+      Subs_List        : List_Id;
+      Scan_State       : Saved_Scan_State;
+      Aliased_Present  : Boolean := False;
+
+   begin
+      Array_Loc := Token_Ptr;
+      Scan; -- past ARRAY
+      Subs_List := New_List;
+      T_Left_Paren;
+
+      --  It's quite tricky to disentangle these two possibilities, so we do
+      --  a prescan to determine which case we have and then reset the scan.
+      --  The prescan skips past possible subtype mark tokens.
+
+      Save_Scan_State (Scan_State); -- just after paren
+
+      while Token in Token_Class_Desig or else
+            Token = Tok_Dot or else
+            Token = Tok_Apostrophe -- because of 'BASE, 'CLASS
+      loop
+         Scan;
+      end loop;
+
+      --  If we end up on RANGE <> then we have the unconstrained case. We
+      --  will also allow the RANGE to be omitted, just to improve error
+      --  handling for a case like array (integer <>) of integer;
+
+      Scan; -- past possible RANGE or <>
+
+      if (Prev_Token = Tok_Range and then Token = Tok_Box) or else
+         Prev_Token = Tok_Box
+      then
+         Def_Node := New_Node (N_Unconstrained_Array_Definition, Array_Loc);
+         Restore_Scan_State (Scan_State); -- to first subtype mark
+
+         loop
+            Append (P_Subtype_Mark_Resync, Subs_List);
+            T_Range;
+            T_Box;
+            exit when Token = Tok_Right_Paren or else Token = Tok_Of;
+            T_Comma;
+         end loop;
+
+         Set_Subtype_Marks (Def_Node, Subs_List);
+
+      else
+         Def_Node := New_Node (N_Constrained_Array_Definition, Array_Loc);
+         Restore_Scan_State (Scan_State); -- to first discrete range
+
+         loop
+            Append (P_Discrete_Subtype_Definition, Subs_List);
+            exit when not Comma_Present;
+         end loop;
+
+         Set_Discrete_Subtype_Definitions (Def_Node, Subs_List);
+      end if;
+
+      T_Right_Paren;
+      T_Of;
+
+      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 Ada_Version < Ada_2005 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;
+
+         --  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_Access_Definition      (CompDef_Node,
+           P_Access_Definition (Not_Null_Present));
+      else
+
+         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);
+
+      return Def_Node;
+   end P_Array_Type_Definition;
+
+   -----------------------------------------
+   -- 3.6  Unconstrained Array Definition --
+   -----------------------------------------
+
+   --  Parsed by P_Array_Type_Definition (3.6)
+
+   ---------------------------------------
+   -- 3.6  Constrained Array Definition --
+   ---------------------------------------
+
+   --  Parsed by P_Array_Type_Definition (3.6)
+
+   --------------------------------------
+   -- 3.6  Discrete Subtype Definition --
+   --------------------------------------
+
+   --  DISCRETE_SUBTYPE_DEFINITION ::=
+   --    discrete_SUBTYPE_INDICATION | RANGE
+
+   --  Note: the discrete subtype definition appearing in a constrained
+   --  array definition is parsed by P_Array_Type_Definition (3.6)
+
+   --  Error recovery: cannot raise Error_Resync
+
+   function P_Discrete_Subtype_Definition return Node_Id is
+   begin
+      --  The syntax of a discrete subtype definition is identical to that
+      --  of a discrete range, so we simply share the same parsing code.
+
+      return P_Discrete_Range;
+   end P_Discrete_Subtype_Definition;
+
+   -------------------------------
+   -- 3.6  Component Definition --
+   -------------------------------
+
+   --  For the array case, parsed by P_Array_Type_Definition (3.6)
+   --  For the record case, parsed by P_Component_Declaration (3.8)
+
+   -----------------------------
+   -- 3.6.1  Index Constraint --
+   -----------------------------
+
+   --  Parsed by P_Index_Or_Discriminant_Constraint (3.7.1)
+
+   ---------------------------
+   -- 3.6.1  Discrete Range --
+   ---------------------------
+
+   --  DISCRETE_RANGE ::= discrete_SUBTYPE_INDICATION | RANGE
+
+   --  The possible forms for a discrete range are:
+
+      --   Subtype_Mark                           (SUBTYPE_INDICATION, 3.2.2)
+      --   Subtype_Mark range Range               (SUBTYPE_INDICATION, 3.2.2)
+      --   Range_Attribute                        (RANGE, 3.5)
+      --   Simple_Expression .. Simple_Expression (RANGE, 3.5)
+
+   --  Error recovery: cannot raise Error_Resync
+
+   function P_Discrete_Range return Node_Id is
+      Expr_Node  : Node_Id;
+      Range_Node : Node_Id;
+
+   begin
+      Expr_Node := P_Simple_Expression_Or_Range_Attribute;
+
+      if Expr_Form = EF_Range_Attr then
+         return Expr_Node;
+
+      elsif Token = Tok_Range then
+         if Expr_Form /= EF_Simple_Name then
+            Error_Msg_SC ("range must be preceded by subtype mark");
+         end if;
+
+         return P_Subtype_Indication (Expr_Node);
+
+      --  Check Expression .. Expression case
+
+      elsif Token = Tok_Dot_Dot then
+         Range_Node := New_Node (N_Range, Token_Ptr);
+         Set_Low_Bound (Range_Node, Expr_Node);
+         Scan; -- past ..
+         Expr_Node := P_Expression;
+         Check_Simple_Expression (Expr_Node);
+         Set_High_Bound (Range_Node, Expr_Node);
+         return Range_Node;
+
+      --  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
+         T_Dot_Dot;
+         return Expr_Node;
+      end if;
+   end P_Discrete_Range;
+
+   ----------------------------
+   -- 3.7  Discriminant Part --
+   ----------------------------
+
+   --  DISCRIMINANT_PART ::=
+   --    UNKNOWN_DISCRIMINANT_PART
+   --  | KNOWN_DISCRIMINANT_PART
+
+   --  A discriminant part is parsed by P_Known_Discriminant_Part_Opt (3.7)
+   --  or P_Unknown_Discriminant_Part (3.7), since we know which we want.
+
+   ------------------------------------
+   -- 3.7  Unknown Discriminant Part --
+   ------------------------------------
+
+   --  UNKNOWN_DISCRIMINANT_PART ::= (<>)
+
+   --  If no unknown discriminant part is present, then False is returned,
+   --  otherwise the unknown discriminant is scanned out and True is returned.
+
+   --  Error recovery: cannot raise Error_Resync
+
+   function P_Unknown_Discriminant_Part_Opt return Boolean is
+      Scan_State : Saved_Scan_State;
+
+   begin
+      --  If <> right now, then this is missing left paren
+
+      if Token = Tok_Box then
+         U_Left_Paren;
+
+      --  If not <> or left paren, then definitely no box
+
+      elsif Token /= Tok_Left_Paren then
+         return False;
+
+      --  Left paren, so might be a box after it
+
+      else
+         Save_Scan_State (Scan_State);
+         Scan; -- past the left paren
+
+         if Token /= Tok_Box then
+            Restore_Scan_State (Scan_State);
+            return False;
+         end if;
+      end if;
+
+      --  We are now pointing to the box
+
+      if Ada_Version = Ada_83 then
+         Error_Msg_SC ("(Ada 83) unknown discriminant not allowed!");
+      end if;
+
+      Scan; -- past the box
+      U_Right_Paren; -- must be followed by right paren
+      return True;
+   end P_Unknown_Discriminant_Part_Opt;
+
+   ----------------------------------
+   -- 3.7  Known Discriminant Part --
+   ----------------------------------
+
+   --  KNOWN_DISCRIMINANT_PART ::=
+   --    (DISCRIMINANT_SPECIFICATION {; DISCRIMINANT_SPECIFICATION})
+
+   --  DISCRIMINANT_SPECIFICATION ::=
+   --    DEFINING_IDENTIFIER_LIST : [NULL_EXCLUSION] SUBTYPE_MARK
+   --      [:= DEFAULT_EXPRESSION]
+   --  | DEFINING_IDENTIFIER_LIST : ACCESS_DEFINITION
+   --      [:= DEFAULT_EXPRESSION]
+
+   --  If no known discriminant part is present, then No_List is returned
+
+   --  Error recovery: cannot raise Error_Resync
+
+   function P_Known_Discriminant_Part_Opt return List_Id is
+      Specification_Node : Node_Id;
+      Specification_List : List_Id;
+      Ident_Sloc         : Source_Ptr;
+      Scan_State         : Saved_Scan_State;
+      Num_Idents         : Nat;
+      Not_Null_Present   : Boolean;
+      Ident              : Nat;
+
+      Idents : array (Int range 1 .. 4096) of Entity_Id;
+      --  This array holds the list of defining identifiers. The upper bound
+      --  of 4096 is intended to be essentially infinite, and we do not even
+      --  bother to check for it being exceeded.
+
+   begin
+      if Token = Tok_Left_Paren then
+         Specification_List := New_List;
+         Scan; -- past (
+         P_Pragmas_Misplaced;
+
+         Specification_Loop : loop
+
+            Ident_Sloc := Token_Ptr;
+            Idents (1) := P_Defining_Identifier (C_Comma_Colon);
+            Num_Idents := 1;
+
+            while Comma_Present loop
+               Num_Idents := Num_Idents + 1;
+               Idents (Num_Idents) := P_Defining_Identifier (C_Comma_Colon);
+            end loop;
+
+            --  If there are multiple identifiers, we repeatedly scan the
+            --  type and initialization expression information by resetting
+            --  the scan pointer (so that we get completely separate trees
+            --  for each occurrence).
+
+            if Num_Idents > 1 then
+               Save_Scan_State (Scan_State);
+            end if;
+
+            T_Colon;
+
+            --  Loop through defining identifiers in list
+
+            Ident := 1;
+            Ident_Loop : loop
+               Specification_Node :=
+                 New_Node (N_Discriminant_Specification, Ident_Sloc);
+               Set_Defining_Identifier (Specification_Node, Idents (Ident));
+               Not_Null_Present :=  --  Ada 2005 (AI-231, AI-447)
+                 P_Null_Exclusion (Allow_Anonymous_In_95 => True);
+
+               if Token = Tok_Access 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 (Not_Null_Present));
+
+               --  Catch ouf-of-order keywords
+
+               elsif Token = Tok_Constant then
+                  Scan;
+
+                  if Token = Tok_Access then
+                     Error_Msg_SC ("CONSTANT must appear after ACCESS");
+                     Set_Discriminant_Type
+                       (Specification_Node,
+                        P_Access_Definition (Not_Null_Present));
+
+                  else
+                     Error_Msg_SC ("misplaced CONSTANT");
+                  end if;
+
+               else
+                  Set_Discriminant_Type
+                    (Specification_Node, P_Subtype_Mark);
+                  No_Constraint;
+                  Set_Null_Exclusion_Present  -- Ada 2005 (AI-231)
+                    (Specification_Node, Not_Null_Present);
+               end if;
+
+               Set_Expression
+                 (Specification_Node, Init_Expr_Opt (True));
+
+               if Ident > 1 then
+                  Set_Prev_Ids (Specification_Node, True);
+               end if;
+
+               if Ident < Num_Idents then
+                  Set_More_Ids (Specification_Node, True);
+               end if;
+
+               Append (Specification_Node, Specification_List);
+               exit Ident_Loop when Ident = Num_Idents;
+               Ident := Ident + 1;
+               Restore_Scan_State (Scan_State);
+               T_Colon;
+            end loop Ident_Loop;
+
+            exit Specification_Loop when Token /= Tok_Semicolon;
+            Scan; -- past ;
+            P_Pragmas_Misplaced;
+         end loop Specification_Loop;
+
+         T_Right_Paren;
+         return Specification_List;
+
+      else
+         return No_List;
+      end if;
+   end P_Known_Discriminant_Part_Opt;
+
+   -------------------------------------
+   -- 3.7  Discriminant Specification --
+   -------------------------------------
+
+   --  Parsed by P_Known_Discriminant_Part_Opt (3.7)
+
+   -----------------------------
+   -- 3.7  Default Expression --
+   -----------------------------
+
+   --  Always parsed (simply as an Expression) by the parent construct
+
+   ------------------------------------
+   -- 3.7.1  Discriminant Constraint --
+   ------------------------------------
+
+   --  Parsed by P_Index_Or_Discriminant_Constraint (3.7.1)
+
+   --------------------------------------------------------
+   -- 3.7.1  Index or Discriminant Constraint (also 3.6) --
+   --------------------------------------------------------
+
+   --  DISCRIMINANT_CONSTRAINT ::=
+   --    (DISCRIMINANT_ASSOCIATION {, DISCRIMINANT_ASSOCIATION})
+
+   --  DISCRIMINANT_ASSOCIATION ::=
+   --    [discriminant_SELECTOR_NAME {| discriminant_SELECTOR_NAME} =>]
+   --      EXPRESSION
+
+   --  This routine parses either an index or a discriminant constraint. As
+   --  is clear from the above grammar, it is often possible to clearly
+   --  determine which of the two possibilities we have, but there are
+   --  cases (those in which we have a series of expressions of the same
+   --  syntactic form as subtype indications), where we cannot tell. Since
+   --  this means that in any case the semantic phase has to distinguish
+   --  between the two, there is not much point in the parser trying to
+   --  distinguish even those cases where the difference is clear. In any
+   --  case, if we have a situation like:
+
+   --     (A => 123, 235 .. 500)
+
+   --  it is not clear which of the two items is the wrong one, better to
+   --  let the semantic phase give a clear message. Consequently, this
+   --  routine in general returns a list of items which can be either
+   --  discrete ranges or discriminant associations.
+
+   --  The caller has checked that the initial token is a left paren
+
+   --  Error recovery: can raise Error_Resync
+
+   function P_Index_Or_Discriminant_Constraint return Node_Id is
+      Scan_State  : Saved_Scan_State;
+      Constr_Node : Node_Id;
+      Constr_List : List_Id;
+      Expr_Node   : Node_Id;
+      Result_Node : Node_Id;
+
+   begin
+      Result_Node := New_Node (N_Index_Or_Discriminant_Constraint, Token_Ptr);
+      Scan; -- past (
+      Constr_List := New_List;
+      Set_Constraints (Result_Node, Constr_List);
+
+      --  The two syntactic forms are a little mixed up, so what we are doing
+      --  here is looking at the first entry to determine which case we have
+
+      --  A discriminant constraint is a list of discriminant associations,
+      --  which have one of the following possible forms:
+
+      --    Expression
+      --    Id => Expression
+      --    Id | Id | .. | Id => Expression
+
+      --  An index constraint is a list of discrete ranges which have one
+      --  of the following possible forms:
+
+      --    Subtype_Mark
+      --    Subtype_Mark range Range
+      --    Range_Attribute
+      --    Simple_Expression .. Simple_Expression
+
+      --  Loop through discriminants in list
+
+      loop
+         --  Check cases of Id => Expression or Id | Id => Expression
+
+         if Token = Tok_Identifier then
+            Save_Scan_State (Scan_State); -- at Id
+            Scan; -- past Id
+
+            if Token = Tok_Arrow or else Token = Tok_Vertical_Bar then
+               Restore_Scan_State (Scan_State); -- to Id
+               Append (P_Discriminant_Association, Constr_List);
+               goto Loop_Continue;
+            else
+               Restore_Scan_State (Scan_State); -- to Id
+            end if;
+         end if;
+
+         --  Otherwise scan out an expression and see what we have got
+
+         Expr_Node := P_Expression_Or_Range_Attribute;
+
+         if Expr_Form = EF_Range_Attr then
+            Append (Expr_Node, Constr_List);
+
+         elsif Token = Tok_Range then
+            if Expr_Form /= EF_Simple_Name then
+               Error_Msg_SC ("subtype mark required before RANGE");
+            end if;
+
+            Append (P_Subtype_Indication (Expr_Node), Constr_List);
+            goto Loop_Continue;
+
+         --  Check Simple_Expression .. Simple_Expression case
+
+         elsif Token = Tok_Dot_Dot then
+            Check_Simple_Expression (Expr_Node);
+            Constr_Node := New_Node (N_Range, Token_Ptr);
+            Set_Low_Bound (Constr_Node, Expr_Node);
+            Scan; -- past ..
+            Expr_Node := P_Expression;
+            Check_Simple_Expression (Expr_Node);
+            Set_High_Bound (Constr_Node, Expr_Node);
+            Append (Constr_Node, Constr_List);
+            goto Loop_Continue;
+
+         --  Case of an expression which could be either form
+
+         else
+            Append (Expr_Node, Constr_List);
+            goto Loop_Continue;
+         end if;
+
+         --  Here with a single entry scanned
+
+         <<Loop_Continue>>
+            exit when not Comma_Present;
+
+      end loop;
+
+      T_Right_Paren;
+      return Result_Node;
+   end P_Index_Or_Discriminant_Constraint;
+
+   -------------------------------------
+   -- 3.7.1  Discriminant Association --
+   -------------------------------------
+
+   --  DISCRIMINANT_ASSOCIATION ::=
+   --    [discriminant_SELECTOR_NAME {| discriminant_SELECTOR_NAME} =>]
+   --      EXPRESSION
+
+   --  This routine is used only when the name list is present and the caller
+   --  has already checked this (by scanning ahead and repositioning the
+   --  scan).
+
+   --  Error_Recovery: cannot raise Error_Resync;
+
+   function P_Discriminant_Association return Node_Id is
+      Discr_Node : Node_Id;
+      Names_List : List_Id;
+      Ident_Sloc : Source_Ptr;
+
+   begin
+      Ident_Sloc := Token_Ptr;
+      Names_List := New_List;
+
+      loop
+         Append (P_Identifier (C_Vertical_Bar_Arrow), Names_List);
+         exit when Token /= Tok_Vertical_Bar;
+         Scan; -- past |
+      end loop;
+
+      Discr_Node := New_Node (N_Discriminant_Association, Ident_Sloc);
+      Set_Selector_Names (Discr_Node, Names_List);
+      TF_Arrow;
+      Set_Expression (Discr_Node, P_Expression);
+      return Discr_Node;
+   end P_Discriminant_Association;
+
+   ---------------------------------
+   -- 3.8  Record Type Definition --
+   ---------------------------------
+
+   --  RECORD_TYPE_DEFINITION ::=
+   --    [[abstract] tagged] [limited] RECORD_DEFINITION
+
+   --  There is no node in the tree for a record type definition. Instead
+   --  a record definition node appears, with possible Abstract_Present,
+   --  Tagged_Present, and Limited_Present flags set appropriately.
+
+   ----------------------------
+   -- 3.8  Record Definition --
+   ----------------------------
+
+   --  RECORD_DEFINITION ::=
+   --    record
+   --      COMPONENT_LIST
+   --    end record
+   --  | null record
+
+   --  Note: in the case where a record definition node is used to represent
+   --  a record type definition, the caller sets the Tagged_Present and
+   --  Limited_Present flags in the resulting N_Record_Definition node as
+   --  required.
+
+   --  Note that the RECORD token at the start may be missing in certain
+   --  error situations, so this function is expected to post the error
+
+   --  Error recovery: can raise Error_Resync
+
+   function P_Record_Definition return Node_Id is
+      Rec_Node : Node_Id;
+
+   begin
+      Inside_Record_Definition := True;
+      Rec_Node := New_Node (N_Record_Definition, Token_Ptr);
+
+      --  Null record case
+
+      if Token = Tok_Null then
+         Scan; -- past NULL
+         T_Record;
+         Set_Null_Present (Rec_Node, True);
+
+      --  Catch incomplete declaration to prevent cascaded errors, see
+      --  ACATS B393002 for an example.
+
+      elsif Token = Tok_Semicolon then
+         Error_Msg_AP ("missing record definition");
+
+      --  Case starting with RECORD keyword. Build scope stack entry. For the
+      --  column, we use the first non-blank character on the line, to deal
+      --  with situations such as:
+
+      --    type X is record
+      --      ...
+      --    end record;
+
+      --  which is not official RM indentation, but is not uncommon usage, and
+      --  in particular is standard GNAT coding style, so handle it nicely.
+
+      else
+         Push_Scope_Stack;
+         Scope.Table (Scope.Last).Etyp := E_Record;
+         Scope.Table (Scope.Last).Ecol := Start_Column;
+         Scope.Table (Scope.Last).Sloc := Token_Ptr;
+         Scope.Table (Scope.Last).Labl := Error;
+         Scope.Table (Scope.Last).Junk := (Token /= Tok_Record);
+
+         T_Record;
+
+         Set_Component_List (Rec_Node, P_Component_List);
+
+         loop
+            exit when Check_End;
+            Discard_Junk_Node (P_Component_List);
+         end loop;
+      end if;
+
+      Inside_Record_Definition := False;
+      return Rec_Node;
+   end P_Record_Definition;
+
+   -------------------------
+   -- 3.8  Component List --
+   -------------------------
+
+   --  COMPONENT_LIST ::=
+   --    COMPONENT_ITEM {COMPONENT_ITEM}
+   --  | {COMPONENT_ITEM} VARIANT_PART
+   --  | null;
+
+   --  Error recovery: cannot raise Error_Resync
+
+   function P_Component_List return Node_Id is
+      Component_List_Node : Node_Id;
+      Decls_List          : List_Id;
+      Scan_State          : Saved_Scan_State;
+      Null_Loc            : Source_Ptr;
+
+   begin
+      Component_List_Node := New_Node (N_Component_List, Token_Ptr);
+      Decls_List := New_List;
+
+      --  Handle null
+
+      if Token = Tok_Null then
+         Null_Loc := Token_Ptr;
+         Scan; -- past NULL
+         TF_Semicolon;
+         P_Pragmas_Opt (Decls_List);
+
+         --  If we have an END or WHEN now, everything is fine, otherwise we
+         --  complain about the null, ignore it, and scan for more components.
+
+         if Token = Tok_End or else Token = Tok_When then
+            Set_Null_Present (Component_List_Node, True);
+            return Component_List_Node;
+         else
+            Error_Msg ("NULL component only allowed in null record", Null_Loc);
+         end if;
+      end if;
+
+      --  Scan components for non-null record
+
+      P_Pragmas_Opt (Decls_List);
+
+      if Token /= Tok_Case then
+         Component_Scan_Loop : loop
+            P_Component_Items (Decls_List);
+            P_Pragmas_Opt (Decls_List);
+
+            exit Component_Scan_Loop when Token = Tok_End
+              or else Token = Tok_Case
+              or else Token = Tok_When;
+
+            --  We are done if we do not have an identifier. However, if we
+            --  have a misspelled reserved identifier that is in a column to
+            --  the right of the record definition, we will treat it as an
+            --  identifier. It turns out to be too dangerous in practice to
+            --  accept such a mis-spelled identifier which does not have this
+            --  additional clue that confirms the incorrect spelling.
+
+            if Token /= Tok_Identifier then
+               if Start_Column > Scope.Table (Scope.Last).Ecol
+                 and then Is_Reserved_Identifier
+               then
+                  Save_Scan_State (Scan_State); -- at reserved id
+                  Scan; -- possible reserved id
+
+                  if Token = Tok_Comma or else Token = Tok_Colon then
+                     Restore_Scan_State (Scan_State);
+                     Scan_Reserved_Identifier (Force_Msg => True);
+
+                     --  Note reserved identifier used as field name after all
+                     --  because not followed by colon or comma.
+
+                  else
+                     Restore_Scan_State (Scan_State);
+                     exit Component_Scan_Loop;
+                  end if;
+
+                  --  Non-identifier that definitely was not reserved id
+
+               else
+                  exit Component_Scan_Loop;
+               end if;
+            end if;
+         end loop Component_Scan_Loop;
+      end if;
+
+      if Token = Tok_Case then
+         Set_Variant_Part (Component_List_Node, P_Variant_Part);
+
+         --  Check for junk after variant part
+
+         if Token = Tok_Identifier then
+            Save_Scan_State (Scan_State);
+            Scan; -- past identifier
+
+            if Token = Tok_Colon then
+               Restore_Scan_State (Scan_State);
+               Error_Msg_SC ("component may not follow variant part");
+               Discard_Junk_Node (P_Component_List);
+
+            elsif Token = Tok_Case then
+               Restore_Scan_State (Scan_State);
+               Error_Msg_SC ("only one variant part allowed in a record");
+               Discard_Junk_Node (P_Component_List);
+
+            else
+               Restore_Scan_State (Scan_State);
+            end if;
+         end if;
+      end if;
+
+      Set_Component_Items (Component_List_Node, Decls_List);
+      return Component_List_Node;
+   end P_Component_List;
+
+   -------------------------
+   -- 3.8  Component Item --
+   -------------------------
+
+   --  COMPONENT_ITEM ::= COMPONENT_DECLARATION | REPRESENTATION_CLAUSE
+
+   --  COMPONENT_DECLARATION ::=
+   --    DEFINING_IDENTIFIER_LIST : COMPONENT_DEFINITION
+   --      [:= DEFAULT_EXPRESSION]
+   --        [ASPECT_SPECIFICATIONS];
+
+   --  COMPONENT_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.
+
+   --  Note: we do not yet allow representation clauses to appear as component
+   --  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 := Empty;  -- initialize to prevent warning
+      Scan_State       : Saved_Scan_State;
+      Not_Null_Present : Boolean := False;
+      Num_Idents       : Nat;
+      Ident            : Nat;
+      Ident_Sloc       : Source_Ptr;
+
+      Idents : array (Int range 1 .. 4096) of Entity_Id;
+      --  This array holds the list of defining identifiers. The upper bound
+      --  of 4096 is intended to be essentially infinite, and we do not even
+      --  bother to check for it being exceeded.
+
+   begin
+      if Token /= Tok_Identifier then
+         Error_Msg_SC ("component declaration expected");
+         Resync_Past_Semicolon;
+         return;
+      end if;
+
+      Ident_Sloc := Token_Ptr;
+      Check_Bad_Layout;
+      Idents (1) := P_Defining_Identifier (C_Comma_Colon);
+      Num_Idents := 1;
+
+      while Comma_Present loop
+         Num_Idents := Num_Idents + 1;
+         Idents (Num_Idents) := P_Defining_Identifier (C_Comma_Colon);
+      end loop;
+
+      --  If there are multiple identifiers, we repeatedly scan the
+      --  type and initialization expression information by resetting
+      --  the scan pointer (so that we get completely separate trees
+      --  for each occurrence).
+
+      if Num_Idents > 1 then
+         Save_Scan_State (Scan_State);
+      end if;
+
+      T_Colon;
+
+      --  Loop through defining identifiers in list
+
+      Ident := 1;
+      Ident_Loop : loop
+
+         --  The following block is present to catch Error_Resync
+         --  which causes the parse to be reset past the semicolon
+
+         begin
+            Decl_Node := New_Node (N_Component_Declaration, Ident_Sloc);
+            Set_Defining_Identifier (Decl_Node, Idents (Ident));
+
+            if Token = Tok_Constant then
+               Error_Msg_SC ("constant components are not permitted");
+               Scan;
+            end if;
+
+            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 Ada_Version < Ada_2005 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;
+
+               --  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);
+               Set_Access_Definition  (CompDef_Node,
+                 P_Access_Definition (Not_Null_Present));
+            else
+
+               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 ("anonymous arrays not allowed as components");
+                  raise Error_Resync;
+               end if;
+
+               Set_Subtype_Indication (CompDef_Node,
+                 P_Subtype_Indication (Not_Null_Present));
+            end if;
+
+            Set_Component_Definition (Decl_Node, CompDef_Node);
+            Set_Expression           (Decl_Node, Init_Expr_Opt);
+
+            if Ident > 1 then
+               Set_Prev_Ids (Decl_Node, True);
+            end if;
+
+            if Ident < Num_Idents then
+               Set_More_Ids (Decl_Node, True);
+            end if;
+
+            Append (Decl_Node, Decls);
+
+         exception
+            when Error_Resync =>
+               if Token /= Tok_End then
+                  Resync_Past_Semicolon;
+               end if;
+         end;
+
+         exit Ident_Loop when Ident = Num_Idents;
+         Ident := Ident + 1;
+         Restore_Scan_State (Scan_State);
+         T_Colon;
+      end loop Ident_Loop;
+
+      P_Aspect_Specifications (Decl_Node);
+   end P_Component_Items;
+
+   --------------------------------
+   -- 3.8  Component Declaration --
+   --------------------------------
+
+   --  Parsed by P_Component_Items (3.8)
+
+   -------------------------
+   -- 3.8.1  Variant Part --
+   -------------------------
+
+   --  VARIANT_PART ::=
+   --    case discriminant_DIRECT_NAME is
+   --      VARIANT
+   --      {VARIANT}
+   --    end case;
+
+   --  The caller has checked that the initial token is CASE
+
+   --  Error recovery: cannot raise Error_Resync
+
+   function P_Variant_Part return Node_Id is
+      Variant_Part_Node : Node_Id;
+      Variants_List     : List_Id;
+      Case_Node         : Node_Id;
+
+   begin
+      Variant_Part_Node := New_Node (N_Variant_Part, Token_Ptr);
+      Push_Scope_Stack;
+      Scope.Table (Scope.Last).Etyp := E_Case;
+      Scope.Table (Scope.Last).Sloc := Token_Ptr;
+      Scope.Table (Scope.Last).Ecol := Start_Column;
+
+      Scan; -- past CASE
+      Case_Node := P_Expression;
+      Set_Name (Variant_Part_Node, Case_Node);
+
+      if Nkind (Case_Node) /= N_Identifier then
+         Set_Name (Variant_Part_Node, Error);
+         Error_Msg ("discriminant name expected", Sloc (Case_Node));
+
+      elsif Paren_Count (Case_Node) /= 0 then
+         Error_Msg
+           ("|discriminant name may not be parenthesized",
+                    Sloc (Case_Node));
+         Set_Paren_Count (Case_Node, 0);
+      end if;
+
+      TF_Is;
+      Variants_List := New_List;
+      P_Pragmas_Opt (Variants_List);
+
+      --  Test missing variant
+
+      if Token = Tok_End then
+         Error_Msg_BC ("WHEN expected (must have at least one variant)");
+      else
+         Append (P_Variant, Variants_List);
+      end if;
+
+      --  Loop through variants, note that we allow if in place of when,
+      --  this error will be detected and handled in P_Variant.
+
+      loop
+         P_Pragmas_Opt (Variants_List);
+
+         if Token /= Tok_When
+           and then Token /= Tok_If
+           and then Token /= Tok_Others
+         then
+            exit when Check_End;
+         end if;
+
+         Append (P_Variant, Variants_List);
+      end loop;
+
+      Set_Variants (Variant_Part_Node, Variants_List);
+      return Variant_Part_Node;
+   end P_Variant_Part;
+
+   --------------------
+   -- 3.8.1  Variant --
+   --------------------
+
+   --  VARIANT ::=
+   --    when DISCRETE_CHOICE_LIST =>
+   --      COMPONENT_LIST
+
+   --  Error recovery: cannot raise Error_Resync
+
+   --  The initial token on entry is either WHEN, IF or OTHERS
+
+   function P_Variant return Node_Id is
+      Variant_Node : Node_Id;
+
+   begin
+      --  Special check to recover nicely from use of IF in place of WHEN
+
+      if Token = Tok_If then
+         T_When;
+         Scan; -- past IF
+      else
+         T_When;
+      end if;
+
+      Variant_Node := New_Node (N_Variant, Prev_Token_Ptr);
+      Set_Discrete_Choices (Variant_Node, P_Discrete_Choice_List);
+      TF_Arrow;
+      Set_Component_List (Variant_Node, P_Component_List);
+      return Variant_Node;
+   end P_Variant;
+
+   ---------------------------------
+   -- 3.8.1  Discrete Choice List --
+   ---------------------------------
+
+   --  DISCRETE_CHOICE_LIST ::= DISCRETE_CHOICE {| DISCRETE_CHOICE}
+
+   --  DISCRETE_CHOICE ::= EXPRESSION | DISCRETE_RANGE | others
+
+   --  Note: in Ada 83, the expression must be a simple expression
+
+   --  Error recovery: cannot raise Error_Resync
+
+   function P_Discrete_Choice_List return List_Id is
+      Choices     : List_Id;
+      Expr_Node   : Node_Id := Empty;  -- initialize to prevent warning
+      Choice_Node : Node_Id;
+
+   begin
+      Choices := New_List;
+      loop
+         if Token = Tok_Others then
+            Append (New_Node (N_Others_Choice, Token_Ptr), Choices);
+            Scan; -- past OTHERS
+
+         else
+            begin
+               --  Scan out expression or range attribute
+
+               Expr_Node := P_Expression_Or_Range_Attribute;
+               Ignore (Tok_Right_Paren);
+
+               if Token = Tok_Colon
+                 and then Nkind (Expr_Node) = N_Identifier
+               then
+                  Error_Msg_SP ("label not permitted in this context");
+                  Scan; -- past colon
+
+               --  Range attribute
+
+               elsif Expr_Form = EF_Range_Attr then
+                  Append (Expr_Node, Choices);
+
+               --  Explicit range
+
+               elsif Token = Tok_Dot_Dot then
+                  Check_Simple_Expression (Expr_Node);
+                  Choice_Node := New_Node (N_Range, Token_Ptr);
+                  Set_Low_Bound (Choice_Node, Expr_Node);
+                  Scan; -- past ..
+                  Expr_Node := P_Expression_No_Right_Paren;
+                  Check_Simple_Expression (Expr_Node);
+                  Set_High_Bound (Choice_Node, Expr_Node);
+                  Append (Choice_Node, Choices);
+
+               --  Simple name, must be subtype, so range allowed
+
+               elsif Expr_Form = EF_Simple_Name then
+                  if Token = Tok_Range then
+                     Append (P_Subtype_Indication (Expr_Node), Choices);
+
+                  elsif Token in Token_Class_Consk then
+                     Error_Msg_SC
+                       ("the only constraint allowed here " &
+                        "is a range constraint");
+                     Discard_Junk_Node (P_Constraint_Opt);
+                     Append (Expr_Node, Choices);
+
+                  else
+                     Append (Expr_Node, Choices);
+                  end if;
+
+               --  Expression
+
+               else
+                  --  In Ada 2012 mode, the expression must be a simple
+                  --  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 disambiguate:
+
+                  --  one of the following:
+
+                  --     when (A in 1 .. 10 | 12) =>
+                  --     when (A in 1 .. 10) | 12 =>
+
+                  --  To solve this, in Ada 2012 mode, we disallow the use of
+                  --  membership operations in expressions in choices.
+
+                  --  Technically in the grammar, the expression must match the
+                  --  grammar for restricted expression.
+
+                  if Ada_Version >= Ada_2012 then
+                     Check_Restricted_Expression (Expr_Node);
+
+                  --  In Ada 83 mode, the syntax required a simple expression
+
+                  else
+                     Check_Simple_Expression_In_Ada_83 (Expr_Node);
+                  end if;
+
+                  Append (Expr_Node, Choices);
+               end if;
+
+            exception
+               when Error_Resync =>
+                  Resync_Choice;
+                  return Error_List;
+            end;
+         end if;
+
+         if Token = Tok_Comma then
+            if Nkind (Expr_Node) = N_Iterated_Component_Association then
+               return Choices;
+            end if;
+
+            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;
+
+      end loop;
+
+      return Choices;
+   end P_Discrete_Choice_List;
+
+   ----------------------------
+   -- 3.8.1  Discrete Choice --
+   ----------------------------
+
+   --  Parsed by P_Discrete_Choice_List (3.8.1)
+
+   ----------------------------------
+   -- 3.9.1  Record Extension Part --
+   ----------------------------------
+
+   --  RECORD_EXTENSION_PART ::= with RECORD_DEFINITION
+
+   --  Parsed by P_Derived_Type_Def_Or_Private_Ext_Decl (3.4)
+
+   --------------------------------------
+   -- 3.9.4  Interface Type Definition --
+   --------------------------------------
+
+   --  INTERFACE_TYPE_DEFINITION ::=
+   --    [limited | task | protected | synchronized] interface
+   --      [and INTERFACE_LIST]
+
+   --  Error recovery: cannot raise Error_Resync
+
+   function P_Interface_Type_Definition
+     (Abstract_Present : Boolean) return Node_Id
+   is
+      Typedef_Node : Node_Id;
+
+   begin
+      if Ada_Version < Ada_2005 then
+         Error_Msg_SP ("abstract interface is an Ada 2005 extension");
+         Error_Msg_SP ("\unit must be compiled with -gnat05 switch");
+      end if;
+
+      if Abstract_Present then
+         Error_Msg_SP
+           ("ABSTRACT not allowed in interface type definition " &
+            "(RM 3.9.4(2/2))");
+      end if;
+
+      Scan; -- past INTERFACE
+
+      --  Ada 2005 (AI-345): In case of interfaces with a null list of
+      --  interfaces we build a record_definition node.
+
+      if Token = Tok_Semicolon or else Aspect_Specifications_Present then
+         Typedef_Node := New_Node (N_Record_Definition, Token_Ptr);
+
+         Set_Abstract_Present  (Typedef_Node);
+         Set_Tagged_Present    (Typedef_Node);
+         Set_Null_Present      (Typedef_Node);
+         Set_Interface_Present (Typedef_Node);
+
+      --  Ada 2005 (AI-251): In case of not-synchronized interfaces that have
+      --  a list of interfaces we build a derived_type_definition node. This
+      --  simplifies the semantic analysis (and hence further maintenance)
+
+      else
+         if Token /= Tok_And then
+            Error_Msg_AP ("AND expected");
+         else
+            Scan; -- past AND
+         end if;
+
+         Typedef_Node := New_Node (N_Derived_Type_Definition, Token_Ptr);
+
+         Set_Abstract_Present   (Typedef_Node);
+         Set_Interface_Present  (Typedef_Node);
+         Set_Subtype_Indication (Typedef_Node, P_Qualified_Simple_Name);
+
+         Set_Record_Extension_Part (Typedef_Node,
+           New_Node (N_Record_Definition, Token_Ptr));
+         Set_Null_Present (Record_Extension_Part (Typedef_Node));
+
+         if Token = Tok_And then
+            Set_Interface_List (Typedef_Node, New_List);
+            Scan; -- past AND
+
+            loop
+               Append (P_Qualified_Simple_Name,
+                       Interface_List (Typedef_Node));
+               exit when Token /= Tok_And;
+               Scan; -- past AND
+            end loop;
+         end if;
+      end if;
+
+      return Typedef_Node;
+   end P_Interface_Type_Definition;
+
+   ----------------------------------
+   -- 3.10  Access Type Definition --
+   ----------------------------------
+
+   --  ACCESS_TYPE_DEFINITION ::=
+   --    ACCESS_TO_OBJECT_DEFINITION
+   --  | ACCESS_TO_SUBPROGRAM_DEFINITION
+
+   --  ACCESS_TO_OBJECT_DEFINITION ::=
+   --    [NULL_EXCLUSION] access [GENERAL_ACCESS_MODIFIER] SUBTYPE_INDICATION
+
+   --  GENERAL_ACCESS_MODIFIER ::= all | constant
+
+   --  ACCESS_TO_SUBPROGRAM_DEFINITION
+   --    [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
+
+   --  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
+     (Header_Already_Parsed : Boolean := False) return Node_Id
+   is
+      Access_Loc       : constant Source_Ptr := Token_Ptr;
+      Prot_Flag        : Boolean;
+      Not_Null_Present : Boolean := False;
+      Not_Null_Subtype : Boolean := False;
+      Type_Def_Node    : Node_Id;
+      Result_Not_Null  : Boolean;
+      Result_Node      : Node_Id;
+
+      procedure Check_Junk_Subprogram_Name;
+      --  Used in access to subprogram definition cases to check for an
+      --  identifier or operator symbol that does not belong.
+
+      --------------------------------
+      -- Check_Junk_Subprogram_Name --
+      --------------------------------
+
+      procedure Check_Junk_Subprogram_Name is
+         Saved_State : Saved_Scan_State;
+
+      begin
+         if Token = Tok_Identifier or else Token = Tok_Operator_Symbol then
+            Save_Scan_State (Saved_State);
+            Scan; -- past possible junk subprogram name
+
+            if Token = Tok_Left_Paren or else Token = Tok_Semicolon then
+               Error_Msg_SP ("unexpected subprogram name ignored");
+               return;
+
+            else
+               Restore_Scan_State (Saved_State);
+            end if;
+         end if;
+      end Check_Junk_Subprogram_Name;
+
+   --  Start of processing for P_Access_Type_Definition
+
+   begin
+      if not Header_Already_Parsed then
+
+         --  NOT NULL ACCESS .. is a common form of access definition.
+         --  ACCESS NOT NULL ..  is certainly rare, but syntactically legal.
+         --  NOT NULL ACCESS NOT NULL .. is rarer yet, and also legal.
+         --  The last two cases are only meaningful if the following subtype
+         --  indication denotes an access type (semantic check). The flag
+         --  Not_Null_Subtype indicates that this second null exclusion is
+         --  present in the access type definition.
+
+         Not_Null_Present := P_Null_Exclusion;     --  Ada 2005 (AI-231)
+         Scan; -- past ACCESS
+         Not_Null_Subtype := P_Null_Exclusion;     --  Might also appear
+      end if;
+
+      if Token_Name = Name_Protected then
+         Check_95_Keyword (Tok_Protected, Tok_Procedure);
+         Check_95_Keyword (Tok_Protected, Tok_Function);
+      end if;
+
+      Prot_Flag := (Token = Tok_Protected);
+
+      if Prot_Flag then
+         Scan; -- past PROTECTED
+
+         if Token /= Tok_Procedure and then Token /= Tok_Function then
+            Error_Msg_SC -- CODEFIX
+              ("FUNCTION or PROCEDURE expected");
+         end if;
+      end if;
+
+      if Token = Tok_Procedure then
+         if Ada_Version = Ada_83 then
+            Error_Msg_SC ("(Ada 83) access to procedure not allowed!");
+         end if;
+
+         Type_Def_Node := New_Node (N_Access_Procedure_Definition, Access_Loc);
+         Set_Null_Exclusion_Present (Type_Def_Node, Not_Null_Present);
+         Scan; -- past PROCEDURE
+         Check_Junk_Subprogram_Name;
+         Set_Parameter_Specifications (Type_Def_Node, P_Parameter_Profile);
+         Set_Protected_Present (Type_Def_Node, Prot_Flag);
+
+      elsif Token = Tok_Function then
+         if Ada_Version = Ada_83 then
+            Error_Msg_SC ("(Ada 83) access to function not allowed!");
+         end if;
+
+         Type_Def_Node := New_Node (N_Access_Function_Definition, Access_Loc);
+         Set_Null_Exclusion_Present (Type_Def_Node, Not_Null_Present);
+         Scan; -- past FUNCTION
+         Check_Junk_Subprogram_Name;
+         Set_Parameter_Specifications (Type_Def_Node, P_Parameter_Profile);
+         Set_Protected_Present (Type_Def_Node, Prot_Flag);
+         TF_Return;
+
+         Result_Not_Null := P_Null_Exclusion;     --  Ada 2005 (AI-231)
+
+         --  Ada 2005 (AI-318-02)
+
+         if Token = Tok_Access then
+            if Ada_Version < Ada_2005 then
+               Error_Msg_SC
+                 ("anonymous access result type is an Ada 2005 extension");
+               Error_Msg_SC ("\unit must be compiled with -gnat05 switch");
+            end if;
+
+            Result_Node := P_Access_Definition (Result_Not_Null);
+
+         else
+            Result_Node := P_Subtype_Mark;
+            No_Constraint;
+
+            --  A null exclusion on the result type must be recorded in a flag
+            --  distinct from the one used for the access-to-subprogram type's
+            --  null exclusion.
+
+            Set_Null_Exclusion_In_Return_Present
+              (Type_Def_Node, Result_Not_Null);
+         end if;
+
+         Set_Result_Definition (Type_Def_Node, Result_Node);
+
+      else
+         Type_Def_Node :=
+           New_Node (N_Access_To_Object_Definition, Access_Loc);
+         Set_Null_Exclusion_Present (Type_Def_Node, Not_Null_Present);
+         Set_Null_Excluding_Subtype (Type_Def_Node, Not_Null_Subtype);
+
+         if Token = Tok_All or else Token = Tok_Constant then
+            if Ada_Version = Ada_83 then
+               Error_Msg_SC ("(Ada 83) access modifier not allowed!");
+            end if;
+
+            if Token = Tok_All then
+               Set_All_Present (Type_Def_Node, True);
+
+            else
+               Set_Constant_Present (Type_Def_Node, True);
+            end if;
+
+            Scan; -- past ALL or CONSTANT
+         end if;
+
+         Set_Subtype_Indication (Type_Def_Node,
+            P_Subtype_Indication (Not_Null_Present));
+      end if;
+
+      return Type_Def_Node;
+   end P_Access_Type_Definition;
+
+   ---------------------------------------
+   -- 3.10  Access To Object Definition --
+   ---------------------------------------
+
+   --  Parsed by P_Access_Type_Definition (3.10)
+
+   -----------------------------------
+   -- 3.10  General Access Modifier --
+   -----------------------------------
+
+   --  Parsed by P_Access_Type_Definition (3.10)
+
+   -------------------------------------------
+   -- 3.10  Access To Subprogram Definition --
+   -------------------------------------------
+
+   --  Parsed by P_Access_Type_Definition (3.10)
+
+   -----------------------------
+   -- 3.10  Access Definition --
+   -----------------------------
+
+   --  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 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
+     (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 2005 (AI-254): Access_To_Subprogram_Definition
+
+      if Token = Tok_Protected
+        or else Token = Tok_Procedure
+        or else Token = Tok_Function
+      then
+         if Ada_Version < Ada_2005 then
+            Error_Msg_SP ("access-to-subprogram is an Ada 2005 extension");
+            Error_Msg_SP ("\unit should be compiled with -gnat05 switch");
+         end if;
+
+         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
+            if Ada_Version < Ada_2005 then
+               Error_Msg_SP
+                 ("ALL is not permitted for anonymous access types");
+            end if;
+
+            Scan; -- past ALL
+            Set_All_Present (Def_Node);
+
+         elsif Token = Tok_Constant then
+            if Ada_Version < Ada_2005 then
+               Error_Msg_SP ("access-to-constant is an Ada 2005 extension");
+               Error_Msg_SP ("\unit should be compiled with -gnat05 switch");
+            end if;
+
+            Scan; -- past CONSTANT
+            Set_Constant_Present (Def_Node);
+         end if;
+
+         Set_Subtype_Mark (Def_Node, P_Subtype_Mark);
+         No_Constraint;
+      end if;
+
+      return Def_Node;
+   end P_Access_Definition;
+
+   -----------------------------------------
+   -- 3.10.1  Incomplete Type Declaration --
+   -----------------------------------------
+
+   --  Parsed by P_Type_Declaration (3.2.1)
+
+   ----------------------------
+   -- 3.11  Declarative Part --
+   ----------------------------
+
+   --  DECLARATIVE_PART ::= {DECLARATIVE_ITEM}
+
+   --  Error recovery: cannot raise Error_Resync (because P_Declarative_Items
+   --  handles errors, and returns cleanly after an error has occurred)
+
+   function P_Declarative_Part return List_Id is
+      Decls : List_Id;
+      Done  : Boolean;
+
+   begin
+      --  Indicate no bad declarations detected yet. This will be reset by
+      --  P_Declarative_Items if a bad declaration is discovered.
+
+      Missing_Begin_Msg := No_Error_Msg;
+
+      --  Get rid of active SIS entry from outer scope. This means we will
+      --  miss some nested cases, but it doesn't seem worth the effort. See
+      --  discussion in Par for further details
+
+      SIS_Entry_Active := False;
+      Decls := New_List;
+
+      --  Loop to scan out the declarations
+
+      loop
+         P_Declarative_Items (Decls, Done, In_Spec => False);
+         exit when Done;
+      end loop;
+
+      --  Get rid of active SIS entry which is left set only if we scanned a
+      --  procedure declaration and have not found the body. We could give
+      --  an error message, but that really would be usurping the role of
+      --  semantic analysis (this really is a missing body case).
+
+      SIS_Entry_Active := False;
+      return Decls;
+   end P_Declarative_Part;
+
+   ----------------------------
+   -- 3.11  Declarative Item --
+   ----------------------------
+
+   --  DECLARATIVE_ITEM ::= BASIC_DECLARATIVE_ITEM | BODY
+
+   --  Can return Error if a junk declaration is found, or Empty if no
+   --  declaration is found (i.e. a token ending declarations, such as
+   --  BEGIN or END is encountered).
+
+   --  Error recovery: cannot raise Error_Resync. If an error resync occurs,
+   --  then the scan is set past the next semicolon and Error is returned.
+
+   procedure P_Declarative_Items
+     (Decls   : List_Id;
+      Done    : out Boolean;
+      In_Spec : Boolean)
+   is
+      Scan_State : Saved_Scan_State;
+
+   begin
+      if Style_Check then
+         Style.Check_Indentation;
+      end if;
+
+      case Token is
+         when Tok_Function
+            | Tok_Not
+            | Tok_Overriding
+            | Tok_Procedure
+         =>
+            Check_Bad_Layout;
+            Append (P_Subprogram (Pf_Decl_Gins_Pbod_Rnam_Stub_Pexp), Decls);
+            Done := False;
+
+         when Tok_For =>
+            Check_Bad_Layout;
+
+            --  Check for loop (premature statement)
+
+            Save_Scan_State (Scan_State);
+            Scan; -- past FOR
+
+            if Token = Tok_Identifier then
+               Scan; -- past identifier
+
+               if Token = Tok_In then
+                  Restore_Scan_State (Scan_State);
+                  Statement_When_Declaration_Expected (Decls, Done, In_Spec);
+                  return;
+               end if;
+            end if;
+
+            --  Not a loop, so must be rep clause
+
+            Restore_Scan_State (Scan_State);
+            Append (P_Representation_Clause, Decls);
+            Done := False;
+
+         when Tok_Generic =>
+            Check_Bad_Layout;
+            Append (P_Generic, Decls);
+            Done := False;
+
+         when Tok_Identifier =>
+            Check_Bad_Layout;
+
+            --  Special check for misuse of overriding not in Ada 2005 mode
+
+            if Token_Name = Name_Overriding
+              and then not Next_Token_Is (Tok_Colon)
+            then
+               Error_Msg_SC ("overriding indicator is an Ada 2005 extension");
+               Error_Msg_SC ("\unit must be compiled with -gnat05 switch");
+
+               Token := Tok_Overriding;
+               Append (P_Subprogram (Pf_Decl_Gins_Pbod_Rnam_Stub_Pexp), Decls);
+               Done := False;
+
+            --  Normal case, no overriding, or overriding followed by colon
+
+            else
+               P_Identifier_Declarations (Decls, Done, In_Spec);
+            end if;
+
+         when Tok_Package =>
+            Check_Bad_Layout;
+            Append (P_Package (Pf_Decl_Gins_Pbod_Rnam_Stub_Pexp), Decls);
+            Done := False;
+
+         when Tok_Pragma =>
+            Append (P_Pragma, Decls);
+            Done := False;
+
+         when Tok_Protected =>
+            Check_Bad_Layout;
+            Scan; -- past PROTECTED
+            Append (P_Protected, Decls);
+            Done := False;
+
+         when Tok_Subtype =>
+            Check_Bad_Layout;
+            Append (P_Subtype_Declaration, Decls);
+            Done := False;
+
+         when Tok_Task =>
+            Check_Bad_Layout;
+            Scan; -- past TASK
+            Append (P_Task, Decls);
+            Done := False;
+
+         when Tok_Type =>
+            Check_Bad_Layout;
+            Append (P_Type_Declaration, Decls);
+            Done := False;
+
+         when Tok_Use =>
+            Check_Bad_Layout;
+            P_Use_Clause (Decls);
+            Done := False;
+
+         when Tok_With =>
+            Check_Bad_Layout;
+
+            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;
+
+               --  Assume that this is a misplaced aspect specification within
+               --  a declarative list. After discarding the misplaced aspects
+               --  we can continue the scan.
+
+               Done := False;
+
+               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
+         --  semicolon in place of IS. We only treat the begin as satisfying
+         --  the subprogram declaration if it falls in the expected column
+         --  or to its right.
+
+         when Tok_Begin =>
+            if SIS_Entry_Active and then Start_Column >= SIS_Ecol then
+
+               --  Here we have the case where a BEGIN is encountered during
+               --  declarations in a declarative part, or at the outer level,
+               --  and there is a subprogram declaration outstanding for which
+               --  no body has been supplied. This is the case where we assume
+               --  that the semicolon in the subprogram declaration should
+               --  really have been is. The active SIS entry describes the
+               --  subprogram declaration. On return the declaration has been
+               --  modified to become a body.
+
+               declare
+                  Specification_Node : Node_Id;
+                  Decl_Node          : Node_Id;
+                  Body_Node          : Node_Id;
+
+               begin
+                  --  First issue the error message. If we had a missing
+                  --  semicolon in the declaration, then change the message
+                  --  to <missing "is">
+
+                  if SIS_Missing_Semicolon_Message /= No_Error_Msg then
+                     Change_Error_Text     -- Replace: "missing "";"" "
+                       (SIS_Missing_Semicolon_Message, "missing ""is""");
+
+                  --  Otherwise we saved the semicolon position, so complain
+
+                  else
+                     Error_Msg -- CODEFIX
+                       ("|"";"" should be IS", SIS_Semicolon_Sloc);
+                  end if;
+
+                  --  The next job is to fix up any declarations that occurred
+                  --  between the procedure header and the BEGIN. These got
+                  --  chained to the outer declarative region (immediately
+                  --  after the procedure declaration) and they should be
+                  --  chained to the subprogram itself, which is a body
+                  --  rather than a spec.
+
+                  Specification_Node := Specification (SIS_Declaration_Node);
+                  Change_Node (SIS_Declaration_Node, N_Subprogram_Body);
+                  Body_Node := SIS_Declaration_Node;
+                  Set_Specification (Body_Node, Specification_Node);
+                  Set_Declarations (Body_Node, New_List);
+
+                  loop
+                     Decl_Node := Remove_Next (Body_Node);
+                     exit when Decl_Node = Empty;
+                     Append (Decl_Node, Declarations (Body_Node));
+                  end loop;
+
+                  --  Now make the scope table entry for the Begin-End and
+                  --  scan it out
+
+                  Push_Scope_Stack;
+                  Scope.Table (Scope.Last).Sloc := SIS_Sloc;
+                  Scope.Table (Scope.Last).Etyp := E_Name;
+                  Scope.Table (Scope.Last).Ecol := SIS_Ecol;
+                  Scope.Table (Scope.Last).Labl := SIS_Labl;
+                  Scope.Table (Scope.Last).Lreq := False;
+                  SIS_Entry_Active := False;
+                  Scan; -- past BEGIN
+                  Set_Handled_Statement_Sequence (Body_Node,
+                    P_Handled_Sequence_Of_Statements);
+                  End_Statements (Handled_Statement_Sequence (Body_Node));
+               end;
+
+               Done := False;
+
+            else
+               Done := True;
+            end if;
+
+         --  Normally an END terminates the scan for basic declarative items.
+         --  The one exception is END RECORD, which is probably left over from
+         --  some other junk.
+
+         when Tok_End =>
+            Save_Scan_State (Scan_State); -- at END
+            Scan; -- past END
+
+            if Token = Tok_Record then
+               Error_Msg_SP ("no RECORD for this `end record`!");
+               Scan; -- past RECORD
+               TF_Semicolon;
+
+               --  This might happen because of misplaced aspect specification.
+               --  After discarding the misplaced aspects we can continue the
+               --  scan.
+
+               Done := False;
+            else
+               Restore_Scan_State (Scan_State); -- to END
+               Done := True;
+            end if;
+
+         --  The following tokens which can only be the start of a statement
+         --  are considered to end a declarative part (i.e. we have a missing
+         --  BEGIN situation). We are fairly conservative in making this
+         --  judgment, because it is a real mess to go into statement mode
+         --  prematurely in response to a junk declaration.
+
+         when Tok_Abort
+            | Tok_Accept
+            | Tok_Declare
+            | Tok_Delay
+            | Tok_Exit
+            | Tok_Goto
+            | Tok_If
+            | Tok_Loop
+            | Tok_Null
+            | Tok_Requeue
+            | Tok_Select
+            | Tok_While
+         =>
+            --  But before we decide that it's a statement, let's check for
+            --  a reserved word misused as an identifier.
+
+            if Is_Reserved_Identifier then
+               Save_Scan_State (Scan_State);
+               Scan; -- past the token
+
+               --  If reserved identifier not followed by colon or comma, then
+               --  this is most likely an assignment statement to the bad id.
+
+               if Token /= Tok_Colon and then Token /= Tok_Comma then
+                  Restore_Scan_State (Scan_State);
+                  Statement_When_Declaration_Expected (Decls, Done, In_Spec);
+                  return;
+
+               --  Otherwise we have a declaration of the bad id
+
+               else
+                  Restore_Scan_State (Scan_State);
+                  Scan_Reserved_Identifier (Force_Msg => True);
+                  P_Identifier_Declarations (Decls, Done, In_Spec);
+               end if;
+
+            --  If not reserved identifier, then it's definitely a statement
+
+            else
+               Statement_When_Declaration_Expected (Decls, Done, In_Spec);
+               return;
+            end if;
+
+         --  The token RETURN may well also signal a missing BEGIN situation,
+         --  however, we never let it end the declarative part, because it may
+         --  also be part of a half-baked function declaration.
+
+         when Tok_Return =>
+            Error_Msg_SC ("misplaced RETURN statement");
+            raise Error_Resync;
+
+         --  PRIVATE definitely terminates the declarations in a spec,
+         --  and is an error in a body.
+
+         when Tok_Private =>
+            if In_Spec then
+               Done := True;
+            else
+               Error_Msg_SC ("PRIVATE not allowed in body");
+               Scan; -- past PRIVATE
+            end if;
+
+         --  An end of file definitely terminates the declarations
+
+         when Tok_EOF =>
+            Done := True;
+
+         --  The remaining tokens do not end the scan, but cannot start a
+         --  valid declaration, so we signal an error and resynchronize.
+         --  But first check for misuse of a reserved identifier.
+
+         when others =>
+
+            --  Here we check for a reserved identifier
+
+            if Is_Reserved_Identifier then
+               Save_Scan_State (Scan_State);
+               Scan; -- past the token
+
+               if Token /= Tok_Colon and then Token /= Tok_Comma then
+                  Restore_Scan_State (Scan_State);
+                  Set_Declaration_Expected;
+                  raise Error_Resync;
+               else
+                  Restore_Scan_State (Scan_State);
+                  Scan_Reserved_Identifier (Force_Msg => True);
+                  Check_Bad_Layout;
+                  P_Identifier_Declarations (Decls, Done, In_Spec);
+               end if;
+
+            else
+               Set_Declaration_Expected;
+               raise Error_Resync;
+            end if;
+      end case;
+
+   --  To resynchronize after an error, we scan to the next semicolon and
+   --  return with Done = False, indicating that there may still be more
+   --  valid declarations to come.
+
+   exception
+      when Error_Resync =>
+         Resync_Past_Semicolon;
+         Done := False;
+   end P_Declarative_Items;
+
+   ----------------------------------
+   -- 3.11  Basic Declarative Item --
+   ----------------------------------
+
+   --  BASIC_DECLARATIVE_ITEM ::=
+   --    BASIC_DECLARATION | REPRESENTATION_CLAUSE | USE_CLAUSE
+
+   --  Scan zero or more basic declarative items
+
+   --  Error recovery: cannot raise Error_Resync. If an error is detected, then
+   --  the scan pointer is repositioned past the next semicolon, and the scan
+   --  for declarative items continues.
+
+   function P_Basic_Declarative_Items return List_Id is
+      Decl  : Node_Id;
+      Decls : List_Id;
+      Kind  : Node_Kind;
+      Done  : Boolean;
+
+   begin
+      --  Indicate no bad declarations detected yet in the current context:
+      --  visible or private declarations of a package spec.
+
+      Missing_Begin_Msg := No_Error_Msg;
+
+      --  Get rid of active SIS entry from outer scope. This means we will
+      --  miss some nested cases, but it doesn't seem worth the effort. See
+      --  discussion in Par for further details
+
+      SIS_Entry_Active := False;
+
+      --  Loop to scan out declarations
+
+      Decls := New_List;
+
+      loop
+         P_Declarative_Items (Decls, Done, In_Spec => True);
+         exit when Done;
+      end loop;
+
+      --  Get rid of active SIS entry. This is set only if we have scanned a
+      --  procedure declaration and have not found the body. We could give
+      --  an error message, but that really would be usurping the role of
+      --  semantic analysis (this really is a case of a missing body).
+
+      SIS_Entry_Active := False;
+
+      --  Test for assorted illegal declarations not diagnosed elsewhere
+
+      Decl := First (Decls);
+
+      while Present (Decl) loop
+         Kind := Nkind (Decl);
+
+         --  Test for body scanned, not acceptable as basic decl item
+
+         if Kind = N_Subprogram_Body or else
+            Kind = N_Package_Body    or else
+            Kind = N_Task_Body       or else
+            Kind = N_Protected_Body
+         then
+            Error_Msg ("proper body not allowed in package spec", Sloc (Decl));
+
+            --  Complete declaration of mangled subprogram body, for better
+            --  recovery if analysis is attempted.
+
+            if Nkind_In (Decl, N_Subprogram_Body, N_Package_Body, N_Task_Body)
+              and then No (Handled_Statement_Sequence (Decl))
+            then
+               Set_Handled_Statement_Sequence (Decl,
+                 Make_Handled_Sequence_Of_Statements (Sloc (Decl),
+                   Statements => New_List));
+            end if;
+
+         --  Test for body stub scanned, not acceptable as basic decl item
+
+         elsif Kind in N_Body_Stub then
+            Error_Msg ("body stub not allowed in package spec", Sloc (Decl));
+
+         elsif Kind = N_Assignment_Statement then
+            Error_Msg
+              ("assignment statement not allowed in package spec",
+                 Sloc (Decl));
+         end if;
+
+         Next (Decl);
+      end loop;
+
+      return Decls;
+   end P_Basic_Declarative_Items;
+
+   ----------------
+   -- 3.11  Body --
+   ----------------
+
+   --  For proper body, see below
+   --  For body stub, see 10.1.3
+
+   -----------------------
+   -- 3.11  Proper Body --
+   -----------------------
+
+   --  Subprogram body is parsed by P_Subprogram (6.1)
+   --  Package body is parsed by P_Package (7.1)
+   --  Task body is parsed by P_Task (9.1)
+   --  Protected body is parsed by P_Protected (9.4)
+
+   ------------------------------
+   -- Set_Declaration_Expected --
+   ------------------------------
+
+   procedure Set_Declaration_Expected is
+   begin
+      Error_Msg_SC ("declaration expected");
+
+      if Missing_Begin_Msg = No_Error_Msg then
+         Missing_Begin_Msg := Get_Msg_Id;
+      end if;
+   end Set_Declaration_Expected;
+
+   ----------------------
+   -- Skip_Declaration --
+   ----------------------
+
+   procedure Skip_Declaration (S : List_Id) is
+      Dummy_Done : Boolean;
+      pragma Warnings (Off, Dummy_Done);
+   begin
+      P_Declarative_Items (S, Dummy_Done, False);
+   end Skip_Declaration;
+
+   -----------------------------------------
+   -- Statement_When_Declaration_Expected --
+   -----------------------------------------
+
+   procedure Statement_When_Declaration_Expected
+     (Decls   : List_Id;
+      Done    : out Boolean;
+      In_Spec : Boolean)
+   is
+   begin
+      --  Case of second occurrence of statement in one declaration sequence
+
+      if Missing_Begin_Msg /= No_Error_Msg then
+
+         --  In the procedure spec case, just ignore it, we only give one
+         --  message for the first occurrence, since otherwise we may get
+         --  horrible cascading if BODY was missing in the header line.
+
+         if In_Spec then
+            null;
+
+         --  Just ignore it if we are in -gnatd.2 (allow statements to appear
+         --  in declaration sequences) mode.
+
+         elsif Debug_Flag_Dot_2 then
+            null;
+
+         --  In the declarative part case, take a second statement as a sure
+         --  sign that we really have a missing BEGIN, and end the declarative
+         --  part now. Note that the caller will fix up the first message to
+         --  say "missing BEGIN" so that's how the error will be signalled.
+
+         else
+            Done := True;
+            return;
+         end if;
+
+      --  Case of first occurrence of unexpected statement
+
+      else
+         --  Do not give error message if we are operating in -gnatd.2 mode
+         --  (alllow statements to appear in declarative parts).
+
+         if not Debug_Flag_Dot_2 then
+
+            --  If we are in a package spec, then give message of statement
+            --  not allowed in package spec. This message never gets changed.
+
+            if In_Spec then
+               Error_Msg_SC ("statement not allowed in package spec");
+
+            --  If in declarative part, then we give the message complaining
+            --  about finding a statement when a declaration is expected. This
+            --  gets changed to a complaint about a missing BEGIN if we later
+            --  find that no BEGIN is present.
+
+            else
+               Error_Msg_SC ("statement not allowed in declarative part");
+            end if;
+
+            --  Capture message Id. This is used for two purposes, first to
+            --  stop multiple messages, see test above, and second, to allow
+            --  the replacement of the message in the declarative part case.
+
+            Missing_Begin_Msg := Get_Msg_Id;
+         end if;
+      end if;
+
+      --  In all cases except the case in which we decided to terminate the
+      --  declaration sequence on a second error, we scan out the statement
+      --  and append it to the list of declarations (note that the semantics
+      --  can handle statements in a declaration list so if we proceed to
+      --  call the semantic phase, all will be (reasonably) well.
+
+      Append_List_To (Decls, P_Sequence_Of_Statements (SS_Unco));
+
+      --  Done is set to False, since we want to continue the scan of
+      --  declarations, hoping that this statement was a temporary glitch.
+      --  If we indeed are now in the statement part (i.e. this was a missing
+      --  BEGIN, then it's not terrible, we will simply keep calling this
+      --  procedure to process the statements one by one, and then finally
+      --  hit the missing BEGIN, which will clean up the error message.
+
+      Done := False;
+   end Statement_When_Declaration_Expected;
+
+end Ch3;