diff mbox

[Ada] Missing aspect specifications on bodies, renamings and stubs

Message ID 20130910150548.GA22107@adacore.com
State New
Headers show

Commit Message

Arnaud Charlet Sept. 10, 2013, 3:05 p.m. UTC
This patch allows the compiler to parse and analyze aspect specifications that
apply to package bodies, protected bodies, task bodies, [generic] renaming
declarations, and body stubs.

------------
-- Source --
------------

--  bodies.adb

package body Bodies with Warnings => On is
   protected body Prot_Typ with Warnings => On is
      entry E when True is begin null; end E;
   end Prot_Typ;

   task body Task_Typ with Warnings => On is
   begin
      accept E;
   end Task_Typ;
end Bodies;

--  bodies.ads

package Bodies is
   protected type Prot_Typ is
      entry E;
   end Prot_Typ;

   task type Task_Typ is
      entry E;
   end Task_Typ;
end Bodies;

--  declarations.ads

package Declarations is

   --  Entry declaration

   task type Task_Typ is
      entry Task_Entry with Warnings => On;
   end Task_Typ;

   --  Exception declaration

   Exc : exception with Warnings => On;

   --  Object declaration

   Obj_1 : Integer with Warnings => On;
   Obj_2 : Integer := 123 with Warnings => On;
   Obj_3 : aliased Integer with Warnings => On;
   Obj_4 : aliased constant Integer := 123 with Warnings => On;
   Obj_5 : access Integer := null with Warnings => On;
   Obj_6 : not null access Integer := Obj_3'Access with Warnings => On;
   type Array_Typ is array (Integer range 1 .. 10) of Boolean;
   Obj_7 : Array_Typ := (others => False) with Warnings => On;

   --  Private extension declaration

   type Root is tagged null record;
   type Priv_Ext is new Root with private with Warnings => On;

   --  Private type declaration

   type Priv_Typ is private with Warnings => On;

private
   type Priv_Ext is new Root with null record;
   type Priv_Typ is null record;
end Declarations;

--  expressions.ads

package Expressions is

   --  Expression function

   function Func (Flag : Boolean) return Integer
     is (if Flag then 123 else 456) with Warnings => On;
end Expressions;

--  generics.ads

package Generics is
   generic
      type Any is private;
   function Gen_Func return Any with Warnings => On;

   generic
      type Any is private;
   package Gen_Pack is
   end Gen_Pack;

   generic
      type Any is private;
   procedure Gen_Proc with Warnings => On;
end Generics;

--  instances.ads

with Generics; use Generics;

package Instances is

   --  Generic function instantiation

   function Func_Inst is new Gen_Func (Integer) with Warnings => On;

   --  Generic package instantiation

   package Pack_Inst is new Gen_Pack (Integer) with Warnings => On;

   --  Generic procedure instantiation

   procedure Proc_Inst is new Gen_Proc (Integer) with Warnings => On;
end Instances;

--  renamings.ads

with Declarations; use Declarations;
with Generics;     use Generics;

package Renamings is

   --  Exception renaming

   Exc_Ren : exception renames Exc with Warnings => On;

   --  Generic renaming declaration

   generic function  Gen_Func_Ren renames Gen_Func with Warnings => On;
   generic package   Gen_Pack_Ren renames Gen_Pack with Warnings => On;
   generic procedure Gen_Proc_Ren renames Gen_Proc with Warnings => On;

   --  Object renaming declaration

   Obj : aliased Integer;
   Obj_Ren : Integer renames Obj with Warnings => On;

   Obj_Ptr : not null access Integer := Obj'Access;
   Obj_Ptr_Ren_1 : access Integer renames Obj_Ptr with Warnings => On;
   Obj_Ptr_Ren_2 : not null access Integer renames Obj_Ptr with Warnings => On;

   --  Package renaming declaration

   package Decl_Ren renames Declarations with Warnings => On;

   --  Subprogram renaming declaration

   function Func return Integer;
   procedure Proc;

   function Func_Ren return Integer renames Func with Warnings => On;
   procedure Proc_ren renames Proc with Warnings => On;
end Renamings;

--  stubs.adb

package body Stubs is

   --  Package stub

   package body Pack is separate with Warnings => On;

   --  Protected stub

   protected body Prot_Typ is separate with Warnings => On;

   --  Subprogram stub

   function Func return Integer is separate with Warnings => On;
   procedure Proc is separate with Warnings => On;

   --  Task stub

   task body Task_Typ is separate with Warnings => On;
end Stubs;

--  stubs.ads

package Stubs is
   package Pack is
      procedure Dummy;
   end Pack;

   protected type Prot_Typ is
      entry E;
   end Prot_Typ;

   function Func return Integer;
   procedure Proc;

   task type Task_Typ is
      entry E;
   end Task_Typ;
end Stubs;

--  stubs-func.adb

separate (Stubs)

function Func return Integer is
begin
   return 0;
end Func;

--  stubs-pack.adb

separate (Stubs)

package body Pack is
   procedure Dummy is begin null; end Dummy;
end Pack;

--  stubs-proc.adb

separate (Stubs)

procedure Proc is begin null; end Proc;

--  stubs-prot_typ.adb

separate (Stubs)

protected body Prot_Typ is
   entry E when True is begin null; end E;
end Prot_Typ;

--  stubs-task_typ.adb

separate (Stubs)

task body Task_Typ is
begin
   accept E;
end Task_Typ;

----------------------------
-- Compilation and output --
----------------------------

$ gcc -c -gnat12 bodies.adb
$ gcc -c -gnatc -gnat12 declarations.ads
$ gcc -c -gnatc -gnat12 expressions.ads
$ gcc -c -gnatc -gnat12 instances.ads
$ gcc -c -gnatc -gnat12 renamings.ads
$ gcc -c -gnat12 stubs.adb
bodies.adb:2:04: warning: user-defined aspects on protected bodies are not
  supported
bodies.adb:6:04: warning: user-defined aspects on task bodies are not supported
stubs-prot_typ.adb:3:01: warning: user-defined aspects on protected bodies are
  not supported
stubs-task_typ.adb:3:01: warning: user-defined aspects on task bodies are not
  supported

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

2013-09-10  Hristian Kirtchev  <kirtchev@adacore.com>

	* aspects.adb: Add entries in the Has_Aspect_Specifications_Flag
	table for package body and body stubs.
	(Move_Or_Merge_Aspects): New routine.
	(Remove_Aspects): New routine.
	* aspects.ads (Move_Aspects): Update comment on usage.
	(Move_Or_Merge_Aspects): New routine.
	(Remove_Aspects): New routine.
	* par-ch3.adb: Update the grammar of private_type_declaration,
	private_extension_declaration, object_renaming_declaration,
	and exception_renaming_declaration.
	(P_Subprogram): Parse the
	aspect specifications that apply to a body stub.
	* par-ch6.adb: Update the grammar of subprogram_body_stub and
	generic_instantiation.
	* par-ch7.adb: Update the grammar of package_declaration,
	package_specification, package_body, package_renaming_declaration,
	package_body_stub.
	(P_Package): Parse the aspect specifications
	that apply to a body, a body stub and package renaming.
	* par-ch9.adb: Update the grammar of entry_declaration,
	protected_body, protected_body_stub, task_body,
	and task_body_stub.
	(P_Protected): Add local variable
	Aspect_Sloc. Add local constant Dummy_Node.  Parse the aspect
	specifications that apply to a protected body and a protected
	body stub.
	(P_Task): Add local variable Aspect_Sloc. Add local
	constant Dummy_Node. Parse the aspect specifications that apply
	to a task body and a task body stub.
	* par-ch12.adb: Update the grammar of
	generic_renaming_declaration.
	(P_Generic): Parse the aspect
	specifications that apply to a generic renaming.
	* sem_ch6.adb (Analyze_Subprogram_Body_Helper): Do not emit
	an error when analyzing aspects that apply to a body stub. Such
	aspects are relocated to the proper body.
	* sem_ch7.adb (Analyze_Package_Body_Helper): Analyze the aspect
	specifications that apply to a body.
	* sem_ch9.adb (Analyze_Protected_Body): Warn about user-defined
	aspects not being supported on protected bodies. Remove the
	aspect specifications.	(Analyze_Single_Protected_Declaration):
	Analyze the aspects that apply to a single protected declaration.
	(Analyze_Task_Body): Warn about user-defined aspects not being
	supported on task bodies. Remove the aspect specifications.
	* sem_ch10.adb: Add with and use clause for Aspects.
	(Analyze_Package_Body_Stub): Propagate the aspect specifications
	from the stub to the proper body.
	* sem_ch13.adb (Analyze_Aspect_Specifications): Insert the
	corresponding pragma of an aspect that applies to a body in the
	declarations of the body.
	* sinfo.ads: Update the gramma of expression_function,
	private_type_declaration, private_extension_declaration,
	object_renaming_declaration, exception_renaming_declaration,
	package_renaming_declaration, subprogram_renaming_declaration,
	generic_renaming_declaration, entry_declaration,
	subprogram_body_stub, package_body_stub, task_body_stub,
	generic_subprogram_declaration.
diff mbox

Patch

Index: par-ch9.adb
===================================================================
--- par-ch9.adb	(revision 202451)
+++ par-ch9.adb	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2013, 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- --
@@ -61,14 +61,15 @@ 
    --      [is [new INTERFACE_LIST with] TASK_DEFINITION];
 
    --  TASK_BODY ::=
-   --    task body DEFINING_IDENTIFIER is
+   --    task body DEFINING_IDENTIFIER [ASPECT_SPECIFICATIONS] is
    --      DECLARATIVE_PART
    --    begin
    --      HANDLED_SEQUENCE_OF_STATEMENTS
    --    end [task_IDENTIFIER]
 
    --  TASK_BODY_STUB ::=
-   --    task body DEFINING_IDENTIFIER is separate;
+   --    task body DEFINING_IDENTIFIER is separate
+   --      [ASPECT_SPECIFICATIONS];
 
    --  This routine scans out a task declaration, task body, or task stub
 
@@ -78,10 +79,16 @@ 
    --  Error recovery: cannot raise Error_Resync
 
    function P_Task return Node_Id is
-      Name_Node  : Node_Id;
-      Task_Node  : Node_Id;
-      Task_Sloc  : Source_Ptr;
+      Aspect_Sloc : Source_Ptr;
+      Name_Node   : Node_Id;
+      Task_Node   : Node_Id;
+      Task_Sloc   : Source_Ptr;
 
+      Dummy_Node : constant Node_Id := New_Node (N_Task_Body, Token_Ptr);
+      --  Placeholder node used to hold legal or prematurely declared aspect
+      --  specifications. Depending on the context, the aspect specifications
+      --  may be moved to a new node.
+
    begin
       Push_Scope_Stack;
       Scope.Table (Scope.Last).Etyp := E_Name;
@@ -100,6 +107,11 @@ 
             Discard_Junk_List (P_Known_Discriminant_Part_Opt);
          end if;
 
+         if Aspect_Specifications_Present then
+            Aspect_Sloc := Token_Ptr;
+            P_Aspect_Specifications (Dummy_Node, Semicolon => False);
+         end if;
+
          TF_Is;
 
          --  Task stub
@@ -108,6 +120,14 @@ 
             Scan; -- past SEPARATE
             Task_Node := New_Node (N_Task_Body_Stub, Task_Sloc);
             Set_Defining_Identifier (Task_Node, Name_Node);
+
+            if Has_Aspects (Dummy_Node) then
+               Error_Msg
+                 ("aspect specifications must come after SEPARATE",
+                  Aspect_Sloc);
+            end if;
+
+            P_Aspect_Specifications (Task_Node, Semicolon => False);
             TF_Semicolon;
             Pop_Scope_Stack; -- remove unused entry
 
@@ -116,6 +136,13 @@ 
          else
             Task_Node := New_Node (N_Task_Body, Task_Sloc);
             Set_Defining_Identifier (Task_Node, Name_Node);
+
+            --  Move the aspect specifications to the body node
+
+            if Has_Aspects (Dummy_Node) then
+               Move_Aspects (From => Dummy_Node, To => Task_Node);
+            end if;
+
             Parse_Decls_Begin_End (Task_Node);
          end if;
 
@@ -367,12 +394,15 @@ 
    --    is [new INTERFACE_LIST with] PROTECTED_DEFINITION;
 
    --  PROTECTED_BODY ::=
-   --    protected body DEFINING_IDENTIFIER is
+   --    protected body DEFINING_IDENTIFIER
+   --      [ASPECT_SPECIFICATIONS]
+   --    is
    --      {PROTECTED_OPERATION_ITEM}
    --    end [protected_IDENTIFIER];
 
    --  PROTECTED_BODY_STUB ::=
-   --    protected body DEFINING_IDENTIFIER is separate;
+   --    protected body DEFINING_IDENTIFIER is separate
+   --      [ASPECT_SPECIFICATIONS];
 
    --  This routine scans out a protected declaration, protected body
    --  or a protected stub.
@@ -383,11 +413,17 @@ 
    --  Error recovery: cannot raise Error_Resync
 
    function P_Protected return Node_Id is
+      Aspect_Sloc    : Source_Ptr;
       Name_Node      : Node_Id;
       Protected_Node : Node_Id;
       Protected_Sloc : Source_Ptr;
       Scan_State     : Saved_Scan_State;
 
+      Dummy_Node : constant Node_Id := New_Node (N_Protected_Body, Token_Ptr);
+      --  Placeholder node used to hold legal or prematurely declared aspect
+      --  specifications. Depending on the context, the aspect specifications
+      --  may be moved to a new node.
+
    begin
       Push_Scope_Stack;
       Scope.Table (Scope.Last).Etyp := E_Name;
@@ -405,14 +441,28 @@ 
             Discard_Junk_List (P_Known_Discriminant_Part_Opt);
          end if;
 
+         if Aspect_Specifications_Present then
+            Aspect_Sloc := Token_Ptr;
+            P_Aspect_Specifications (Dummy_Node, Semicolon => False);
+         end if;
+
          TF_Is;
 
          --  Protected stub
 
          if Token = Tok_Separate then
             Scan; -- past SEPARATE
+
             Protected_Node := New_Node (N_Protected_Body_Stub, Protected_Sloc);
             Set_Defining_Identifier (Protected_Node, Name_Node);
+
+            if Has_Aspects (Dummy_Node) then
+               Error_Msg
+                 ("aspect specifications must come after SEPARATE",
+                  Aspect_Sloc);
+            end if;
+
+            P_Aspect_Specifications (Protected_Node, Semicolon => False);
             TF_Semicolon;
             Pop_Scope_Stack; -- remove unused entry
 
@@ -421,6 +471,8 @@ 
          else
             Protected_Node := New_Node (N_Protected_Body, Protected_Sloc);
             Set_Defining_Identifier (Protected_Node, Name_Node);
+
+            Move_Aspects (From => Dummy_Node, To => Protected_Node);
             Set_Declarations (Protected_Node, P_Protected_Operation_Items);
             End_Statements (Protected_Node);
          end if;
@@ -800,8 +852,8 @@ 
 
    --  ENTRY_DECLARATION ::=
    --    [OVERRIDING_INDICATOR]
-   --    entry DEFINING_IDENTIFIER [(DISCRETE_SUBTYPE_DEFINITION)]
-   --      PARAMETER_PROFILE;
+   --    entry DEFINING_IDENTIFIER
+   --      [(DISCRETE_SUBTYPE_DEFINITION)] PARAMETER_PROFILE
    --        [ASPECT_SPECIFICATIONS];
 
    --  The caller has checked that the initial token is ENTRY, NOT or
Index: sinfo.ads
===================================================================
--- sinfo.ads	(revision 202459)
+++ sinfo.ads	(working copy)
@@ -4775,7 +4775,8 @@ 
       --  and put in its proper section when we know exactly where that is!
 
       --  EXPRESSION_FUNCTION ::=
-      --    FUNCTION SPECIFICATION IS (EXPRESSION);
+      --    FUNCTION SPECIFICATION IS (EXPRESSION)
+      --      [ASPECT_SPECIFICATIONS];
 
       --  N_Expression_Function
       --  Sloc points to FUNCTION
@@ -5010,7 +5011,8 @@ 
 
       --  PRIVATE_TYPE_DECLARATION ::=
       --    type DEFINING_IDENTIFIER [DISCRIMINANT_PART]
-      --      is [[abstract] tagged] [limited] private;
+      --      is [[abstract] tagged] [limited] private
+      --        [ASPECT_SPECIFICATIONS];
 
       --  Note: TAGGED is not permitted in Ada 83 mode
 
@@ -5032,7 +5034,7 @@ 
       --    type DEFINING_IDENTIFIER [DISCRIMINANT_PART] is
       --      [abstract] [limited | synchronized]
       --        new ancestor_SUBTYPE_INDICATION [and INTERFACE_LIST]
-      --           with private;
+      --           with private [ASPECT_SPECIFICATIONS];
 
       --  Note: LIMITED, and private extension declarations are not allowed
       --        in Ada 83 mode.
@@ -5102,9 +5104,11 @@ 
 
       --  OBJECT_RENAMING_DECLARATION ::=
       --    DEFINING_IDENTIFIER :
-      --      [NULL_EXCLUSION] SUBTYPE_MARK renames object_NAME;
+      --      [NULL_EXCLUSION] SUBTYPE_MARK renames object_NAME
+      --        [ASPECT_SPECIFICATIONS];
       --  | DEFINING_IDENTIFIER :
-      --      ACCESS_DEFINITION renames object_NAME;
+      --      ACCESS_DEFINITION renames object_NAME
+      --        [ASPECT_SPECIFICATIONS];
 
       --  Note: Access_Definition is an optional field that gives support to
       --  Ada 2005 (AI-230). The parser generates nodes that have either the
@@ -5124,7 +5128,8 @@ 
       -----------------------------------------
 
       --  EXCEPTION_RENAMING_DECLARATION ::=
-      --    DEFINING_IDENTIFIER : exception renames exception_NAME;
+      --    DEFINING_IDENTIFIER : exception renames exception_NAME
+      --      [ASPECT_SPECIFICATIONS];
 
       --  N_Exception_Renaming_Declaration
       --  Sloc points to first identifier
@@ -5136,7 +5141,8 @@ 
       ---------------------------------------
 
       --  PACKAGE_RENAMING_DECLARATION ::=
-      --    package DEFINING_PROGRAM_UNIT_NAME renames package_NAME;
+      --    package DEFINING_PROGRAM_UNIT_NAME renames package_NAME
+      --      [ASPECT_SPECIFICATIONS];
 
       --  N_Package_Renaming_Declaration
       --  Sloc points to PACKAGE
@@ -5149,7 +5155,8 @@ 
       ------------------------------------------
 
       --  SUBPROGRAM_RENAMING_DECLARATION ::=
-      --    SUBPROGRAM_SPECIFICATION renames callable_entity_NAME;
+      --    SUBPROGRAM_SPECIFICATION renames callable_entity_NAME
+      --      [ASPECT_SPECIFICATIONS];
 
       --  N_Subprogram_Renaming_Declaration
       --  Sloc points to RENAMES
@@ -5167,10 +5174,13 @@ 
       --  GENERIC_RENAMING_DECLARATION ::=
       --    generic package DEFINING_PROGRAM_UNIT_NAME
       --      renames generic_package_NAME
+      --        [ASPECT_SPECIFICATIONS];
       --  | generic procedure DEFINING_PROGRAM_UNIT_NAME
       --      renames generic_procedure_NAME
+      --        [ASPECT_SPECIFICATIONS];
       --  | generic function DEFINING_PROGRAM_UNIT_NAME
       --      renames generic_function_NAME
+      --        [ASPECT_SPECIFICATIONS];
 
       --  N_Generic_Package_Renaming_Declaration
       --  Sloc points to GENERIC
@@ -5384,7 +5394,8 @@ 
       --  ENTRY_DECLARATION ::=
       --    [[not] overriding]
       --    entry DEFINING_IDENTIFIER
-      --      [(DISCRETE_SUBTYPE_DEFINITION)] PARAMETER_PROFILE;
+      --      [(DISCRETE_SUBTYPE_DEFINITION)] PARAMETER_PROFILE
+      --        [ASPECT_SPECIFICATIONS];
 
       --  N_Entry_Declaration
       --  Sloc points to ENTRY
@@ -5985,7 +5996,8 @@ 
       ----------------------------------
 
       --  SUBPROGRAM_BODY_STUB ::=
-      --    SUBPROGRAM_SPECIFICATION is separate;
+      --    SUBPROGRAM_SPECIFICATION is separate
+      --      [ASPECT_SPECIFICATION];
 
       --  N_Subprogram_Body_Stub
       --  Sloc points to FUNCTION or PROCEDURE
@@ -5998,7 +6010,8 @@ 
       -------------------------------
 
       --  PACKAGE_BODY_STUB ::=
-      --    package body DEFINING_IDENTIFIER is separate;
+      --    package body DEFINING_IDENTIFIER is separate
+      --      [ASPECT_SPECIFICATION];
 
       --  N_Package_Body_Stub
       --  Sloc points to PACKAGE
@@ -6011,7 +6024,8 @@ 
       ----------------------------
 
       --  TASK_BODY_STUB ::=
-      --    task body DEFINING_IDENTIFIER is separate;
+      --    task body DEFINING_IDENTIFIER is separate
+      --      [ASPECT_SPECIFICATION];
 
       --  N_Task_Body_Stub
       --  Sloc points to TASK
@@ -6024,7 +6038,8 @@ 
       ---------------------------------
 
       --  PROTECTED_BODY_STUB ::=
-      --    protected body DEFINING_IDENTIFIER is separate;
+      --    protected body DEFINING_IDENTIFIER is separate
+      --      [ASPECT_SPECIFICATION];
 
       --  Note: protected body stubs are not allowed in Ada 83 mode
 
@@ -6225,7 +6240,8 @@ 
       ------------------------------------------
 
       --  GENERIC_SUBPROGRAM_DECLARATION ::=
-      --    GENERIC_FORMAL_PART SUBPROGRAM_SPECIFICATION;
+      --    GENERIC_FORMAL_PART SUBPROGRAM_SPECIFICATION
+      --      [ASPECT_SPECIFICATIONS];
 
       --  Note: Generic_Formal_Declarations can include pragmas
 
Index: sem_ch7.adb
===================================================================
--- sem_ch7.adb	(revision 202451)
+++ sem_ch7.adb	(working copy)
@@ -219,11 +219,15 @@ 
       --  the later is never used for name resolution. In this fashion there
       --  is only one visible entity that denotes the package.
 
-      --  Set Body_Id. Note that this Will be reset to point to the generic
+      --  Set Body_Id. Note that this will be reset to point to the generic
       --  copy later on in the generic case.
 
       Body_Id := Defining_Entity (N);
 
+      if Has_Aspects (N) then
+         Analyze_Aspect_Specifications (N, Body_Id);
+      end if;
+
       if Present (Corresponding_Spec (N)) then
 
          --  Body is body of package instantiation. Corresponding spec has
@@ -766,7 +770,7 @@ 
       --  True when this package declaration is not a nested declaration
 
    begin
-      --  Analye aspect specifications immediately, since we need to recognize
+      --  Analyze aspect specifications immediately, since we need to recognize
       --  things like Pure early enough to diagnose violations during analysis.
 
       if Has_Aspects (N) then
Index: sem_ch9.adb
===================================================================
--- sem_ch9.adb	(revision 202451)
+++ sem_ch9.adb	(working copy)
@@ -1734,6 +1734,22 @@ 
       Set_Ekind (Body_Id, E_Protected_Body);
       Spec_Id := Find_Concurrent_Spec (Body_Id);
 
+      --  Protected bodies are currently removed by the expander. Since there
+      --  are no language-defined aspects that apply to a protected body, it is
+      --  not worth changing the whole expansion to accomodate user-defined
+      --  aspects. Plus we cannot possibly known the semantics of user-defined
+      --  aspects in order to plan ahead.
+
+      if Has_Aspects (N) then
+         Error_Msg_N
+           ("?user-defined aspects on protected bodies are not supported", N);
+
+         --  The aspects are removed for now to prevent cascading errors down
+         --  stream.
+
+         Remove_Aspects (N);
+      end if;
+
       if Present (Spec_Id)
         and then Ekind (Spec_Id) = E_Protected_Type
       then
@@ -2606,6 +2622,10 @@ 
       --  disastrous result.
 
       Analyze_Protected_Type_Declaration (N);
+
+      if Has_Aspects (N) then
+         Analyze_Aspect_Specifications (N, Id);
+      end if;
    end Analyze_Single_Protected_Declaration;
 
    -------------------------------------
@@ -2703,6 +2723,22 @@ 
       Set_Scope (Body_Id, Current_Scope);
       Spec_Id := Find_Concurrent_Spec (Body_Id);
 
+      --  Task bodies are transformed into a subprogram spec and body pair by
+      --  the expander. Since there are no language-defined aspects that apply
+      --  to a task body, it is not worth changing the whole expansion to
+      --  accomodate user-defined aspects. Plus we cannot possibly known the
+      --  semantics of user-defined aspects in order to plan ahead.
+
+      if Has_Aspects (N) then
+         Error_Msg_N
+           ("?user-defined aspects on task bodies are not supported", N);
+
+         --  The aspects are removed for now to prevent cascading errors down
+         --  stream.
+
+         Remove_Aspects (N);
+      end if;
+
       --  The spec is either a task type declaration, or a single task
       --  declaration for which we have created an anonymous type.
 
Index: sem_ch10.adb
===================================================================
--- sem_ch10.adb	(revision 202451)
+++ sem_ch10.adb	(working copy)
@@ -23,6 +23,7 @@ 
 --                                                                          --
 ------------------------------------------------------------------------------
 
+with Aspects;  use Aspects;
 with Atree;    use Atree;
 with Debug;    use Debug;
 with Einfo;    use Einfo;
@@ -1555,8 +1556,8 @@ 
    -------------------------------
 
    procedure Analyze_Package_Body_Stub (N : Node_Id) is
-      Id   : constant Entity_Id := Defining_Identifier (N);
-      Nam  : Entity_Id;
+      Id  : constant Entity_Id := Defining_Identifier (N);
+      Nam : Entity_Id;
 
    begin
       --  The package declaration must be in the current declarative part
@@ -1844,6 +1845,12 @@ 
                         SCO_Record (Unum);
                      end if;
 
+                     --  Propagate any aspect specifications associated with
+                     --  with the stub to the proper body.
+
+                     Move_Or_Merge_Aspects
+                       (From => N, To => Proper_Body (Unit (Comp_Unit)));
+
                      --  Analyze the unit if semantics active
 
                      if not Fatal_Error (Unum) or else Try_Semantics then
@@ -2327,8 +2334,8 @@ 
    ----------------------------
 
    procedure Analyze_Task_Body_Stub (N : Node_Id) is
+      Loc : constant Source_Ptr := Sloc (N);
       Nam : Entity_Id := Current_Entity_In_Scope (Defining_Identifier (N));
-      Loc : constant Source_Ptr := Sloc (N);
 
    begin
       Check_Stub_Level (N);
Index: par-ch6.adb
===================================================================
--- par-ch6.adb	(revision 202451)
+++ par-ch6.adb	(working copy)
@@ -161,13 +161,16 @@ 
    --      [ASPECT_SPECIFICATIONS];
 
    --  SUBPROGRAM_BODY_STUB ::=
-   --    SUBPROGRAM_SPECIFICATION is separate;
+   --    SUBPROGRAM_SPECIFICATION is separate
+   --      [ASPECT_SPECIFICATIONS];
 
    --  GENERIC_INSTANTIATION ::=
    --    procedure DEFINING_PROGRAM_UNIT_NAME is
-   --      new generic_procedure_NAME [GENERIC_ACTUAL_PART];
+   --      new generic_procedure_NAME [GENERIC_ACTUAL_PART]
+   --        [ASPECT_SPECIFICATIONS];
    --  | function DEFINING_DESIGNATOR is
-   --      new generic_function_NAME [GENERIC_ACTUAL_PART];
+   --      new generic_function_NAME [GENERIC_ACTUAL_PART]
+   --        [ASPECT_SPECIFICATIONS];
 
    --  NULL_PROCEDURE_DECLARATION ::=
    --    SUBPROGRAM_SPECIFICATION is null;
@@ -394,8 +397,8 @@ 
       if Token = Tok_Identifier
         and then not Token_Is_At_Start_Of_Line
       then
-            T_Left_Paren; -- to generate message
-            Fpart_List := P_Formal_Part;
+         T_Left_Paren; -- to generate message
+         Fpart_List := P_Formal_Part;
 
       --  Otherwise scan out an optional formal part in the usual manner
 
@@ -681,21 +684,21 @@ 
                   Sloc (Name_Node));
             end if;
 
+            Scan; -- past SEPARATE
+
             Stub_Node :=
               New_Node (N_Subprogram_Body_Stub, Sloc (Specification_Node));
             Set_Specification (Stub_Node, Specification_Node);
 
-            --  The specification has been parsed as part of a subprogram
-            --  declaration, and aspects have already been collected.
-
             if Is_Non_Empty_List (Aspects) then
-               Set_Parent (Aspects, Stub_Node);
-               Set_Aspect_Specifications (Stub_Node, Aspects);
+               Error_Msg
+                 ("aspect specifications must come after SEPARATE",
+                  Sloc (First (Aspects)));
             end if;
 
-            Scan; -- past SEPARATE
+            P_Aspect_Specifications (Stub_Node, Semicolon => False);
+            TF_Semicolon;
             Pop_Scope_Stack;
-            TF_Semicolon;
             return Stub_Node;
 
          --  Subprogram body or expression function case
Index: aspects.adb
===================================================================
--- aspects.adb	(revision 202451)
+++ aspects.adb	(working copy)
@@ -271,6 +271,31 @@ 
       end if;
    end Move_Aspects;
 
+   ---------------------------
+   -- Move_Or_Merge_Aspects --
+   ---------------------------
+
+   procedure Move_Or_Merge_Aspects (From : Node_Id; To : Node_Id) is
+   begin
+      if Has_Aspects (From) then
+
+         --  Merge the aspects of From into To. Make sure that From has no
+         --  aspects after the merge takes place.
+
+         if Has_Aspects (To) then
+            Append_List
+              (List => Aspect_Specifications (From),
+               To   => Aspect_Specifications (To));
+            Remove_Aspects (From);
+
+         --  Otherwise simply move the aspects
+
+         else
+            Move_Aspects (From => From, To => To);
+         end if;
+      end if;
+   end Move_Or_Merge_Aspects;
+
    -----------------------------------
    -- Permits_Aspect_Specifications --
    -----------------------------------
@@ -294,6 +319,8 @@ 
       N_Generic_Subprogram_Declaration         => True,
       N_Object_Declaration                     => True,
       N_Object_Renaming_Declaration            => True,
+      N_Package_Body                           => True,
+      N_Package_Body_Stub                      => True,
       N_Package_Declaration                    => True,
       N_Package_Instantiation                  => True,
       N_Package_Specification                  => True,
@@ -302,6 +329,7 @@ 
       N_Private_Type_Declaration               => True,
       N_Procedure_Instantiation                => True,
       N_Protected_Body                         => True,
+      N_Protected_Body_Stub                    => True,
       N_Protected_Type_Declaration             => True,
       N_Single_Protected_Declaration           => True,
       N_Single_Task_Declaration                => True,
@@ -311,6 +339,7 @@ 
       N_Subprogram_Body_Stub                   => True,
       N_Subtype_Declaration                    => True,
       N_Task_Body                              => True,
+      N_Task_Body_Stub                         => True,
       N_Task_Type_Declaration                  => True,
       others                                   => False);
 
@@ -319,6 +348,18 @@ 
       return Has_Aspect_Specifications_Flag (Nkind (N));
    end Permits_Aspect_Specifications;
 
+   --------------------
+   -- Remove_Aspects --
+   --------------------
+
+   procedure Remove_Aspects (N : Node_Id) is
+   begin
+      if Has_Aspects (N) then
+         Aspect_Specifications_Hash_Table.Remove (N);
+         Set_Has_Aspects (N, False);
+      end if;
+   end Remove_Aspects;
+
    -----------------
    -- Same_Aspect --
    -----------------
Index: aspects.ads
===================================================================
--- aspects.ads	(revision 202458)
+++ aspects.ads	(working copy)
@@ -698,16 +698,24 @@ 
    --  Determine whether entity Id has aspect A
 
    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.
+   --  Relocate the aspect specifications of node From to node To. On entry it
+   --  is assumed that To does not have aspect specifications. If From has no
+   --  aspects, the routine has no effect.
 
+   procedure Move_Or_Merge_Aspects (From : Node_Id; To : Node_Id);
+   --  Relocate the aspect specifications of node From to node To. If To has
+   --  aspects, the aspects of From are added to the aspects of To. If From has
+   --  no aspects, the routine has no effect.
+
    function Permits_Aspect_Specifications (N : Node_Id) return Boolean;
    --  Returns True if the node N is a declaration node that permits aspect
    --  specifications in the grammar. It is possible for other nodes to have
    --  aspect specifications as a result of Rewrite or Replace calls.
 
+   procedure Remove_Aspects (N : Node_Id);
+   --  Delete the aspect specifications associated with node N. If the node has
+   --  no aspects, the routine has no effect.
+
    function Same_Aspect (A1 : Aspect_Id; A2 : Aspect_Id) return Boolean;
    --  Returns True if A1 and A2 are (essentially) the same aspect. This is not
    --  a simple equality test because e.g. Post and Postcondition are the same.
Index: sem_ch6.adb
===================================================================
--- sem_ch6.adb	(revision 202451)
+++ sem_ch6.adb	(working copy)
@@ -2680,7 +2680,14 @@ 
       --  a corresponding spec, but for which there may also be a spec_id.
 
       if Has_Aspects (N) then
-         if Present (Spec_Id) then
+
+         --  Aspects that apply to a body stub are relocated to the proper
+         --  body. Do not emit an error in this case.
+
+         if Present (Spec_Id)
+           and then Nkind (N) not in N_Body_Stub
+           and then Nkind (Parent (N)) /= N_Subunit
+         then
             Error_Msg_N
               ("aspect specifications must appear in subprogram declaration",
                 N);
Index: par-ch12.adb
===================================================================
--- par-ch12.adb	(revision 202451)
+++ par-ch12.adb	(working copy)
@@ -74,10 +74,13 @@ 
    --  GENERIC_RENAMING_DECLARATION ::=
    --    generic package DEFINING_PROGRAM_UNIT_NAME
    --      renames generic_package_NAME
+   --        [ASPECT_SPECIFICATIONS];
    --  | generic procedure DEFINING_PROGRAM_UNIT_NAME
    --      renames generic_procedure_NAME
+   --        [ASPECT_SPECIFICATIONS];
    --  | generic function DEFINING_PROGRAM_UNIT_NAME
    --      renames generic_function_NAME
+   --        [ASPECT_SPECIFICATIONS];
 
    --  GENERIC_FORMAL_PARAMETER_DECLARATION ::=
    --    FORMAL_OBJECT_DECLARATION
@@ -140,6 +143,8 @@ 
                Scan; -- past RENAMES
                Set_Defining_Unit_Name (Decl_Node, Def_Unit);
                Set_Name (Decl_Node, P_Name);
+
+               P_Aspect_Specifications (Decl_Node, Semicolon => False);
                TF_Semicolon;
                return Decl_Node;
             end if;
@@ -211,7 +216,6 @@ 
 
       else
          Gen_Decl := New_Node (N_Generic_Subprogram_Declaration, Gen_Sloc);
-
          Set_Specification (Gen_Decl, P_Subprogram_Specification);
 
          if Nkind (Defining_Unit_Name (Specification (Gen_Decl))) =
Index: sem_ch13.adb
===================================================================
--- sem_ch13.adb	(revision 202459)
+++ sem_ch13.adb	(working copy)
@@ -1781,7 +1781,6 @@ 
                --  Warnings
 
                when Aspect_Warnings =>
-
                   Make_Aitem_Pragma
                     (Pragma_Argument_Associations => New_List (
                        Make_Pragma_Argument_Association (Sloc (Expr),
@@ -2434,6 +2433,18 @@ 
                Set_Has_Delayed_Aspects (E);
                Record_Rep_Item (E, Aspect);
 
+            --  When delay is not required and the context is a package body,
+            --  insert the pragma in the declarations of the body.
+
+            elsif Nkind (N) = N_Package_Body then
+               if No (Declarations (N)) then
+                  Set_Declarations (N, New_List);
+               end if;
+
+               --  The pragma is added before source declarations
+
+               Prepend_To (Declarations (N), Aitem);
+
             --  When delay is not required and the context is not a compilation
             --  unit, we simply insert the pragma/attribute definition clause
             --  in sequence.
Index: par-ch3.adb
===================================================================
--- par-ch3.adb	(revision 202451)
+++ par-ch3.adb	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2012, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2013, 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- --
@@ -275,13 +275,14 @@ 
 
    --  PRIVATE_TYPE_DECLARATION ::=
    --    type DEFINING_IDENTIFIER [DISCRIMINANT_PART]
-   --      is [abstract] [tagged] [limited] private;
+   --      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;
+   --          with private [ASPECT_SPECIFICATIONS];
 
    --  TYPE_DEFINITION ::=
    --    ENUMERATION_TYPE_DEFINITION  | INTEGER_TYPE_DEFINITION
@@ -1277,12 +1278,15 @@ 
 
    --  OBJECT_RENAMING_DECLARATION ::=
    --    DEFINING_IDENTIFIER :
-   --      [NULL_EXCLUSION] SUBTYPE_MARK renames object_NAME;
+   --      [NULL_EXCLUSION] SUBTYPE_MARK renames object_NAME
+   --        [ASPECT_SPECIFICATIONS];
    --  | DEFINING_IDENTIFIER :
-   --      ACCESS_DEFINITION renames object_NAME;
+   --      ACCESS_DEFINITION renames object_NAME
+   --        [ASPECT_SPECIFICATIONS];
 
    --  EXCEPTION_RENAMING_DECLARATION ::=
-   --    DEFINING_IDENTIFIER : exception renames exception_NAME;
+   --    DEFINING_IDENTIFIER : exception renames exception_NAME
+   --      [ASPECT_SPECIFICATIONS];
 
    --  EXCEPTION_DECLARATION ::=
    --    DEFINING_IDENTIFIER_LIST : exception
@@ -1669,15 +1673,19 @@ 
 
             --  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];
 
             --  OBJECT_RENAMING_DECLARATION ::=
             --    DEFINING_IDENTIFIER :
-            --      [NULL_EXCLUSION] SUBTYPE_MARK renames object_NAME;
+            --      [NULL_EXCLUSION] SUBTYPE_MARK renames object_NAME
+            --        [ASPECT_SPECIFICATIONS];
             --  | DEFINING_IDENTIFIER :
-            --      ACCESS_DEFINITION renames object_NAME;
+            --      ACCESS_DEFINITION renames object_NAME
+            --        [ASPECT_SPECIFICATIONS];
 
             Not_Null_Present := P_Null_Exclusion;  --  Ada 2005 (AI-231/423)
 
@@ -1893,7 +1901,7 @@ 
    --     type DEFINING_IDENTIFIER [DISCRIMINANT_PART] is
    --       [abstract] [limited | synchronized]
    --          new ancestor_SUBTYPE_INDICATION [and INTERFACE_LIST]
-   --            with private;
+   --            with private [ASPECT_SPECIFICATIONS];
 
    --  RECORD_EXTENSION_PART ::= with RECORD_DEFINITION
 
Index: par-ch7.adb
===================================================================
--- par-ch7.adb	(revision 202451)
+++ par-ch7.adb	(working copy)
@@ -38,28 +38,33 @@ 
    --  renaming declaration or generic instantiation starting with PACKAGE
 
    --  PACKAGE_DECLARATION ::=
-   --    PACKAGE_SPECIFICATION
-   --      [ASPECT_SPECIFICATIONS];
+   --    PACKAGE_SPECIFICATION;
 
    --  PACKAGE_SPECIFICATION ::=
-   --    package DEFINING_PROGRAM_UNIT_NAME is
+   --    package DEFINING_PROGRAM_UNIT_NAME
+   --      [ASPECT_SPECIFICATIONS]
+   --    is
    --      {BASIC_DECLARATIVE_ITEM}
    --    [private
    --      {BASIC_DECLARATIVE_ITEM}]
    --    end [[PARENT_UNIT_NAME .] IDENTIFIER]
 
    --  PACKAGE_BODY ::=
-   --    package body DEFINING_PROGRAM_UNIT_NAME is
+   --    package body DEFINING_PROGRAM_UNIT_NAME
+   --      [ASPECT_SPECIFICATIONS]
+   --    is
    --      DECLARATIVE_PART
    --    [begin
    --      HANDLED_SEQUENCE_OF_STATEMENTS]
    --    end [[PARENT_UNIT_NAME .] IDENTIFIER]
 
    --  PACKAGE_RENAMING_DECLARATION ::=
-   --    package DEFINING_IDENTIFIER renames package_NAME;
+   --    package DEFINING_IDENTIFIER renames package_NAME
+   --      [ASPECT_SPECIFICATIONS];
 
    --  PACKAGE_BODY_STUB ::=
-   --    package body DEFINING_IDENTIFIER is separate;
+   --    package body DEFINING_IDENTIFIER is separate
+   --      [ASPECT_SPECIFICATIONS];
 
    --  PACKAGE_INSTANTIATION ::=
    --    package DEFINING_PROGRAM_UNIT_NAME is
@@ -141,6 +146,12 @@ 
          Scope.Table (Scope.Last).Sloc := Token_Ptr;
          Name_Node := P_Defining_Program_Unit_Name;
          Scope.Table (Scope.Last).Labl := Name_Node;
+
+         if Aspect_Specifications_Present then
+            Aspect_Sloc := Token_Ptr;
+            P_Aspect_Specifications (Dummy_Node, Semicolon => False);
+         end if;
+
          TF_Is;
 
          if Separate_Present then
@@ -149,16 +160,30 @@ 
             end if;
 
             Scan; -- past SEPARATE
-            TF_Semicolon;
-            Pop_Scope_Stack;
 
             Package_Node := New_Node (N_Package_Body_Stub, Package_Sloc);
             Set_Defining_Identifier (Package_Node, Name_Node);
 
+            if Has_Aspects (Dummy_Node) then
+               Error_Msg
+                 ("aspect specifications must come after SEPARATE",
+                  Aspect_Sloc);
+            end if;
+
+            P_Aspect_Specifications (Package_Node, Semicolon => False);
+            TF_Semicolon;
+            Pop_Scope_Stack;
+
          else
             Package_Node := New_Node (N_Package_Body, Package_Sloc);
             Set_Defining_Unit_Name (Package_Node, Name_Node);
 
+            --  Move the aspect specifications to the body node
+
+            if Has_Aspects (Dummy_Node) then
+               Move_Aspects (From => Dummy_Node, To => Package_Node);
+            end if;
+
             --  In SPARK, a HIDE directive can be placed at the beginning of a
             --  package implementation, thus hiding the package body from SPARK
             --  tool-set. No violation of the SPARK restriction should be
@@ -204,6 +229,7 @@ 
             Set_Name (Package_Node, P_Qualified_Simple_Name);
 
             No_Constraint;
+            P_Aspect_Specifications (Package_Node, Semicolon => False);
             TF_Semicolon;
             Pop_Scope_Stack;