Patchwork [Ada] Complete implementation of AI05-0183-1 (aspect specifications)

login
register
mail settings
Submitter Arnaud Charlet
Date Oct. 12, 2010, 9:38 a.m.
Message ID <20101012093803.GA6590@adacore.com>
Download mbox | patch
Permalink /patch/67514/
State New
Headers show

Comments

Arnaud Charlet - Oct. 12, 2010, 9:38 a.m.
This AI is now fully implemented, the final stage in this patch is to
recognize the aspect syntax in all declarations where it is allowed.
The following test compiles silently with -gnat12:

procedure AllAspects is
   type R is new Integer
     with Warnings => Off;

   function "+" (A, B : R) return R is abstract
     with Warnings => Off;

   type R55 is record
      I : Integer
        with Warnings => Off;
   end record;

   task type Rtt is
      entry Q
        with Warnings => Off;
   end Rtt
     with Warnings => Off;

   task body Rtt is begin accept Q; end;

   X : exception
     with Warnings => Off;

   package Rpkg is end
     with Warnings => Off;

   I : Integer
     with Warnings => Off;

   type Jtag is tagged null record;

   package P3 is
      type R is private
        with Warnings => Off;
      type J is null record;
      type JJ is new Jtag with private
        with Warnings => Off;
   private
      type R is new Integer;
      type JJ is new Jtag with record
         X : Integer;
      end record;
   end P3;

   task XXX is end
     with Warnings => Off;

   task body XXX is begin null; end;

   subtype Q is Integer range 1 .. 2
     with Warnings => Off;

   procedure ppp
     with Warnings => Off;

   procedure ppp is begin null; end;

   generic package GP is end
     with Warnings => Off;

   package GGPP is new GP
     with Warnings => Off;

   generic procedure PG
     with Warnings => Off;

   procedure PG is begin null; end;

   procedure NPG is new PG
     with Warnings => Off;

   generic function FG return Integer
     with Warnings => Off;

   function FG return Integer is
   begin
      return 1;
   end;

   function FGG is new FG
     with Warnings => Off;

   generic
      A : Integer
        with Warnings => Off;
      type R is private
        with Warnings => Off;
      with package PPP is new GP
        with Warnings => Off;
      with procedure XXX (A : Jtag) is abstract
        with Warnings => Off;
      with procedure YYY
        with Warnings => Off;
   package PPPPP is end;

   protected type P is end
     with Warnings => Off;

   protected body P is end;

   protected PSINGLE is end
     with Warnings => Off;

   protected body PSINGLE is end;

begin
   null;
end;

Tested on x86_64-pc-linux-gnu, committed on trunk

2010-10-12  Robert Dewar  <dewar@adacore.com>

	* aspects.ads, aspects.adb (Move_Aspects): New procedure.
	* atree.ads, atree.adb: (New_Copy): Does not copy aspect specifications
	* sinfo.ads, par-ch3.adb, par-ch6.adb, par-ch7.adb, par-ch9.adb,
	par-endh.adb, par-ch13.adb, par-ch12.adb: Modify grammar to include
	aspect specifications.
	Recognize aspect specifications for all cases
	* par.adb: Recognize aspect specifications for all cases
	* sem_ch12.ads, sem_ch12.adb (Copy_Generic_Node): Copies aspect
	specifications.
	* sem_ch3.adb (Analyze_Subtype_Declaration): Improve patch to freeze
	generic actual types (was missing some guards before).
	* sem_ch9.adb (Analyze_Single_Protected_Declaration): Copy aspects to
	generated object
	(Analyze_Single_Task_Declaration): Copy aspects to generated object

Patch

Index: par-ch9.adb
===================================================================
--- par-ch9.adb	(revision 165316)
+++ par-ch9.adb	(working copy)
@@ -40,23 +40,33 @@  package body Ch9 is
    function P_Entry_Body_Formal_Part               return Node_Id;
    function P_Entry_Declaration                    return Node_Id;
    function P_Entry_Index_Specification            return Node_Id;
-   function P_Protected_Definition                 return Node_Id;
    function P_Protected_Operation_Declaration_Opt  return Node_Id;
    function P_Protected_Operation_Items            return List_Id;
-   function P_Task_Definition                      return Node_Id;
    function P_Task_Items                           return List_Id;
 
+   function P_Protected_Definition (Decl : Node_Id) return Node_Id;
+   --  Parses protected definition and following aspect specifications if
+   --  present. The argument is the declaration node to which the aspect
+   --  specifications are to be attached.
+
+   function P_Task_Definition (Decl : Node_Id) return Node_Id;
+   --  Parses task definition and following aspect specifications if present.
+   --  The argument is the declaration node to which the aspect specifications
+   --  are to be attached.
+
    -----------------------------
    -- 9.1  Task (also 10.1.3) --
    -----------------------------
 
    --  TASK_TYPE_DECLARATION ::=
    --    task type DEFINING_IDENTIFIER [KNOWN_DISCRIMINANT_PART]
-   --      [is [new INTERFACE_LIST with] TASK_DEFINITION];
+   --      [is [new INTERFACE_LIST with] TASK_DEFINITION]
+   --        [ASPECT_SPECIFICATIONS];
 
    --  SINGLE_TASK_DECLARATION ::=
    --    task DEFINING_IDENTIFIER
-   --      [is [new INTERFACE_LIST with] TASK_DEFINITION];
+   --      [is [new INTERFACE_LIST with] TASK_DEFINITION]
+   --        [ASPECT_SPECIFICATIONS];
 
    --  TASK_BODY ::=
    --    task body DEFINING_IDENTIFIER is
@@ -143,10 +153,17 @@  package body Ch9 is
             end if;
          end if;
 
+         --  If we have aspect definitions present here, then we do not have
+         --  a task definition present.
+
+         if Aspect_Specifications_Present then
+            P_Aspect_Specifications (Task_Node);
+
          --  Parse optional task definition. Note that P_Task_Definition scans
-         --  out the semicolon as well as the task definition itself.
+         --  out the semicolon and possible aspect specifications as well as
+         --  the task definition itself.
 
-         if Token = Tok_Semicolon then
+         elsif Token = Tok_Semicolon then
 
             --  A little check, if the next token after semicolon is
             --  Entry, then surely the semicolon should really be IS
@@ -156,10 +173,13 @@  package body Ch9 is
             if Token = Tok_Entry then
                Error_Msg_SP -- CODEFIX
                  ("|"";"" should be IS");
-               Set_Task_Definition (Task_Node, P_Task_Definition);
+               Set_Task_Definition (Task_Node, P_Task_Definition (Task_Node));
             else
                Pop_Scope_Stack; -- Remove unused entry
             end if;
+
+         --  Here we have a task definition
+
          else
             TF_Is; -- must have IS if no semicolon
 
@@ -194,7 +214,7 @@  package body Ch9 is
                end if;
             end if;
 
-            Set_Task_Definition (Task_Node, P_Task_Definition);
+            Set_Task_Definition (Task_Node, P_Task_Definition (Task_Node));
          end if;
 
          return Task_Node;
@@ -233,7 +253,7 @@  package body Ch9 is
 
    --  Error recovery:  cannot raise Error_Resync
 
-   function P_Task_Definition return Node_Id is
+   function P_Task_Definition (Decl : Node_Id) return Node_Id is
       Def_Node  : Node_Id;
 
    begin
@@ -253,7 +273,7 @@  package body Ch9 is
          end loop;
       end if;
 
-      End_Statements (Def_Node);
+      End_Statements (Def_Node, Decl);
       return Def_Node;
    end P_Task_Definition;
 
@@ -347,11 +367,13 @@  package body Ch9 is
 
    --  PROTECTED_TYPE_DECLARATION ::=
    --    protected type DEFINING_IDENTIFIER [KNOWN_DISCRIMINANT_PART]
-   --      is [new INTERFACE_LIST with] PROTECTED_DEFINITION;
+   --      is [new INTERFACE_LIST with] PROTECTED_DEFINITION
+   --        [ASPECT_SPECIFICATIONS];
 
    --  SINGLE_PROTECTED_DECLARATION ::=
    --    protected DEFINING_IDENTIFIER
    --    is [new INTERFACE_LIST with] PROTECTED_DEFINITION;
+   --      [ASPECT_SPECIFICATIONS];
 
    --  PROTECTED_BODY ::=
    --    protected body DEFINING_IDENTIFIER is
@@ -464,8 +486,8 @@  package body Ch9 is
                    End_Label           => Empty));
 
                SIS_Entry_Active := False;
-               End_Statements (Protected_Definition (Protected_Node));
-               Scan; -- past semicolon
+               End_Statements
+                 (Protected_Definition (Protected_Node), Protected_Node);
                return Protected_Node;
             end if;
 
@@ -503,7 +525,8 @@  package body Ch9 is
             Scan; -- past WITH
          end if;
 
-         Set_Protected_Definition (Protected_Node, P_Protected_Definition);
+         Set_Protected_Definition
+           (Protected_Node, P_Protected_Definition (Protected_Node));
          return Protected_Node;
       end if;
    end P_Protected;
@@ -538,7 +561,7 @@  package body Ch9 is
 
    --  Error recovery: cannot raise Error_Resync
 
-   function P_Protected_Definition return Node_Id is
+   function P_Protected_Definition (Decl : Node_Id) return Node_Id is
       Def_Node  : Node_Id;
       Item_Node : Node_Id;
 
@@ -584,7 +607,7 @@  package body Ch9 is
          end loop Declaration_Loop;
       end loop Private_Loop;
 
-      End_Statements (Def_Node);
+      End_Statements (Def_Node, Decl);
       return Def_Node;
    end P_Protected_Definition;
 
Index: sem_ch3.adb
===================================================================
--- sem_ch3.adb	(revision 165316)
+++ sem_ch3.adb	(working copy)
@@ -4150,10 +4150,16 @@  package body Sem_Ch3 is
          end if;
       end if;
 
-      --  Make sure that generic actual types are properly frozen
+      --  Make sure that generic actual types are properly frozen The subtype
+      --  is marked as a generic actual type when the enclosing instance is
+      --  analyzed, so here we identify the subtype from the tree structure.
 
       if Expander_Active
         and then Is_Generic_Actual_Type (Id)
+        and then In_Instance
+        and then not Comes_From_Source (N)
+        and then Nkind (Subtype_Indication (N)) /= N_Subtype_Indication
+        and then Is_Frozen (T)
       then
          Insert_Actions (N, Freeze_Entity (Id, N));
       end if;
Index: sinfo.ads
===================================================================
--- sinfo.ads	(revision 165316)
+++ sinfo.ads	(working copy)
@@ -2120,7 +2120,9 @@  package Sinfo is
 
       --  FULL_TYPE_DECLARATION ::=
       --    type DEFINING_IDENTIFIER [KNOWN_DISCRIMINANT_PART]
-      --      is TYPE_DEFINITION;
+      --      is TYPE_DEFINITION
+      --        [ASPECT_SPECIFICATIONS];
+
       --  | TASK_TYPE_DECLARATION
       --  | PROTECTED_TYPE_DECLARATION
 
@@ -2227,11 +2229,14 @@  package Sinfo is
 
       --  OBJECT_DECLARATION ::=
       --    DEFINING_IDENTIFIER_LIST : [aliased] [constant]
-      --      [NULL_EXCLUSION] SUBTYPE_INDICATION [:= EXPRESSION];
+      --      [NULL_EXCLUSION] SUBTYPE_INDICATION [:= EXPRESSION]
+      --        [ASPECT_SPECIFICATIONS];
       --  | DEFINING_IDENTIFIER_LIST : [aliased] [constant]
-      --      ACCESS_DEFINITION [:= EXPRESSION];
+      --      ACCESS_DEFINITION [:= EXPRESSION]
+      --        [ASPECT_SPECIFICATIONS];
       --  | DEFINING_IDENTIFIER_LIST : [aliased] [constant]
-      --      ARRAY_TYPE_DEFINITION [:= EXPRESSION];
+      --      ARRAY_TYPE_DEFINITION [:= EXPRESSION]
+      --        [ASPECT_SPECIFICATIONS];
       --  | SINGLE_TASK_DECLARATION
       --  | SINGLE_PROTECTED_DECLARATION
 
@@ -2841,7 +2846,8 @@  package Sinfo is
 
       --  COMPONENT_DECLARATION ::=
       --    DEFINING_IDENTIFIER_LIST : COMPONENT_DEFINITION
-      --      [:= DEFAULT_EXPRESSION];
+      --      [:= DEFAULT_EXPRESSION]
+      --        [ASPECT_SPECIFICATIONS];
 
       --  Note: although the syntax does not permit a component definition to
       --  be an anonymous array (and the parser will diagnose such an attempt
@@ -4209,7 +4215,9 @@  package Sinfo is
       -- 6.1  Subprogram Declaration --
       ---------------------------------
 
-      --  SUBPROGRAM_DECLARATION ::= SUBPROGRAM_SPECIFICATION;
+      --  SUBPROGRAM_DECLARATION ::=
+      --    SUBPROGRAM_SPECIFICATION
+      --      [ASPECT_SPECIFICATIONS];
 
       --  N_Subprogram_Declaration
       --  Sloc points to FUNCTION or PROCEDURE
@@ -4223,7 +4231,8 @@  package Sinfo is
       ------------------------------------------
 
       --  ABSTRACT_SUBPROGRAM_DECLARATION ::=
-      --    SUBPROGRAM_SPECIFICATION is abstract;
+      --    SUBPROGRAM_SPECIFICATION is abstract
+      --      [ASPECT_SPECIFICATIONS];
 
       --  N_Abstract_Subprogram_Declaration
       --  Sloc points to ABSTRACT
@@ -4640,7 +4649,9 @@  package Sinfo is
       -- 7.1  Package Declaration --
       ------------------------------
 
-      --  PACKAGE_DECLARATION ::= PACKAGE_SPECIFICATION;
+      --  PACKAGE_DECLARATION ::=
+      --    PACKAGE_SPECIFICATION
+      --      [ASPECT_SPECIFICATIONS];
 
       --  Note: the activation chain entity for a package spec is used for
       --  all tasks declared in the package spec, or in the package body.
@@ -4889,7 +4900,8 @@  package Sinfo is
 
       --  TASK_TYPE_DECLARATION ::=
       --    task type DEFINING_IDENTIFIER [KNOWN_DISCRIMINANT_PART]
-      --      [is [new INTERFACE_LIST with] TASK_DEFINITION];
+      --      [is [new INTERFACE_LIST with] TASK_DEFINITION]
+      --        [ASPECT_SPECIFICATIONS];
 
       --  N_Task_Type_Declaration
       --  Sloc points to TASK
@@ -4906,7 +4918,8 @@  package Sinfo is
 
       --  SINGLE_TASK_DECLARATION ::=
       --    task DEFINING_IDENTIFIER
-      --      [is [new INTERFACE_LIST with] TASK_DEFINITION];
+      --      [is [new INTERFACE_LIST with] TASK_DEFINITION]
+      --        [ASPECT_SPECIFICATIONS];
 
       --  N_Single_Task_Declaration
       --  Sloc points to TASK
@@ -4973,7 +4986,8 @@  package Sinfo is
 
       --  PROTECTED_TYPE_DECLARATION ::=
       --    protected type DEFINING_IDENTIFIER [KNOWN_DISCRIMINANT_PART]
-      --      is [new INTERFACE_LIST with] PROTECTED_DEFINITION;
+      --      is [new INTERFACE_LIST with] PROTECTED_DEFINITION
+      --        {ASPECT_SPECIFICATIONS];
 
       --  Note: protected type declarations are not permitted in Ada 83 mode
 
@@ -4992,7 +5006,8 @@  package Sinfo is
 
       --  SINGLE_PROTECTED_DECLARATION ::=
       --    protected DEFINING_IDENTIFIER
-      --      is [new INTERFACE_LIST with] PROTECTED_DEFINITION;
+      --      is [new INTERFACE_LIST with] PROTECTED_DEFINITION
+      --        [ASPECT_SPECIFICATIONS];
 
       --  Note: single protected declarations are not allowed in Ada 83 mode
 
@@ -5733,7 +5748,8 @@  package Sinfo is
       -- 11.1  Exception Declaration --
       ---------------------------------
 
-      --  EXCEPTION_DECLARATION ::= DEFINING_IDENTIFIER_LIST : exception;
+      --  EXCEPTION_DECLARATION ::= DEFINING_IDENTIFIER_LIST : exception
+      --    [ASPECT_SPECIFICATIONS];
 
       --  For consistency with object declarations etc., the parser converts
       --  the case of multiple identifiers being declared to a series of
@@ -5902,7 +5918,8 @@  package Sinfo is
       ---------------------------------------
 
       --  GENERIC_PACKAGE_DECLARATION ::=
-      --    GENERIC_FORMAL_PART PACKAGE_SPECIFICATION;
+      --    GENERIC_FORMAL_PART PACKAGE_SPECIFICATION
+      --      [ASPECT_SPECIFICATIONS];
 
       --  Note: when we do generics right, the Activation_Chain_Entity entry
       --  for this node can be removed (since the expander won't see generic
@@ -5941,13 +5958,16 @@  package Sinfo is
 
       --  GENERIC_INSTANTIATION ::=
       --    package DEFINING_PROGRAM_UNIT_NAME is
-      --      new generic_package_NAME [GENERIC_ACTUAL_PART];
+      --      new generic_package_NAME [GENERIC_ACTUAL_PART]
+      --        [ASPECT_SPECIFICATIONS];
       --  | [[not] overriding]
       --    procedure DEFINING_PROGRAM_UNIT_NAME is
-      --      new generic_procedure_NAME [GENERIC_ACTUAL_PART];
+      --      new generic_procedure_NAME [GENERIC_ACTUAL_PART]
+      --        [ASPECT_SPECIFICATIONS];
       --  | [[not] overriding]
       --    function DEFINING_DESIGNATOR is
-      --      new generic_function_NAME [GENERIC_ACTUAL_PART];
+      --      new generic_function_NAME [GENERIC_ACTUAL_PART]
+      --        [ASPECT_SPECIFICATIONS];
 
       --  N_Package_Instantiation
       --  Sloc points to PACKAGE
@@ -6031,9 +6051,11 @@  package Sinfo is
 
       --  FORMAL_OBJECT_DECLARATION ::=
       --    DEFINING_IDENTIFIER_LIST :
-      --      MODE [NULL_EXCLUSION] SUBTYPE_MARK [:= DEFAULT_EXPRESSION];
+      --      MODE [NULL_EXCLUSION] SUBTYPE_MARK [:= DEFAULT_EXPRESSION]
+      --        [ASPECT_SPECIFICATIONS];
       --  | DEFINING_IDENTIFIER_LIST :
-      --      MODE ACCESS_DEFINITION [:= DEFAULT_EXPRESSION];
+      --      MODE ACCESS_DEFINITION [:= DEFAULT_EXPRESSION]
+      --        [ASPECT_SPECIFICATIONS];
 
       --  Although the syntax allows multiple identifiers in the list, the
       --  semantics is as though successive declarations were given with
@@ -6061,7 +6083,8 @@  package Sinfo is
 
       --  FORMAL_TYPE_DECLARATION ::=
       --    type DEFINING_IDENTIFIER [DISCRIMINANT_PART]
-      --      is FORMAL_TYPE_DEFINITION;
+      --      is FORMAL_TYPE_DEFINITION
+      --        [ASPECT_SPECIFICATIONS];
 
       --  N_Formal_Type_Declaration
       --  Sloc points to TYPE
@@ -6208,7 +6231,8 @@  package Sinfo is
       --------------------------------------------------
 
       --  FORMAL_CONCRETE_SUBPROGRAM_DECLARATION ::=
-      --    with SUBPROGRAM_SPECIFICATION [is SUBPROGRAM_DEFAULT];
+      --    with SUBPROGRAM_SPECIFICATION [is SUBPROGRAM_DEFAULT]
+      --      [ASPECT_SPECIFICATIONS];
 
       --  N_Formal_Concrete_Subprogram_Declaration
       --  Sloc points to WITH
@@ -6224,7 +6248,8 @@  package Sinfo is
       --------------------------------------------------
 
       --  FORMAL_ABSTRACT_SUBPROGRAM_DECLARATION ::=
-      --    with SUBPROGRAM_SPECIFICATION is abstract [SUBPROGRAM_DEFAULT];
+      --    with SUBPROGRAM_SPECIFICATION is abstract [SUBPROGRAM_DEFAULT]
+      --      [ASPECT_SPECIFICATIONS];
 
       --  N_Formal_Abstract_Subprogram_Declaration
       --  Sloc points to WITH
@@ -6258,7 +6283,8 @@  package Sinfo is
 
       --  FORMAL_PACKAGE_DECLARATION ::=
       --    with package DEFINING_IDENTIFIER
-      --      is new generic_package_NAME FORMAL_PACKAGE_ACTUAL_PART;
+      --      is new generic_package_NAME FORMAL_PACKAGE_ACTUAL_PART
+      --        [ASPECT_SPECIFICATIONS];
 
       --  Note: formal package declarations not allowed in Ada 83 mode
 
@@ -6384,7 +6410,7 @@  package Sinfo is
       --  entry in the list of aspects. So we use this grammar instead:
 
       --     ASPECT_SPECIFICATIONS ::=
-      --       with ASPECT_SPECIFICATION {, ASPECT_SPECIFICATION};
+      --       with ASPECT_SPECIFICATION {, ASPECT_SPECIFICATION}
 
       --     ASPECT_SPECIFICATION =>
       --       ASPECT_MARK [=> ASPECT_DEFINITION]
Index: par-ch13.adb
===================================================================
--- par-ch13.adb	(revision 165316)
+++ par-ch13.adb	(working copy)
@@ -378,17 +378,19 @@  package body Ch13 is
       Aspect  : Node_Id;
       A_Id    : Aspect_Id;
       OK      : Boolean;
+      Ptr     : Source_Ptr;
 
    begin
       --  Check if aspect specification present
 
       if not Aspect_Specifications_Present then
-         T_Semicolon;
+         TF_Semicolon;
          return;
       end if;
 
       --  Aspect Specification is present
 
+      Ptr := Token_Ptr;
       Scan; -- past WITH
 
       --  Here we have an aspect specification to scan, note that we don;t
@@ -511,8 +513,12 @@  package body Ch13 is
       --  If aspects scanned, store them
 
       if Is_Non_Empty_List (Aspects) then
-         Set_Parent (Aspects, Decl);
-         Set_Aspect_Specifications (Decl, Aspects);
+         if Decl = Error then
+            Error_Msg ("aspect specifications not allowed here", Ptr);
+         else
+            Set_Parent (Aspects, Decl);
+            Set_Aspect_Specifications (Decl, Aspects);
+         end if;
       end if;
    end P_Aspect_Specifications;
 
Index: sem_ch9.adb
===================================================================
--- sem_ch9.adb	(revision 165316)
+++ sem_ch9.adb	(working copy)
@@ -1691,6 +1691,7 @@  package body Sem_Ch9 is
           Defining_Identifier => O_Name,
           Object_Definition   => Make_Identifier (Loc,  Chars (T)));
 
+      Move_Aspects (N, O_Decl);
       Rewrite (N, T_Decl);
       Insert_After (N, O_Decl);
       Mark_Rewrite_Insertion (O_Decl);
@@ -1749,13 +1750,15 @@  package body Sem_Ch9 is
       --  entity is the new object declaration. The single_task_declaration
       --  is not used further in semantics or code generation, but is scanned
       --  when generating debug information, and therefore needs the updated
-      --  Sloc information for the entity (see Sprint).
+      --  Sloc information for the entity (see Sprint). Aspect specifications
+      --  are moved from the single task node to the object declaration node.
 
       O_Decl :=
         Make_Object_Declaration (Loc,
           Defining_Identifier => O_Name,
           Object_Definition   => Make_Identifier (Loc, Chars (T)));
 
+      Move_Aspects (N, O_Decl);
       Rewrite (N, T_Decl);
       Insert_After (N, O_Decl);
       Mark_Rewrite_Insertion (O_Decl);
Index: par-endh.adb
===================================================================
--- par-endh.adb	(revision 165316)
+++ par-endh.adb	(working copy)
@@ -166,7 +166,7 @@  package body Endh is
    -- Check_End --
    ---------------
 
-   function Check_End return Boolean is
+   function Check_End (Decl : Node_Id := Empty) return Boolean is
       Name_On_Separate_Line : Boolean;
       --  Set True if the name on an END line is on a separate source line
       --  from the END. This is highly suspicious, but is allowed. The point
@@ -387,6 +387,15 @@  package body Endh is
             end if;
          end if;
 
+         --  Scan aspect specifications if permitted here
+
+         if Aspect_Specifications_Present then
+            if No (Decl) then
+               P_Aspect_Specifications (Error);
+            else
+               P_Aspect_Specifications (Decl);
+            end if;
+
          --  Except in case of END RECORD, semicolon must follow. For END
          --  RECORD, a semicolon does follow, but it is part of a higher level
          --  construct. In any case, a missing semicolon is not serious enough
@@ -394,7 +403,7 @@  package body Endh is
          --  are dealing with (i.e. to be suspicious that it is not in fact
          --  the END statement we are looking for!)
 
-         if End_Type /= E_Record then
+         elsif End_Type /= E_Record then
             if Token = Tok_Semicolon then
                T_Semicolon;
 
@@ -644,13 +653,15 @@  package body Endh is
 
    --  Error recovery: cannot raise Error_Resync;
 
-   procedure End_Statements (Parent : Node_Id := Empty) is
+   procedure End_Statements
+     (Parent : Node_Id := Empty;
+      Decl   : Node_Id := Empty) is
    begin
       --  This loop runs more than once in the case where Check_End rejects
       --  the END sequence, as indicated by Check_End returning False.
 
       loop
-         if Check_End then
+         if Check_End (Decl) then
             if Present (Parent) then
                Set_End_Label (Parent, End_Labl);
             end if;
Index: sem_ch12.adb
===================================================================
--- sem_ch12.adb	(revision 165316)
+++ sem_ch12.adb	(working copy)
@@ -5768,6 +5768,14 @@  package body Sem_Ch12 is
 
       New_N := New_Copy (N);
 
+      --  Copy aspects if present
+
+      if Has_Aspects (N) then
+         Set_Has_Aspects (New_N, False);
+         Set_Aspect_Specifications
+           (New_N, Copy_Generic_List (Aspect_Specifications (N), Parent_Id));
+      end if;
+
       if Instantiating then
          Adjust_Instantiation_Sloc (New_N, S_Adjustment);
       end if;
Index: sem_ch12.ads
===================================================================
--- sem_ch12.ads	(revision 165316)
+++ sem_ch12.ads	(working copy)
@@ -64,7 +64,9 @@  package Sem_Ch12 is
    --  repeatedly: once to produce a copy on which semantic analysis of
    --  the generic is performed, and once for each instantiation. The tree
    --  being copied is not semantically analyzed, except that references to
-   --  global entities are marked on terminal nodes.
+   --  global entities are marked on terminal nodes. Note that this function
+   --  copies any aspect specifications from the input node N to the returned
+   --  node, as well as the setting of the Has_Aspects flag.
 
    function Get_Instance_Of (A : Entity_Id) return Entity_Id;
    --  Retrieve actual associated with given generic parameter.
Index: par.adb
===================================================================
--- par.adb	(revision 165316)
+++ par.adb	(working copy)
@@ -754,10 +754,14 @@  function Par (Configuration_Pragmas : Bo
    -------------
 
    package Ch7 is
-      function P_Package (Pf_Flags : Pf_Rec) return Node_Id;
+      function P_Package
+        (Pf_Flags : Pf_Rec;
+         Decl     : Node_Id := Empty) return Node_Id;
       --  Scans out any construct starting with the keyword PACKAGE. The
       --  parameter indicates which possible kinds of construct (body, spec,
-      --  instantiation etc.) are permissible in the current context.
+      --  instantiation etc.) are permissible in the current context. Decl
+      --  is set in the specification case to request that if there are aspect
+      --  specifications present, they be associated with this declaration.
    end Ch7;
 
    -------------
@@ -854,7 +858,9 @@  function Par (Configuration_Pragmas : Bo
       --  the given declaration node, and the list of aspect specifications is
       --  constructed and associated with this declaration node using a call to
       --  Set_Aspect_Specifications. If no WITH keyword is present, then this
-      --  call has no effect other than scanning out the semicolon.
+      --  call has no effect other than scanning out the semicolon. If Decl is
+      --  Error on entry, any scanned aspect specifications are ignored and a
+      --  message is output saying aspect specifications not permitted here.
 
       function P_Code_Statement (Subtype_Mark : Node_Id) return Node_Id;
       --  Function to parse a code statement. The caller has scanned out
@@ -880,7 +886,7 @@  function Par (Configuration_Pragmas : Bo
    --  Routines for handling end lines, including scope recovery
 
    package Endh is
-      function Check_End return Boolean;
+      function Check_End (Decl : Node_Id := Empty) return Boolean;
       --  Called when an end sequence is required. In the absence of an error
       --  situation, Token contains Tok_End on entry, but in a missing end
       --  case, this may not be the case. Pop_End_Context is used to determine
@@ -891,6 +897,10 @@  function Par (Configuration_Pragmas : Bo
       --  Skip_And_Reject). Note that the END sequence includes a semicolon,
       --  except in the case of END RECORD, where a semicolon follows the END
       --  RECORD, but is not part of the record type definition itself.
+      --
+      --  If Decl is non-empty, then aspect specifications are permitted
+      --  following the end, and Decl is the declaration node with which
+      --  these aspect specifications are to be associated.
 
       procedure End_Skip;
       --  Skip past an end sequence. On entry Token contains Tok_End, and we
@@ -900,13 +910,19 @@  function Par (Configuration_Pragmas : Bo
       --  position after the end sequence. We do not issue any additional
       --  error messages while carrying this out.
 
-      procedure End_Statements (Parent : Node_Id := Empty);
+      procedure End_Statements
+        (Parent : Node_Id := Empty;
+         Decl   : Node_Id := Empty);
       --  Called when an end is required or expected to terminate a sequence
       --  of statements. The caller has already made an appropriate entry in
       --  the Scope.Table to describe the expected form of the end. This can
       --  only be used in cases where the only appropriate terminator is end.
       --  If Parent is non-empty, then if a correct END line is encountered,
       --  the End_Label field of Parent is set appropriately.
+      --
+      --  If Decl is non-null, then it is a declaration node, and aspect
+      --  specifications are permitted after the end statement. These aspect
+      --  specifications, if present, are stored in this declaration node.
    end Endh;
 
    --------------
Index: par-ch6.adb
===================================================================
--- par-ch6.adb	(revision 165316)
+++ par-ch6.adb	(working copy)
@@ -84,10 +84,13 @@  package body Ch6 is
    --  subprogram renaming declaration or subprogram generic instantiation.
    --  It also handles the new Ada 2012 parameterized expression form
 
-   --  SUBPROGRAM_DECLARATION ::= SUBPROGRAM_SPECIFICATION;
+   --  SUBPROGRAM_DECLARATION ::=
+   --    SUBPROGRAM_SPECIFICATION
+   --     [ASPECT_SPECIFICATIONS];
 
    --  ABSTRACT_SUBPROGRAM_DECLARATION ::=
-   --    SUBPROGRAM_SPECIFICATION is abstract;
+   --    SUBPROGRAM_SPECIFICATION is abstract
+   --      [ASPECT_SPECIFICATIONS];
 
    --  SUBPROGRAM_SPECIFICATION ::=
    --      procedure DEFINING_PROGRAM_UNIT_NAME PARAMETER_PROFILE
@@ -445,13 +448,19 @@  package body Ch6 is
          end if;
       end if;
 
+      --  Subprogram declaration ended by aspect specifications
+
+      if Aspect_Specifications_Present then
+         goto Subprogram_Declaration;
+
       --  Deal with case of semicolon ending a subprogram declaration
 
-      if Token = Tok_Semicolon then
+      elsif Token = Tok_Semicolon then
          if not Pf_Flags.Decl then
             T_Is;
          end if;
 
+         Save_Scan_State (Scan_State);
          Scan; -- past semicolon
 
          --  If semicolon is immediately followed by IS, then ignore the
@@ -476,6 +485,7 @@  package body Ch6 is
             goto Subprogram_Body;
 
          else
+            Restore_Scan_State (Scan_State);
             goto Subprogram_Declaration;
          end if;
 
@@ -544,7 +554,6 @@  package body Ch6 is
                   Set_Null_Present (Specification_Node);
                end if;
 
-               TF_Semicolon;
                goto Subprogram_Declaration;
 
             --  Check for IS NEW with Formal_Part present and handle nicely
@@ -572,6 +581,11 @@  package body Ch6 is
                goto Subprogram_Body;
             end if;
 
+         --  Aspect specifications present
+
+         elsif Aspect_Specifications_Present then
+            goto Subprogram_Declaration;
+
          --  Here we have a missing IS or missing semicolon, we always guess
          --  a missing semicolon, since we are pretty good at fixing up a
          --  semicolon which should really be an IS
@@ -770,6 +784,7 @@  package body Ch6 is
          Decl_Node :=
            New_Node (N_Subprogram_Declaration, Sloc (Specification_Node));
          Set_Specification (Decl_Node, Specification_Node);
+         P_Aspect_Specifications (Decl_Node);
 
          --  If this is a context in which a subprogram body is permitted,
          --  set active SIS entry in case (see section titled "Handling
Index: aspects.adb
===================================================================
--- aspects.adb	(revision 165316)
+++ aspects.adb	(working copy)
@@ -160,6 +160,20 @@  package body Aspects is
       end if;
    end Aspect_Specifications;
 
+   ------------------
+   -- Move_Aspects --
+   ------------------
+
+   procedure Move_Aspects (From : Node_Id; To : Node_Id) is
+      pragma Assert (not Has_Aspects (To));
+   begin
+      if Has_Aspects (From) then
+         Set_Aspect_Specifications (To, Aspect_Specifications (From));
+         Aspect_Specifications_Hash_Table.Remove (From);
+         Set_Has_Aspects (From, False);
+      end if;
+   end Move_Aspects;
+
    -----------------------------------
    -- Permits_Aspect_Specifications --
    -----------------------------------
Index: aspects.ads
===================================================================
--- aspects.ads	(revision 165316)
+++ aspects.ads	(working copy)
@@ -195,6 +195,12 @@  package Aspects is
    --  node that has its Has_Aspects flag set True on entry, or with L being an
    --  empty list or No_List.
 
+   procedure Move_Aspects (From : Node_Id; To : Node_Id);
+   --  Moves aspects from 'From' node to 'To' node. Has_Aspects (To) must be
+   --  False on entry. If Has_Aspects (From) is False, the call has no effect.
+   --  Otherwise the aspects are moved and on return Has_Aspects (To) is True,
+   --  and Has_Aspects (From) is False.
+
    procedure Tree_Write;
    --  Writes contents of Aspect_Specifications hash table to the tree file
 
Index: par-ch12.adb
===================================================================
--- par-ch12.adb	(revision 165316)
+++ par-ch12.adb	(working copy)
@@ -61,10 +61,12 @@  package body Ch12 is
    --    GENERIC_SUBPROGRAM_DECLARATION | GENERIC_PACKAGE_DECLARATION
 
    --  GENERIC_SUBPROGRAM_DECLARATION ::=
-   --    GENERIC_FORMAL_PART SUBPROGRAM_SPECIFICATION;
+   --    GENERIC_FORMAL_PART SUBPROGRAM_SPECIFICATION
+   --      [ASPECT_SPECIFICATIONS];
 
    --  GENERIC_PACKAGE_DECLARATION ::=
-   --    GENERIC_FORMAL_PART PACKAGE_SPECIFICATION;
+   --    GENERIC_FORMAL_PART PACKAGE_SPECIFICATION
+   --      [ASPECT_SPECIFICATIONS];
 
    --  GENERIC_FORMAL_PART ::=
    --    generic {GENERIC_FORMAL_PARAMETER_DECLARATION | USE_CLAUSE}
@@ -194,14 +196,14 @@  package body Ch12 is
                exit Decl_Loop;
             end if;
          end if;
-
       end loop Decl_Loop;
 
       --  Generic formal part is scanned, scan out subprogram or package spec
 
       if Token = Tok_Package then
          Gen_Decl := New_Node (N_Generic_Package_Declaration, Gen_Sloc);
-         Set_Specification (Gen_Decl, P_Package (Pf_Spcn));
+         Set_Specification (Gen_Decl, P_Package (Pf_Spcn, Gen_Decl));
+
       else
          Gen_Decl := New_Node (N_Generic_Subprogram_Declaration, Gen_Sloc);
 
@@ -213,7 +215,8 @@  package body Ch12 is
          then
             Error_Msg_SP ("child unit allowed only at library level");
          end if;
-         TF_Semicolon;
+
+         P_Aspect_Specifications (Gen_Decl);
       end if;
 
       Set_Generic_Formal_Declarations (Gen_Decl, Decls);
@@ -275,8 +278,9 @@  package body Ch12 is
    begin
       --  Figure out if a generic actual part operation is present. Clearly
       --  there is no generic actual part if the current token is semicolon
+      --  or if we have apsect specifications present.
 
-      if Token = Tok_Semicolon then
+      if Token = Tok_Semicolon or else Aspect_Specifications_Present then
          return No_List;
 
       --  If we don't have a left paren, then we have an error, and the job
@@ -402,9 +406,11 @@  package body Ch12 is
 
    --  FORMAL_OBJECT_DECLARATION ::=
    --    DEFINING_IDENTIFIER_LIST :
-   --      MODE [NULL_EXCLUSION] SUBTYPE_MARK [:= DEFAULT_EXPRESSION];
+   --      MODE [NULL_EXCLUSION] SUBTYPE_MARK [:= DEFAULT_EXPRESSION]
+   --        [ASPECT_SPECIFICATIONS];
    --  | DEFINING_IDENTIFIER_LIST :
    --      MODE ACCESS_DEFINITION [:= DEFAULT_EXPRESSION];
+   --        [ASPECT_SPECIFICATIONS];
 
    --  The caller has checked that the initial token is an identifier
 
@@ -425,7 +431,6 @@  package body Ch12 is
    begin
       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);
@@ -479,6 +484,7 @@  package body Ch12 is
 
          No_Constraint;
          Set_Default_Expression (Decl_Node, Init_Expr_Opt);
+         P_Aspect_Specifications (Decl_Node);
 
          if Ident > 1 then
             Set_Prev_Ids (Decl_Node, True);
@@ -494,8 +500,6 @@  package body Ch12 is
          Ident := Ident + 1;
          Restore_Scan_State (Scan_State);
       end loop Ident_Loop;
-
-      TF_Semicolon;
    end P_Formal_Object_Declarations;
 
    -----------------------------------
@@ -504,7 +508,8 @@  package body Ch12 is
 
    --  FORMAL_TYPE_DECLARATION ::=
    --    type DEFINING_IDENTIFIER [DISCRIMINANT_PART]
-   --      is FORMAL_TYPE_DEFINITION;
+   --      is FORMAL_TYPE_DEFINITION
+   --        [ASPECT_SPECIFICATIONS];
 
    --  The caller has checked that the initial token is TYPE
 
@@ -532,15 +537,20 @@  package body Ch12 is
 
       if Def_Node /= Error then
          Set_Formal_Type_Definition (Decl_Node, Def_Node);
-         TF_Semicolon;
+         P_Aspect_Specifications (Decl_Node);
 
       else
          Decl_Node := Error;
 
+         --  If we have aspect specifications, skip them
+
+         if Aspect_Specifications_Present then
+            P_Aspect_Specifications (Error);
+
          --  If we have semicolon, skip it to avoid cascaded errors
 
-         if Token = Tok_Semicolon then
-            Scan;
+         elsif Token = Tok_Semicolon then
+            Scan; -- past semicolon
          end if;
       end if;
 
@@ -1078,10 +1088,12 @@  package body Ch12 is
    --  | FORMAL_ABSTRACT_SUBPROGRAM_DECLARATION
 
    --  FORMAL_CONCRETE_SUBPROGRAM_DECLARATION ::=
-   --    with SUBPROGRAM_SPECIFICATION [is SUBPROGRAM_DEFAULT];
+   --    with SUBPROGRAM_SPECIFICATION [is SUBPROGRAM_DEFAULT]
+   --      [ASPECT_SPECIFICATIONS];
 
    --  FORMAL_ABSTRACT_SUBPROGRAM_DECLARATION ::=
-   --    with SUBPROGRAM_SPECIFICATION is abstract [SUBPROGRAM_DEFAULT];
+   --    with SUBPROGRAM_SPECIFICATION is abstract [SUBPROGRAM_DEFAULT]
+   --      [ASPECT_SPECIFICATIONS];
 
    --  SUBPROGRAM_DEFAULT ::= DEFAULT_NAME | <>
 
@@ -1122,12 +1134,14 @@  package body Ch12 is
          Set_Specification (Def_Node, Spec_Node);
 
          if Token = Tok_Semicolon then
-            Scan; -- past ";"
+            null;
+
+         elsif Aspect_Specifications_Present then
+            null;
 
          elsif Token = Tok_Box then
             Set_Box_Present (Def_Node, True);
             Scan; -- past <>
-            T_Semicolon;
 
          elsif Token = Tok_Null then
             if Ada_Version < Ada_2005 then
@@ -1143,20 +1157,18 @@  package body Ch12 is
             end if;
 
             Scan;  --  past NULL
-            T_Semicolon;
 
          else
             Set_Default_Name (Def_Node, P_Name);
-            T_Semicolon;
          end if;
 
       else
          Def_Node :=
            New_Node (N_Formal_Concrete_Subprogram_Declaration, Prev_Sloc);
          Set_Specification (Def_Node, Spec_Node);
-         T_Semicolon;
       end if;
 
+      P_Aspect_Specifications (Def_Node);
       return Def_Node;
    end P_Formal_Subprogram_Declaration;
 
@@ -1178,7 +1190,8 @@  package body Ch12 is
 
    --  FORMAL_PACKAGE_DECLARATION ::=
    --    with package DEFINING_IDENTIFIER
-   --      is new generic_package_NAME FORMAL_PACKAGE_ACTUAL_PART;
+   --      is new generic_package_NAME FORMAL_PACKAGE_ACTUAL_PART
+   --        [ASPECT_SPECIFICATIONS];
 
    --  FORMAL_PACKAGE_ACTUAL_PART ::=
    --    ([OTHERS =>] <>) |
@@ -1222,7 +1235,7 @@  package body Ch12 is
          end if;
       end if;
 
-      T_Semicolon;
+      P_Aspect_Specifications (Def_Node);
       return Def_Node;
    end P_Formal_Package_Declaration;
 
Index: atree.adb
===================================================================
--- atree.adb	(revision 165316)
+++ atree.adb	(working copy)
@@ -1191,7 +1191,6 @@  package body Atree is
 
    begin
       if Source > Empty_Or_Error then
-
          New_Id := Allocate_Initialize_Node (Source, Has_Extension (Source));
 
          Nodes.Table (New_Id).Link := Empty_List_Or_Node;
@@ -1202,6 +1201,11 @@  package body Atree is
 
          Nodes.Table (New_Id).Rewrite_Ins := False;
          pragma Debug (New_Node_Debugging_Output (New_Id));
+
+         --  Always clear Has_Aspects, the caller must take care of copying
+         --  aspects if this is required for the particular situation.
+
+         Set_Has_Aspects (New_Id, False);
       end if;
 
       return New_Id;
@@ -1659,6 +1663,7 @@  package body Atree is
          --  of aspect specifications if aspect specifications are present.
 
          if Has_Aspects (Sav_Node) then
+            Set_Has_Aspects (Sav_Node, False);
             Set_Aspect_Specifications
               (Sav_Node, Aspect_Specifications (Old_Node));
          end if;
Index: atree.ads
===================================================================
--- atree.ads	(revision 165316)
+++ atree.ads	(working copy)
@@ -398,7 +398,10 @@  package Atree is
    --  The parent pointer of the destination and its list link, if any, are
    --  not affected by the copy. Note that parent pointers of descendents
    --  are not adjusted, so the descendents of the destination node after
-   --  the Copy_Node is completed have dubious parent pointers.
+   --  the Copy_Node is completed have dubious parent pointers. Note that
+   --  this routine does NOT copy aspect specifications, the Has_Aspects
+   --  flag in the returned node will always be False. The caller must deal
+   --  with copying aspect specifications where this is required.
 
    function New_Copy (Source : Node_Id) return Node_Id;
    --  This function allocates a completely new node, and then initializes
Index: par-ch3.adb
===================================================================
--- par-ch3.adb	(revision 165316)
+++ par-ch3.adb	(working copy)
@@ -276,7 +276,8 @@  package body Ch3 is
    --  | PRIVATE_EXTENSION_DECLARATION
 
    --  FULL_TYPE_DECLARATION ::=
-   --    type DEFINING_IDENTIFIER [KNOWN_DISCRIMINANT_PART] is TYPE_DEFINITION;
+   --    type DEFINING_IDENTIFIER [KNOWN_DISCRIMINANT_PART] is TYPE_DEFINITION
+   --      [ASPECT_SPECIFICATIONS];
    --  | CONCURRENT_TYPE_DECLARATION
 
    --  INCOMPLETE_TYPE_DECLARATION ::=
@@ -1260,11 +1261,14 @@  package body Ch3 is
 
    --  OBJECT_DECLARATION ::=
    --    DEFINING_IDENTIFIER_LIST : [aliased] [constant]
-   --      [NULL_EXCLUSION] SUBTYPE_INDICATION [:= EXPRESSION];
+   --      [NULL_EXCLUSION] SUBTYPE_INDICATION [:= EXPRESSION]
+   --        [ASPECT_SPECIFICATIONS];
    --  | DEFINING_IDENTIFIER_LIST : [aliased] [constant]
-   --      ACCESS_DEFINITION [:= EXPRESSION];
+   --      ACCESS_DEFINITION [:= EXPRESSION]
+   --        [ASPECT_SPECIFICATIONS];
    --  | DEFINING_IDENTIFIER_LIST : [aliased] [constant]
-   --      ARRAY_TYPE_DEFINITION [:= EXPRESSION];
+   --      ARRAY_TYPE_DEFINITION [:= EXPRESSION]
+   --        [ASPECT_SPECIFICATIONS];
 
    --  NUMBER_DECLARATION ::=
    --    DEFINING_IDENTIFIER_LIST : constant ::= static_EXPRESSION;
@@ -1279,7 +1283,8 @@  package body Ch3 is
    --    DEFINING_IDENTIFIER : exception renames exception_NAME;
 
    --  EXCEPTION_DECLARATION ::=
-   --    DEFINING_IDENTIFIER_LIST : exception;
+   --    DEFINING_IDENTIFIER_LIST : exception
+   --      [ASPECT_SPECIFICATIONS];
 
    --  Note that the ALIASED indication in an object declaration is
    --  marked by a flag in the parent node.
@@ -3322,7 +3327,8 @@  package body Ch3 is
 
    --  COMPONENT_DECLARATION ::=
    --    DEFINING_IDENTIFIER_LIST : COMPONENT_DEFINITION
-   --      [:= DEFAULT_EXPRESSION];
+   --      [:= DEFAULT_EXPRESSION]
+   --        [ASPECT_SPECIFICATIONS];
 
    --  COMPONENT_DEFINITION ::=
    --    [aliased] [NULL_EXCLUSION] SUBTYPE_INDICATION | ACCESS_DEFINITION
Index: par-ch7.adb
===================================================================
--- par-ch7.adb	(revision 165316)
+++ par-ch7.adb	(working copy)
@@ -37,7 +37,9 @@  package body Ch7 is
    --  This routine scans out a package declaration, package body, or a
    --  renaming declaration or generic instantiation starting with PACKAGE
 
-   --  PACKAGE_DECLARATION ::= PACKAGE_SPECIFICATION;
+   --  PACKAGE_DECLARATION ::=
+   --    PACKAGE_SPECIFICATION
+   --      [ASPECT_SPECIFICATIONS];
 
    --  PACKAGE_SPECIFICATION ::=
    --    package DEFINING_PROGRAM_UNIT_NAME is
@@ -59,6 +61,11 @@  package body Ch7 is
    --  PACKAGE_BODY_STUB ::=
    --    package body DEFINING_IDENTIFIER is separate;
 
+   --  PACKAGE_INSTANTIATION ::=
+   --    package DEFINING_PROGRAM_UNIT_NAME is
+   --      new generic_package_NAME [GENERIC_ACTUAL_PART]
+   --        [ASPECT_SPECIFICATIONS];
+
    --  The value in Pf_Flags indicates which of these possible declarations
    --  is acceptable to the caller:
 
@@ -85,7 +92,10 @@  package body Ch7 is
 
    --  Error recovery: cannot raise Error_Resync
 
-   function P_Package (Pf_Flags : Pf_Rec) return Node_Id is
+   function P_Package
+     (Pf_Flags : Pf_Rec;
+      Decl     : Node_Id := Empty) return Node_Id
+   is
       Package_Node       : Node_Id;
       Specification_Node : Node_Id;
       Name_Node          : Node_Id;
@@ -185,7 +195,7 @@  package body Ch7 is
                Set_Name (Package_Node, P_Qualified_Simple_Name);
                Set_Generic_Associations
                  (Package_Node, P_Generic_Actual_Part_Opt);
-               TF_Semicolon;
+               P_Aspect_Specifications (Package_Node);
                Pop_Scope_Stack;
 
             --  Case of package declaration or package specification
@@ -239,7 +249,11 @@  package body Ch7 is
                   Discard_Junk_List (P_Sequence_Of_Statements (SS_None));
                end if;
 
-               End_Statements (Specification_Node);
+               if Nkind (Package_Node) = N_Package_Declaration then
+                  End_Statements (Specification_Node, Package_Node);
+               else
+                  End_Statements (Specification_Node, Decl);
+               end if;
             end if;
 
             return Package_Node;