Patchwork [Ada] Delay of aspect specification evaluation

login
register
mail settings
Submitter Arnaud Charlet
Date June 12, 2012, 1:03 p.m.
Message ID <20120612130336.GA27165@adacore.com>
Download mbox | patch
Permalink /patch/164413/
State New
Headers show

Comments

Arnaud Charlet - June 12, 2012, 1:03 p.m.
This patch implements the delay for each aspect specification evaluation.
Indeed, according to the RM 13.1.1 (13), all aspects are evaluated at the
freeze point or the end of the enclosing declaration list. 

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

2012-06-12  Vincent Pucci  <pucci@adacore.com>

	* checks.adb (Tag_Checks_Suppressed): Remove Kill_Tag_Checks check.
	* einfo.adb (Universal_Aliasing): Apply to the implementation
	base type instead of the base type.
	(Get_Rep_Item_For_Entity):
	Return a pragma if the pragma node is not present in the Rep
	Item chain of the parent.
	(Kill_Tag_Checks): Removed (unused flag).
	(Set_Kill_Tag_Checks): Removed.
	(Get_First_Rep_Item): New routine.
	(Get_Rep_Pragma_For_Entity): New routine.
	(Has_Rep_Item): New routine.
	(Has_Rep_Pragma_For_Entity): New routine.
	(Present_In_Rep_Item): New routine.
	* einfo.ads (Kill_Tag_Checks): Removed.
	(Set_Kill_Tag_Checks): Removed.
	(Get_First_Rep_Item): New routine.
	(Get_Rep_Pragma_For_Entity): New routine.
	(Has_Rep_Item): New routine.
	(Has_Rep_Pragma_For_Entity): New routine.
	(Present_In_Rep_Item): New routine.
	* exp_attr.adb, sem_attr.adb: Attribute_CPU,
	Attribute_Dispatching_Domain and Attribute_Interrupt_Priority
	case added.
	* exp_ch13.adb (Expand_N_Attribute_Definition_Clause): For
	attribute Storage_Size, insert the new assignement statement
	after the Size variable declaration.
	* exp_ch3.adb (Build_Init_Statements): Fill the CPU,
	Dispatching_Domain, Priority and Size components with the Rep
	Item expression (if any).
	* exp_ch9.adb (Expand_N_Task_Type_Declaration): _CPU,
	_Priority, _Domain fields are always present in the
	corresponding record type.
	(Find_Task_Or_Protected_Pragma): Removed.
	(Get_Relative_Deadline_Pragma): New routine.
	(Make_Initialize_Protection): Find_Task_Or_Protected_Pragma removed.
	(Make_Task_Create_Call): Check CPU, Size or
	Dispatching_Domain Rep Item is present using new routine Has_Rep_Item.
	* freeze.adb (Freeze_All): Push_Scope_And_Install_Discriminants
	and Uninstall_Discriminants_And_Pop_Scope calls added.
	(Freeze_Entity): Evaluate_Aspects_At_Freeze_Point call added.
	* sem_aux.adb (Nearest_Ancestor): Retrieve the nearest ancestor
	for private derived types.
	* sem_ch13.adb (Analyze_Aspect_Specifications): Clean-up
	and reordering. Delay analysis for all aspects (except some
	peculiar cases).
	(Analyze_Attribute_Definition_Clause):
	Attribute_CPU, Attribute_Dispatching_Domain,
	Interrupt_Priority and Attribute_Priority cases added.
	(Analyze_Freeze_Entity): Push_Scope_And_Install_Discriminants
	and Uninstall_Discriminants_And_Pop_Scope calls added.
	(Check_Aspect_At_Freeze_Point): Reordering and clean-up.
	(Duplicate_Clause): Issue an explicit error msg when the current
	clause duplicates an aspect specification, an attribute definition
	clause or a pragma.
	(Evaluate_Aspects_At_Freeze_Point): New routine.
	* sem_ch13.ads (Evaluate_Aspects_At_Freeze_Point): New routine.
	* sem_ch9.adb, sem_ch9.ads (Install_Discriminants): New routine.
	(Push_Scope_And_Install_Discriminants): New routine.
	(Uninstall_Discriminants): New routine.
	(Uninstall_Discriminants_And_Pop_Scope): New routine.
	* sem_prag.adb (Check_Duplicate_Pragma): Issue an explicit error
	msg when the current pragma duplicates an aspect specification,
	an attribute definition clause or a pragma.
	(Analyze_Pragma): Remove use of flags Has_Pragma_CPU,
	Has_Pragma_Priority and Has_Pragma_Dispatching_Domain.
	* sem_util.adb (Compile_Time_Constraint_Error): Don't complain
	about the type if the corresponding concurrent type doesn't come
	from source.
	* sinfo.adb, sinfo.ads (Has_Pragma_CPU): Removed.
	(Has_Pragma_Dispatching_Domain): Removed.
	(Has_Pragma_Priority): Removed.
	(Has_Task_Info_Pragma): Removed.
	(Has_Task_Name_Pragma): Removed.
	(Set_Has_Pragma_CPU): Removed.
	(Set_Has_Pragma_Dispatching_Domain): Removed.
	(Set_Has_Pragma_Priority): Removed.
	(Set_Has_Task_Info_Pragma): Removed.
	(Set_Has_Task_Name_Pragma): Removed.
	* snames.adb-tmpl (Get_Pragma_Id): Pragma_CPU,
	Pragma_Dispatching_Domain and Pragma_Interrupt_Priority added.
	(Is_Pragma_Name): Name_CPU, Name_Dispatching_Domain and
	Name_Interrupt_Priority added.
	* snames.ads-tmpl: Name_Dispatching_Domain, Name_CPU
	and Name_Interrupt_Priority moved to the list of
	Attribute_Name. Attribute_CPU, Attribute_Dispatching_Domain and
	Attribute_Interrupt_Priority added.  Pragma_Dispatching_Domain,
	Pragma_CPU and Pragma_Interrupt_Priority moved to the end of
	the Pragma_Name list.

Patch

Index: sem_aux.adb
===================================================================
--- sem_aux.adb	(revision 188428)
+++ sem_aux.adb	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2012, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -832,7 +832,7 @@ 
    ----------------------
 
    function Nearest_Ancestor (Typ : Entity_Id) return Entity_Id is
-         D : constant Node_Id := Declaration_Node (Typ);
+      D : constant Node_Id := Original_Node (Declaration_Node (Typ));
 
    begin
       --  If we have a subtype declaration, get the ancestor subtype
@@ -860,6 +860,15 @@ 
             end if;
          end;
 
+      --  If derived type and private type, get the full view to find who we
+      --  are derived from.
+
+      elsif Is_Derived_Type (Typ)
+        and then Is_Private_Type (Typ)
+        and then Present (Full_View (Typ))
+      then
+         return Nearest_Ancestor (Full_View (Typ));
+
       --  Otherwise, nothing useful to return, return Empty
 
       else
Index: exp_attr.adb
===================================================================
--- exp_attr.adb	(revision 188445)
+++ exp_attr.adb	(working copy)
@@ -831,12 +831,18 @@ 
 
       --  Attributes related to Ada 2012 iterators (placeholder ???)
 
-      when Attribute_Constant_Indexing    => null;
-      when Attribute_Default_Iterator     => null;
-      when Attribute_Implicit_Dereference => null;
-      when Attribute_Iterator_Element     => null;
-      when Attribute_Variable_Indexing    => null;
+      when Attribute_Constant_Indexing    |
+           Attribute_Default_Iterator     |
+           Attribute_Implicit_Dereference |
+           Attribute_Iterator_Element     |
+           Attribute_Variable_Indexing    => null;
 
+      --  Attributes related to Ada 2012 aspects
+
+      when Attribute_CPU                |
+           Attribute_Dispatching_Domain |
+           Attribute_Interrupt_Priority => null;
+
       ------------
       -- Access --
       ------------
Index: sinfo.adb
===================================================================
--- sinfo.adb	(revision 188449)
+++ sinfo.adb	(working copy)
@@ -1476,33 +1476,6 @@ 
       return Flag17 (N);
    end Has_No_Elaboration_Code;
 
-   function Has_Pragma_CPU
-      (N : Node_Id) return Boolean is
-   begin
-      pragma Assert (False
-        or else NT (N).Nkind = N_Subprogram_Body
-        or else NT (N).Nkind = N_Task_Definition);
-      return Flag14 (N);
-   end Has_Pragma_CPU;
-
-   function Has_Pragma_Dispatching_Domain
-     (N : Node_Id) return Boolean is
-   begin
-      pragma Assert (False
-        or else NT (N).Nkind = N_Task_Definition);
-      return Flag15 (N);
-   end Has_Pragma_Dispatching_Domain;
-
-   function Has_Pragma_Priority
-      (N : Node_Id) return Boolean is
-   begin
-      pragma Assert (False
-        or else NT (N).Nkind = N_Protected_Definition
-        or else NT (N).Nkind = N_Subprogram_Body
-        or else NT (N).Nkind = N_Task_Definition);
-      return Flag6 (N);
-   end Has_Pragma_Priority;
-
    function Has_Pragma_Suppress_All
       (N : Node_Id) return Boolean is
    begin
@@ -1549,22 +1522,6 @@ 
       return Flag5 (N);
    end Has_Storage_Size_Pragma;
 
-   function Has_Task_Info_Pragma
-      (N : Node_Id) return Boolean is
-   begin
-      pragma Assert (False
-        or else NT (N).Nkind = N_Task_Definition);
-      return Flag7 (N);
-   end Has_Task_Info_Pragma;
-
-   function Has_Task_Name_Pragma
-      (N : Node_Id) return Boolean is
-   begin
-      pragma Assert (False
-        or else NT (N).Nkind = N_Task_Definition);
-      return Flag8 (N);
-   end Has_Task_Name_Pragma;
-
    function Has_Wide_Character
       (N : Node_Id) return Boolean is
    begin
@@ -4580,33 +4537,6 @@ 
       Set_Flag17 (N, Val);
    end Set_Has_No_Elaboration_Code;
 
-   procedure Set_Has_Pragma_CPU
-      (N : Node_Id; Val : Boolean := True) is
-   begin
-      pragma Assert (False
-        or else NT (N).Nkind = N_Subprogram_Body
-        or else NT (N).Nkind = N_Task_Definition);
-      Set_Flag14 (N, Val);
-   end Set_Has_Pragma_CPU;
-
-   procedure Set_Has_Pragma_Dispatching_Domain
-      (N : Node_Id; Val : Boolean := True) is
-   begin
-      pragma Assert (False
-        or else NT (N).Nkind = N_Task_Definition);
-      Set_Flag15 (N, Val);
-   end Set_Has_Pragma_Dispatching_Domain;
-
-   procedure Set_Has_Pragma_Priority
-      (N : Node_Id; Val : Boolean := True) is
-   begin
-      pragma Assert (False
-        or else NT (N).Nkind = N_Protected_Definition
-        or else NT (N).Nkind = N_Subprogram_Body
-        or else NT (N).Nkind = N_Task_Definition);
-      Set_Flag6 (N, Val);
-   end Set_Has_Pragma_Priority;
-
    procedure Set_Has_Pragma_Suppress_All
       (N : Node_Id; Val : Boolean := True) is
    begin
@@ -4653,22 +4583,6 @@ 
       Set_Flag5 (N, Val);
    end Set_Has_Storage_Size_Pragma;
 
-   procedure Set_Has_Task_Info_Pragma
-      (N : Node_Id; Val : Boolean := True) is
-   begin
-      pragma Assert (False
-        or else NT (N).Nkind = N_Task_Definition);
-      Set_Flag7 (N, Val);
-   end Set_Has_Task_Info_Pragma;
-
-   procedure Set_Has_Task_Name_Pragma
-      (N : Node_Id; Val : Boolean := True) is
-   begin
-      pragma Assert (False
-        or else NT (N).Nkind = N_Task_Definition);
-      Set_Flag8 (N, Val);
-   end Set_Has_Task_Name_Pragma;
-
    procedure Set_Has_Wide_Character
       (N : Node_Id; Val : Boolean := True) is
    begin
Index: sinfo.ads
===================================================================
--- sinfo.ads	(revision 188449)
+++ sinfo.ads	(working copy)
@@ -1149,16 +1149,6 @@ 
    --    generate elaboration code, and non-preelaborated packages which do
    --    not generate elaboration code.
 
-   --  Has_Pragma_CPU (Flag14-Sem)
-   --    A flag present in N_Subprogram_Body and N_Task_Definition nodes to
-   --    flag the presence of a CPU pragma in the declaration sequence (public
-   --    or private in the task case).
-
-   --  Has_Pragma_Dispatching_Domain (Flag15-Sem)
-   --    A flag present in N_Task_Definition nodes to flag the presence of a
-   --    Dispatching_Domain pragma in the declaration sequence (public or
-   --    private in the task case).
-
    --  Has_Pragma_Suppress_All (Flag14-Sem)
    --    This flag is set in an N_Compilation_Unit node if the Suppress_All
    --    pragma appears anywhere in the unit. This accommodates the rather
@@ -1168,12 +1158,6 @@ 
    --    Suppress (All_Checks) appearing at the start of the configuration
    --    pragmas for the unit.
 
-   --  Has_Pragma_Priority (Flag6-Sem)
-   --    A flag present in N_Subprogram_Body, N_Task_Definition and
-   --    N_Protected_Definition nodes to flag the presence of either a Priority
-   --    or Interrupt_Priority pragma in the declaration sequence (public or
-   --    private in the task and protected cases)
-
    --  Has_Private_View (Flag11-Sem)
    --    A flag present in generic nodes that have an entity, to indicate that
    --    the node has a private type. Used to exchange private and full
@@ -1194,14 +1178,6 @@ 
    --    A flag present in an N_Task_Definition node to flag the presence of a
    --    Storage_Size pragma.
 
-   --  Has_Task_Info_Pragma (Flag7-Sem)
-   --    A flag present in an N_Task_Definition node to flag the presence of a
-   --    Task_Info pragma. Used to detect duplicate pragmas.
-
-   --  Has_Task_Name_Pragma (Flag8-Sem)
-   --    A flag present in N_Task_Definition nodes to flag the presence of a
-   --    Task_Name pragma in the declaration sequence for the task.
-
    --  Has_Wide_Character (Flag11-Sem)
    --    Present in string literals, set if any wide character (i.e. character
    --    code outside the Character range but within Wide_Character range)
@@ -4619,13 +4595,11 @@ 
       --  Acts_As_Spec (Flag4-Sem)
       --  Bad_Is_Detected (Flag15) used only by parser
       --  Do_Storage_Check (Flag17-Sem)
-      --  Has_Pragma_Priority (Flag6-Sem)
       --  Is_Protected_Subprogram_Body (Flag7-Sem)
       --  Is_Entry_Barrier_Function (Flag8-Sem)
       --  Is_Task_Master (Flag5-Sem)
       --  Was_Originally_Stub (Flag13-Sem)
       --  Has_Relative_Deadline_Pragma (Flag9-Sem)
-      --  Has_Pragma_CPU (Flag14-Sem)
 
       -------------------------
       -- Expression Function --
@@ -5109,13 +5083,8 @@ 
       --  Visible_Declarations (List2)
       --  Private_Declarations (List3) (set to No_List if no private part)
       --  End_Label (Node4)
-      --  Has_Pragma_Priority (Flag6-Sem)
       --  Has_Storage_Size_Pragma (Flag5-Sem)
-      --  Has_Task_Info_Pragma (Flag7-Sem)
-      --  Has_Task_Name_Pragma (Flag8-Sem)
       --  Has_Relative_Deadline_Pragma (Flag9-Sem)
-      --  Has_Pragma_CPU (Flag14-Sem)
-      --  Has_Pragma_Dispatching_Domain (Flag15-Sem)
 
       --------------------
       -- 9.1  Task Item --
@@ -5200,7 +5169,6 @@ 
       --  Visible_Declarations (List2)
       --  Private_Declarations (List3) (set to No_List if no private part)
       --  End_Label (Node4)
-      --  Has_Pragma_Priority (Flag6-Sem)
 
       ------------------------------------------
       -- 9.4  Protected Operation Declaration --
@@ -8566,15 +8534,6 @@ 
    function Has_No_Elaboration_Code
      (N : Node_Id) return Boolean;    -- Flag17
 
-   function Has_Pragma_CPU
-     (N : Node_Id) return Boolean;    -- Flag14
-
-   function Has_Pragma_Dispatching_Domain
-     (N : Node_Id) return Boolean;    -- Flag15
-
-   function Has_Pragma_Priority
-     (N : Node_Id) return Boolean;    -- Flag6
-
    function Has_Pragma_Suppress_All
      (N : Node_Id) return Boolean;    -- Flag14
 
@@ -8590,12 +8549,6 @@ 
    function Has_Storage_Size_Pragma
      (N : Node_Id) return Boolean;    -- Flag5
 
-   function Has_Task_Info_Pragma
-     (N : Node_Id) return Boolean;    -- Flag7
-
-   function Has_Task_Name_Pragma
-     (N : Node_Id) return Boolean;    -- Flag8
-
    function Has_Wide_Character
      (N : Node_Id) return Boolean;    -- Flag11
 
@@ -9556,15 +9509,6 @@ 
    procedure Set_Has_No_Elaboration_Code
      (N : Node_Id; Val : Boolean := True);    -- Flag17
 
-   procedure Set_Has_Pragma_CPU
-     (N : Node_Id; Val : Boolean := True);    -- Flag14
-
-   procedure Set_Has_Pragma_Dispatching_Domain
-     (N : Node_Id; Val : Boolean := True);    -- Flag15
-
-   procedure Set_Has_Pragma_Priority
-     (N : Node_Id; Val : Boolean := True);    -- Flag6
-
    procedure Set_Has_Pragma_Suppress_All
      (N : Node_Id; Val : Boolean := True);    -- Flag14
 
@@ -9580,12 +9524,6 @@ 
    procedure Set_Has_Storage_Size_Pragma
      (N : Node_Id; Val : Boolean := True);    -- Flag5
 
-   procedure Set_Has_Task_Info_Pragma
-     (N : Node_Id; Val : Boolean := True);    -- Flag7
-
-   procedure Set_Has_Task_Name_Pragma
-     (N : Node_Id; Val : Boolean := True);    -- Flag8
-
    procedure Set_Has_Wide_Character
      (N : Node_Id; Val : Boolean := True);    -- Flag11
 
@@ -11990,15 +11928,10 @@ 
    pragma Inline (Has_Local_Raise);
    pragma Inline (Has_Self_Reference);
    pragma Inline (Has_No_Elaboration_Code);
-   pragma Inline (Has_Pragma_CPU);
-   pragma Inline (Has_Pragma_Dispatching_Domain);
-   pragma Inline (Has_Pragma_Priority);
    pragma Inline (Has_Pragma_Suppress_All);
    pragma Inline (Has_Private_View);
    pragma Inline (Has_Relative_Deadline_Pragma);
    pragma Inline (Has_Storage_Size_Pragma);
-   pragma Inline (Has_Task_Info_Pragma);
-   pragma Inline (Has_Task_Name_Pragma);
    pragma Inline (Has_Wide_Character);
    pragma Inline (Has_Wide_Wide_Character);
    pragma Inline (Header_Size_Added);
@@ -12316,15 +12249,10 @@ 
    pragma Inline (Set_Has_Local_Raise);
    pragma Inline (Set_Has_Dynamic_Range_Check);
    pragma Inline (Set_Has_No_Elaboration_Code);
-   pragma Inline (Set_Has_Pragma_CPU);
-   pragma Inline (Set_Has_Pragma_Dispatching_Domain);
-   pragma Inline (Set_Has_Pragma_Priority);
    pragma Inline (Set_Has_Pragma_Suppress_All);
    pragma Inline (Set_Has_Private_View);
    pragma Inline (Set_Has_Relative_Deadline_Pragma);
    pragma Inline (Set_Has_Storage_Size_Pragma);
-   pragma Inline (Set_Has_Task_Info_Pragma);
-   pragma Inline (Set_Has_Task_Name_Pragma);
    pragma Inline (Set_Has_Wide_Character);
    pragma Inline (Set_Has_Wide_Wide_Character);
    pragma Inline (Set_Header_Size_Added);
Index: exp_ch9.adb
===================================================================
--- exp_ch9.adb	(revision 188428)
+++ exp_ch9.adb	(working copy)
@@ -395,15 +395,6 @@ 
    --  the scope of Context_Id and Context_Decls is the declarative list of
    --  Context.
 
-   function Find_Task_Or_Protected_Pragma
-     (T : Node_Id;
-      P : Name_Id) return Node_Id;
-   --  Searches the task or protected definition T for the first occurrence
-   --  of the pragma whose name is given by P. The caller has ensured that
-   --  the pragma is present in the task definition. A special case is that
-   --  when P is Name_uPriority, the call will also find Interrupt_Priority.
-   --  ??? Should be implemented with the rep item chain mechanism.
-
    function Index_Object (Spec_Id : Entity_Id) return Entity_Id;
    --  Given a subprogram identifier, return the entity which is associated
    --  with the protection entry index in the Protected_Body_Subprogram or the
@@ -11279,30 +11270,30 @@ 
    --  in the pragma, and is used to override the task stack size otherwise
    --  associated with the task type.
 
-   --  The _Priority field is present only if a Priority or Interrupt_Priority
-   --  pragma appears in the task definition. The expression captures the
-   --  argument that was present in the pragma, and is used to provide the Size
-   --  parameter to the call to Create_Task.
+   --  The _Priority field is always present. It will be filled at the freeze
+   --  point, when the record init proc is built, to capture the expression of
+   --  a Priority pragma, attribute definition clause or aspect specification
+   --  (see Build_Record_Init_Proc in Exp_Ch3).
 
    --  The _Task_Info field is present only if a Task_Info pragma appears in
    --  the task definition. The expression captures the argument that was
    --  present in the pragma, and is used to provide the Task_Image parameter
    --  to the call to Create_Task.
 
-   --  The _CPU field is present only if a CPU pragma appears in the task
-   --  definition. The expression captures the argument that was present in
-   --  the pragma, and is used to provide the CPU parameter to the call to
-   --  Create_Task.
+   --  The _CPU field is always present. It will be filled at the freeze point,
+   --  when the record init proc is built, to capture the expression of a CPU
+   --  pragma, attribute definition clause or aspect specification (see
+   --  Build_Record_Init_Proc in Exp_Ch3).
 
    --  The _Relative_Deadline field is present only if a Relative_Deadline
    --  pragma appears in the task definition. The expression captures the
    --  argument that was present in the pragma, and is used to provide the
    --  Relative_Deadline parameter to the call to Create_Task.
 
-   --  The _Domain field is present only if a Dispatching_Domain pragma or
-   --  aspect appears in the task definition. The expression captures the
-   --  argument that was present in the pragma or aspect, and is used to
-   --  provide the Dispatching_Domain parameter to the call to Create_Task.
+   --  The _Domain field is always present. It will be filled at the freeze
+   --  point, when the record init proc is built, to capture the expression of
+   --  a Dispatching_Domain pragma, attribute definition clause or aspect
+   --  specification (see Build_Record_Init_Proc in Exp_Ch3).
 
    --  When a task is declared, an instance of the task value record is
    --  created. The elaboration of this declaration creates the correct bounds
@@ -11336,21 +11327,65 @@ 
 
    procedure Expand_N_Task_Type_Declaration (N : Node_Id) is
       Loc     : constant Source_Ptr := Sloc (N);
+      TaskId  : constant Entity_Id  := Defining_Identifier (N);
       Tasktyp : constant Entity_Id  := Etype (Defining_Identifier (N));
       Tasknm  : constant Name_Id    := Chars (Tasktyp);
       Taskdef : constant Node_Id    := Task_Definition (N);
 
+      Body_Decl  : Node_Id;
+      Cdecls     : List_Id;
+      Decl_Stack : Node_Id;
+      Elab_Decl  : Node_Id;
+      Ent_Stack  : Entity_Id;
       Proc_Spec  : Node_Id;
       Rec_Decl   : Node_Id;
       Rec_Ent    : Entity_Id;
-      Cdecls     : List_Id;
-      Elab_Decl  : Node_Id;
-      Size_Decl  : Node_Id;
-      Body_Decl  : Node_Id;
+      Size_Decl  : Entity_Id;
       Task_Size  : Node_Id;
-      Ent_Stack  : Entity_Id;
-      Decl_Stack : Node_Id;
 
+      function Get_Relative_Deadline_Pragma (T : Node_Id) return Node_Id;
+      --  Searches the task definition T for the first occurrence of the pragma
+      --  Relative Deadline. The caller has ensured that the pragma is present
+      --  in the task definition. Note that this routine cannot be implemented
+      --  with the Rep Item chain mechanism since Relative_Deadline pragmas are
+      --  not chained because their expansion into a procedure call statement
+      --  would cause a break in the chain.
+
+      ----------------------------------
+      -- Get_Relative_Deadline_Pragma --
+      ----------------------------------
+
+      function Get_Relative_Deadline_Pragma (T : Node_Id) return Node_Id is
+         N : Node_Id;
+
+      begin
+         N := First (Visible_Declarations (T));
+         while Present (N) loop
+            if Nkind (N) = N_Pragma
+              and then Pragma_Name (N) = Name_Relative_Deadline
+            then
+               return N;
+            end if;
+
+            Next (N);
+         end loop;
+
+         N := First (Private_Declarations (T));
+         while Present (N) loop
+            if Nkind (N) = N_Pragma
+              and then Pragma_Name (N) = Name_Relative_Deadline
+            then
+               return N;
+            end if;
+
+            Next (N);
+         end loop;
+
+         raise Program_Error;
+      end Get_Relative_Deadline_Pragma;
+
+   --  Start of processing for Expand_N_Task_Type_Declaration
+
    begin
       --  If already expanded, nothing to do
 
@@ -11378,6 +11413,7 @@ 
           Aliased_Present      => True,
           Object_Definition    => New_Reference_To (Standard_Boolean, Loc),
           Expression           => New_Reference_To (Standard_False, Loc));
+
       Insert_After (N, Elab_Decl);
 
       --  Next create the declaration of the size variable (tasknmZ)
@@ -11392,8 +11428,7 @@ 
           Is_Static_Expression
             (Expression
                (First (Pragma_Argument_Associations
-                         (Find_Task_Or_Protected_Pragma
-                            (Taskdef, Name_Storage_Size)))))
+                         (Get_Rep_Pragma (TaskId, Name_Storage_Size)))))
       then
          Size_Decl :=
            Make_Object_Declaration (Loc,
@@ -11403,8 +11438,8 @@ 
                Convert_To (RTE (RE_Size_Type),
                  Relocate_Node
                    (Expression (First (Pragma_Argument_Associations
-                                         (Find_Task_Or_Protected_Pragma
-                                            (Taskdef, Name_Storage_Size)))))));
+                                         (Get_Rep_Pragma
+                                            (TaskId, Name_Storage_Size)))))));
 
       else
          Size_Decl :=
@@ -11472,8 +11507,7 @@ 
                Expr_N : constant Node_Id :=
                           Expression (First (
                             Pragma_Argument_Associations (
-                              Find_Task_Or_Protected_Pragma
-                                (Taskdef, Name_Storage_Size))));
+                              Get_Rep_Pragma (TaskId, Name_Storage_Size))));
                Etyp   : constant Entity_Id := Etype (Expr_N);
                P      : constant Node_Id   := Parent (Expr_N);
 
@@ -11532,52 +11566,20 @@ 
 
       Collect_Entry_Families (Loc, Cdecls, Size_Decl, Tasktyp);
 
-      --  Add the _Priority component if a Priority pragma is present
+      --  Add the _Priority component with no expression
 
-      if Present (Taskdef) and then Has_Pragma_Priority (Taskdef) then
-         declare
-            Prag : constant Node_Id :=
-                     Find_Task_Or_Protected_Pragma (Taskdef, Name_Priority);
-            Expr : Node_Id;
+      Append_To (Cdecls,
+        Make_Component_Declaration (Loc,
+          Defining_Identifier  =>
+            Make_Defining_Identifier (Loc, Name_uPriority),
+          Component_Definition =>
+            Make_Component_Definition (Loc,
+              Aliased_Present    => False,
+              Subtype_Indication =>
+                New_Reference_To (Standard_Integer, Loc))));
 
-         begin
-            Expr := First (Pragma_Argument_Associations (Prag));
+      --  Add the _Size component if a Storage_Size pragma is present
 
-            if Nkind (Expr) = N_Pragma_Argument_Association then
-               Expr := Expression (Expr);
-            end if;
-
-            Expr := New_Copy_Tree (Expr);
-
-            --  Add conversion to proper type to do range check if required
-            --  Note that for runtime units, we allow out of range interrupt
-            --  priority values to be used in a priority pragma. This is for
-            --  the benefit of some versions of System.Interrupts which use
-            --  a special server task with maximum interrupt priority.
-
-            if Pragma_Name (Prag) = Name_Priority
-              and then not GNAT_Mode
-            then
-               Rewrite (Expr, Convert_To (RTE (RE_Priority), Expr));
-            else
-               Rewrite (Expr, Convert_To (RTE (RE_Any_Priority), Expr));
-            end if;
-
-            Append_To (Cdecls,
-              Make_Component_Declaration (Loc,
-                Defining_Identifier =>
-                  Make_Defining_Identifier (Loc, Name_uPriority),
-                Component_Definition =>
-                  Make_Component_Definition (Loc,
-                    Aliased_Present    => False,
-                    Subtype_Indication => New_Reference_To (Standard_Integer,
-                                                            Loc)),
-                Expression => Expr));
-         end;
-      end if;
-
-      --  Add the _Task_Size component if a Storage_Size pragma is present
-
       if Present (Taskdef)
         and then Has_Storage_Size_Pragma (Taskdef)
       then
@@ -11589,21 +11591,20 @@ 
              Component_Definition =>
                Make_Component_Definition (Loc,
                  Aliased_Present    => False,
-                 Subtype_Indication => New_Reference_To (RTE (RE_Size_Type),
-                                                         Loc)),
+                 Subtype_Indication =>
+                   New_Reference_To (RTE (RE_Size_Type), Loc)),
 
              Expression =>
                Convert_To (RTE (RE_Size_Type),
                  Relocate_Node (
                    Expression (First (
                      Pragma_Argument_Associations (
-                       Find_Task_Or_Protected_Pragma
-                         (Taskdef, Name_Storage_Size))))))));
+                       Get_Rep_Pragma (TaskId, Name_Storage_Size))))))));
       end if;
 
       --  Add the _Task_Info component if a Task_Info pragma is present
 
-      if Present (Taskdef) and then Has_Task_Info_Pragma (Taskdef) then
+      if Has_Rep_Pragma_For_Entity (TaskId, Name_Task_Info) then
          Append_To (Cdecls,
            Make_Component_Declaration (Loc,
              Defining_Identifier =>
@@ -11618,31 +11619,22 @@ 
              Expression => New_Copy (
                Expression (First (
                  Pragma_Argument_Associations (
-                   Find_Task_Or_Protected_Pragma
-                     (Taskdef, Name_Task_Info)))))));
+                   Get_Rep_Pragma_For_Entity (TaskId, Name_Task_Info)))))));
       end if;
 
-      --  Add the _CPU component if a CPU pragma is present
+      --  Add the _CPU component with no expression
 
-      if Present (Taskdef) and then Has_Pragma_CPU (Taskdef) then
-         Append_To (Cdecls,
-           Make_Component_Declaration (Loc,
-             Defining_Identifier =>
-               Make_Defining_Identifier (Loc, Name_uCPU),
+      Append_To (Cdecls,
+        Make_Component_Declaration (Loc,
+          Defining_Identifier =>
+            Make_Defining_Identifier (Loc, Name_uCPU),
 
-             Component_Definition =>
-               Make_Component_Definition (Loc,
-                 Aliased_Present    => False,
-                 Subtype_Indication =>
-                   New_Reference_To (RTE (RE_CPU_Range), Loc)),
+          Component_Definition =>
+            Make_Component_Definition (Loc,
+              Aliased_Present    => False,
+              Subtype_Indication =>
+                New_Reference_To (RTE (RE_CPU_Range), Loc))));
 
-             Expression => New_Copy (
-               Expression (First (
-                 Pragma_Argument_Associations (
-                   Find_Task_Or_Protected_Pragma
-                     (Taskdef, Name_CPU)))))));
-      end if;
-
       --  Add the _Relative_Deadline component if a Relative_Deadline pragma is
       --  present. If we are using a restricted run time this component will
       --  not be added (deadlines are not allowed by the Ravenscar profile).
@@ -11667,19 +11659,14 @@ 
                  Relocate_Node (
                    Expression (First (
                      Pragma_Argument_Associations (
-                       Find_Task_Or_Protected_Pragma
-                         (Taskdef, Name_Relative_Deadline))))))));
+                       Get_Relative_Deadline_Pragma (Taskdef))))))));
       end if;
 
-      --  Add the _Dispatching_Domain component if a Dispatching_Domain pragma
-      --  or aspect is present. If we are using a restricted run time this
-      --  component will not be added (dispatching domains are not allowed by
-      --  the Ravenscar profile).
+      --  Add the _Dispatching_Domain component with no expression. If we are
+      --  using a restricted run time this component will not be added
+      --  (dispatching domains are not allowed by the Ravenscar profile).
 
-      if not Restricted_Profile
-        and then Present (Taskdef)
-        and then Has_Pragma_Dispatching_Domain (Taskdef)
-      then
+      if not Restricted_Profile then
          Append_To (Cdecls,
            Make_Component_Declaration (Loc,
              Defining_Identifier  =>
@@ -11690,16 +11677,7 @@ 
                  Aliased_Present    => False,
                  Subtype_Indication =>
                    New_Reference_To
-                     (RTE (RE_Dispatching_Domain_Access), Loc)),
-
-             Expression           =>
-               Unchecked_Convert_To (RTE (RE_Dispatching_Domain_Access),
-                 Relocate_Node
-                   (Expression
-                      (First
-                         (Pragma_Argument_Associations
-                            (Find_Task_Or_Protected_Pragma
-                               (Taskdef, Name_Dispatching_Domain))))))));
+                     (RTE (RE_Dispatching_Domain_Access), Loc))));
       end if;
 
       Insert_After (Size_Decl, Rec_Decl);
@@ -12750,60 +12728,6 @@ 
       return S;
    end Find_Master_Scope;
 
-   -----------------------------------
-   -- Find_Task_Or_Protected_Pragma --
-   -----------------------------------
-
-   function Find_Task_Or_Protected_Pragma
-     (T : Node_Id;
-      P : Name_Id) return Node_Id
-   is
-      N : Node_Id;
-
-   begin
-      N := First (Visible_Declarations (T));
-      while Present (N) loop
-         if Nkind (N) = N_Pragma then
-            if Pragma_Name (N) = P then
-               return N;
-
-            elsif P = Name_Priority
-              and then Pragma_Name (N) = Name_Interrupt_Priority
-            then
-               return N;
-
-            else
-               Next (N);
-            end if;
-
-         else
-            Next (N);
-         end if;
-      end loop;
-
-      N := First (Private_Declarations (T));
-      while Present (N) loop
-         if Nkind (N) = N_Pragma then
-            if Pragma_Name (N) = P then
-               return N;
-
-            elsif P = Name_Priority
-              and then Pragma_Name (N) = Name_Interrupt_Priority
-            then
-               return N;
-
-            else
-               Next (N);
-            end if;
-
-         else
-            Next (N);
-         end if;
-      end loop;
-
-      raise Program_Error;
-   end Find_Task_Or_Protected_Pragma;
-
    -------------------------------
    -- First_Protected_Operation --
    -------------------------------
@@ -13362,7 +13286,6 @@ 
    is
       Loc         : constant Source_Ptr := Sloc (Protect_Rec);
       P_Arr       : Entity_Id;
-      Pdef        : Node_Id;
       Pdec        : Node_Id;
       Ptyp        : constant Node_Id :=
                       Corresponding_Concurrent_Type (Protect_Rec);
@@ -13392,10 +13315,6 @@ 
          Next (Pdec);
       end loop;
 
-      --  Now we can find the object definition from this declaration
-
-      Pdef := Protected_Definition (Pdec);
-
       --  Build the parameter list for the call. Note that _Init is the name
       --  of the formal for the object to be initialized, which is the task
       --  value record itself.
@@ -13418,24 +13337,34 @@ 
              Attribute_Name => Name_Unchecked_Access));
 
          --  Priority parameter. Set to Unspecified_Priority unless there is a
-         --  priority pragma, in which case we take the value from the pragma,
-         --  or there is an interrupt pragma and no priority pragma, and we
-         --  set the ceiling to Interrupt_Priority'Last, an implementation-
-         --  defined value, see D.3(10).
+         --  priority clause, in which case we take the value from the
+         --  pragma/attribute definition clause, or there is an interrupt
+         --  clause and no priority clause, and we set the ceiling to
+         --  Interrupt_Priority'Last, an implementation defined value,
+         --  see D.3(10).
 
-         if Present (Pdef)
-           and then Has_Pragma_Priority (Pdef)
-         then
+         if Has_Rep_Item (Ptyp, Name_Priority) then
             declare
-               Prio : constant Node_Id :=
-                        Expression
-                          (First
-                             (Pragma_Argument_Associations
-                                (Find_Task_Or_Protected_Pragma
-                                   (Pdef, Name_Priority))));
+               Prio_Clause : constant Node_Id :=
+                               Get_Rep_Item (Ptyp, Name_Priority);
+
+               Prio : Node_Id;
                Temp : Entity_Id;
 
             begin
+               --  Pragma Priority
+
+               if Nkind (Prio_Clause) = N_Pragma then
+                  Prio :=
+                    Expression
+                     (First (Pragma_Argument_Associations (Prio_Clause)));
+
+               --  Attribute definition clause Priority
+
+               else
+                  Prio := Expression (Prio_Clause);
+               end if;
+
                --  If priority is a static expression, then we can duplicate it
                --  with no problem and simply append it to the argument list.
 
@@ -13738,9 +13667,9 @@ 
       Args := New_List;
 
       --  Priority parameter. Set to Unspecified_Priority unless there is a
-      --  priority pragma, in which case we take the value from the pragma.
+      --  priority rep item, in which case we take the value from the rep item.
 
-      if Present (Tdef) and then Has_Pragma_Priority (Tdef) then
+      if Has_Rep_Item (Ttyp, Name_Priority) then
          Append_To (Args,
            Make_Selected_Component (Loc,
              Prefix        => Make_Identifier (Loc, Name_uInit),
@@ -13795,9 +13724,7 @@ 
       --  Task_Info parameter. Set to Unspecified_Task_Info unless there is a
       --  Task_Info pragma, in which case we take the value from the pragma.
 
-      if Present (Tdef)
-        and then Has_Task_Info_Pragma (Tdef)
-      then
+      if Has_Rep_Pragma_For_Entity (Ttyp, Name_Task_Info) then
          Append_To (Args,
            Make_Selected_Component (Loc,
              Prefix        => Make_Identifier (Loc, Name_uInit),
@@ -13808,18 +13735,17 @@ 
            New_Reference_To (RTE (RE_Unspecified_Task_Info), Loc));
       end if;
 
-      --  CPU parameter. Set to Unspecified_CPU unless there is a CPU pragma,
-      --  in which case we take the value from the pragma. The parameter is
+      --  CPU parameter. Set to Unspecified_CPU unless there is a CPU rep item,
+      --  in which case we take the value from the rep item. The parameter is
       --  passed as an Integer because in the case of unspecified CPU the
       --  value is not in the range of CPU_Range.
 
-      if Present (Tdef) and then Has_Pragma_CPU (Tdef) then
+      if Has_Rep_Item (Ttyp, Name_CPU) then
          Append_To (Args,
            Convert_To (Standard_Integer,
              Make_Selected_Component (Loc,
                Prefix        => Make_Identifier (Loc, Name_uInit),
                Selector_Name => Make_Identifier (Loc, Name_uCPU))));
-
       else
          Append_To (Args,
            New_Reference_To (RTE (RE_Unspecified_CPU), Loc));
@@ -13836,7 +13762,9 @@ 
 
          --  Case where pragma Relative_Deadline applies: use given value
 
-         if Present (Tdef) and then Has_Relative_Deadline_Pragma (Tdef) then
+         if Present (Tdef)
+           and then Has_Relative_Deadline_Pragma (Tdef)
+         then
             Append_To (Args,
               Make_Selected_Component (Loc,
                 Prefix        =>
@@ -13851,18 +13779,17 @@ 
               New_Reference_To (RTE (RE_Time_Span_Zero), Loc));
          end if;
 
-         --  Dispatching_Domain parameter. If no Dispatching_Domain pragma or
-         --  aspect is present, then the dispatching domain is null. If a
-         --  pragma or aspect is present, then the dispatching domain is taken
-         --  from the _Dispatching_Domain field of the task value record,
-         --  which was set from the pragma value. Note that this parameter
-         --  must not be generated for the restricted profiles since Ravenscar
-         --  does not allow dispatching domains.
+         --  Dispatching_Domain parameter. If no Dispatching_Domain rep item is
+         --  present, then the dispatching domain is null. If a rep item is
+         --  present, then the dispatching domain is taken from the
+         --  _Dispatching_Domain field of the task value record, which was set
+         --  from the rep item value. Note that this parameter must not be
+         --  generated for the restricted profiles since Ravenscar does not
+         --  allow dispatching domains.
 
-         --  Case where pragma or aspect Dispatching_Domain applies: use given
-         --  value.
+         --  Case where Dispatching_Domain rep item applies: use given value
 
-         if Present (Tdef) and then Has_Pragma_Dispatching_Domain (Tdef) then
+         if Has_Rep_Item (Ttyp, Name_Dispatching_Domain) then
             Append_To (Args,
               Make_Selected_Component (Loc,
                 Prefix        =>
@@ -13980,18 +13907,16 @@ 
       --  init call unless there is a Task_Name pragma, in which case we take
       --  the value from the pragma.
 
-      if Present (Tdef)
-        and then Has_Task_Name_Pragma (Tdef)
-      then
+      if Has_Rep_Pragma_For_Entity (Ttyp, Name_Task_Name) then
          --  Copy expression in full, because it may be dynamic and have
          --  side effects.
 
          Append_To (Args,
            New_Copy_Tree
-             (Expression (First
-                           (Pragma_Argument_Associations
-                             (Find_Task_Or_Protected_Pragma
-                               (Tdef, Name_Task_Name))))));
+             (Expression
+               (First
+                 (Pragma_Argument_Associations
+                   (Get_Rep_Pragma_For_Entity (Ttyp, Name_Task_Name))))));
 
       else
          Append_To (Args, Make_Identifier (Loc, Name_uTask_Name));
Index: sem_ch9.adb
===================================================================
--- sem_ch9.adb	(revision 188428)
+++ sem_ch9.adb	(working copy)
@@ -111,10 +111,6 @@ 
    --  Find entity in corresponding task or protected declaration. Use full
    --  view if first declaration was for an incomplete type.
 
-   procedure Install_Declarations (Spec : Entity_Id);
-   --  Utility to make visible in corresponding body the entities defined in
-   --  task, protected type declaration, or entry declaration.
-
    -------------------------------------
    -- Allows_Lock_Free_Implementation --
    -------------------------------------
@@ -2983,4 +2979,91 @@ 
       end loop;
    end Install_Declarations;
 
+   ---------------------------
+   -- Install_Discriminants --
+   ---------------------------
+
+   procedure Install_Discriminants (E : Entity_Id) is
+      Disc : Entity_Id;
+      Prev : Entity_Id;
+   begin
+      Disc := First_Discriminant (E);
+      while Present (Disc) loop
+         Prev := Current_Entity (Disc);
+         Set_Current_Entity (Disc);
+         Set_Is_Immediately_Visible (Disc);
+         Set_Homonym (Disc, Prev);
+         Next_Discriminant (Disc);
+      end loop;
+   end Install_Discriminants;
+
+   ------------------------------------------
+   -- Push_Scope_And_Install_Discriminants --
+   ------------------------------------------
+
+   procedure Push_Scope_And_Install_Discriminants (E : Entity_Id) is
+   begin
+      if Has_Discriminants (E) then
+         Push_Scope (E);
+         Install_Discriminants (E);
+      end if;
+   end Push_Scope_And_Install_Discriminants;
+
+   -----------------------------
+   -- Uninstall_Discriminants --
+   -----------------------------
+
+   procedure Uninstall_Discriminants (E : Entity_Id) is
+      Disc  : Entity_Id;
+      Prev  : Entity_Id;
+      Outer : Entity_Id;
+
+   begin
+      Disc := First_Discriminant (E);
+      while Present (Disc) loop
+         if Disc /= Current_Entity (Disc) then
+            Prev := Current_Entity (Disc);
+            while Present (Prev)
+              and then Present (Homonym (Prev))
+              and then Homonym (Prev) /= Disc
+            loop
+               Prev := Homonym (Prev);
+            end loop;
+         else
+            Prev := Empty;
+         end if;
+
+         Set_Is_Immediately_Visible (Disc, False);
+
+         Outer := Homonym (Disc);
+         while Present (Outer) and then Scope (Outer) = E loop
+            Outer := Homonym (Outer);
+         end loop;
+
+         --  Reset homonym link of other entities, but do not modify link
+         --  between entities in current scope, so that the back-end can have
+         --  a proper count of local overloadings.
+
+         if No (Prev) then
+            Set_Name_Entity_Id (Chars (Disc), Outer);
+
+         elsif Scope (Prev) /= Scope (Disc) then
+            Set_Homonym (Prev,  Outer);
+         end if;
+
+         Next_Discriminant (Disc);
+      end loop;
+   end Uninstall_Discriminants;
+
+   -------------------------------------------
+   -- Uninstall_Discriminants_And_Pop_Scope --
+   -------------------------------------------
+
+   procedure Uninstall_Discriminants_And_Pop_Scope (E : Entity_Id) is
+   begin
+      if Has_Discriminants (E) then
+         Uninstall_Discriminants (E);
+         Pop_Scope;
+      end if;
+   end Uninstall_Discriminants_And_Pop_Scope;
 end Sem_Ch9;
Index: sem_ch9.ads
===================================================================
--- sem_ch9.ads	(revision 188428)
+++ sem_ch9.ads	(working copy)
@@ -54,6 +54,25 @@ 
    procedure Analyze_Timed_Entry_Call                   (N : Node_Id);
    procedure Analyze_Triggering_Alternative             (N : Node_Id);
 
+   procedure Install_Declarations (Spec : Entity_Id);
+   --  Utility to make visible in corresponding body the entities defined in
+   --  task, protected type declaration, or entry declaration.
+
+   procedure Install_Discriminants (E : Entity_Id);
+   --  Utility to make visible the discriminants of type entity E
+
+   procedure Push_Scope_And_Install_Discriminants (E : Entity_Id);
+   --  Utility that pushes the scope E and makes visible the discriminants of
+   --  type entity E if E has discriminants.
+
+   procedure Uninstall_Discriminants (E : Entity_Id);
+   --  Utility that removes the visibility to the discriminants of type entity
+   --  E.
+
+   procedure Uninstall_Discriminants_And_Pop_Scope (E : Entity_Id);
+   --  Utility that removes the visibility to the discriminants of type entity
+   --  E and pop the scope stack if E has discriminants.
+
    ------------------------------
    -- Lock Free Data Structure --
    ------------------------------
Index: einfo.adb
===================================================================
--- einfo.adb	(revision 188428)
+++ einfo.adb	(working copy)
@@ -35,6 +35,7 @@ 
 with Atree;    use Atree;
 with Nlists;   use Nlists;
 with Output;   use Output;
+with Sem_Aux;  use Sem_Aux;
 with Sinfo;    use Sinfo;
 with Stand;    use Stand;
 
@@ -283,7 +284,6 @@ 
    --    Checks_May_Be_Suppressed        Flag31
    --    Kill_Elaboration_Checks         Flag32
    --    Kill_Range_Checks               Flag33
-   --    Kill_Tag_Checks                 Flag34
    --    Is_Class_Wide_Equivalent_Type   Flag35
    --    Referenced_As_LHS               Flag36
    --    Is_Known_Non_Null               Flag37
@@ -526,6 +526,7 @@ 
    --    Has_Anonymous_Master            Flag253
    --    Is_Implementation_Defined       Flag254
 
+   --    (unused)                        Flag34
    --    (unused)                        Flag201
 
    -----------------------
@@ -2210,11 +2211,6 @@ 
       return Flag33 (Id);
    end Kill_Range_Checks;
 
-   function Kill_Tag_Checks (Id : E) return B is
-   begin
-      return Flag34 (Id);
-   end Kill_Tag_Checks;
-
    function Known_To_Have_Preelab_Init (Id : E) return B is
    begin
       pragma Assert (Is_Type (Id));
@@ -2781,7 +2777,7 @@ 
    function Universal_Aliasing (Id : E) return B is
    begin
       pragma Assert (Is_Type (Id));
-      return Flag216 (Base_Type (Id));
+      return Flag216 (Implementation_Base_Type (Id));
    end Universal_Aliasing;
 
    function Unset_Reference (Id : E) return N is
@@ -4760,11 +4756,6 @@ 
       Set_Flag33 (Id, V);
    end Set_Kill_Range_Checks;
 
-   procedure Set_Kill_Tag_Checks (Id : E; V : B := True) is
-   begin
-      Set_Flag34 (Id, V);
-   end Set_Kill_Tag_Checks;
-
    procedure Set_Known_To_Have_Preelab_Init (Id : E; V : B := True) is
    begin
       pragma Assert (Is_Type (Id));
@@ -5988,6 +5979,44 @@ 
       return Empty;
    end Get_Attribute_Definition_Clause;
 
+   ------------------
+   -- Get_Rep_Item --
+   ------------------
+
+   function Get_Rep_Item
+     (E   : Entity_Id;
+      Nam : Name_Id) return Node_Id
+   is
+      N     : Node_Id;
+      N_Nam : Name_Id := No_Name;
+
+   begin
+      N := First_Rep_Item (E);
+
+      while Present (N) loop
+         if Nkind (N) = N_Pragma then
+            N_Nam := Pragma_Name (N);
+
+         elsif Nkind (N) = N_Attribute_Definition_Clause then
+            N_Nam := Chars (N);
+
+         elsif Nkind (N) = N_Aspect_Specification then
+            N_Nam := Chars (Identifier (N));
+         end if;
+
+         if N_Nam = Nam
+           or else (Nam = Name_Priority
+                     and then N_Nam = Name_Interrupt_Priority)
+         then
+            return N;
+         end if;
+
+         Next_Rep_Item (N);
+      end loop;
+
+      return Empty;
+   end Get_Rep_Item;
+
    -------------------
    -- Get_Full_View --
    -------------------
@@ -6036,28 +6065,47 @@ 
      (E   : Entity_Id;
       Nam : Name_Id) return Node_Id
    is
+      Par : constant Entity_Id := Nearest_Ancestor (E);
+      --  In case of a derived type or subtype, this node represents the parent
+      --  type of type E.
+
       N   : Node_Id;
-      Arg : Node_Id;
 
    begin
       N := First_Rep_Item (E);
       while Present (N) loop
-         if Nkind (N) = N_Pragma and then Pragma_Name (N) = Nam then
-            Arg := Get_Pragma_Arg (First (Pragma_Argument_Associations (N)));
+         if Nkind (N) = N_Pragma
+           and then
+             (Pragma_Name (N) = Nam
+               or else (Nam = Name_Priority
+                         and then Pragma_Name (N) = Name_Interrupt_Priority))
+         then
+            --  Return N if the pragma doesn't appear in the Rep_Item chain of
+            --  the parent.
 
-            if Is_Entity_Name (Arg) and then Entity (Arg) = E then
+            if No (Par) then
                return N;
+
+            elsif not Present_In_Rep_Item (Par, N) then
+               return N;
             end if;
 
          elsif Nkind (N) = N_Attribute_Definition_Clause
-           and then Chars (N) = Nam
            and then Entity (N) = E
+           and then
+             (Chars (N) = Nam
+                or else (Nam = Name_Priority
+                          and then Chars (N) = Name_Interrupt_Priority))
          then
             return N;
 
          elsif Nkind (N) = N_Aspect_Specification
-           and then Chars (Identifier (N)) = Nam
            and then Entity (N) = E
+           and then
+             (Chars (Identifier (N)) = Nam
+                or else (Nam = Name_Priority
+                          and then Chars (Identifier (N)) =
+                                     Name_Interrupt_Priority))
          then
             return N;
          end if;
@@ -6078,7 +6126,12 @@ 
    begin
       N := First_Rep_Item (E);
       while Present (N) loop
-         if Nkind (N) = N_Pragma and then Pragma_Name (N) = Nam then
+         if Nkind (N) = N_Pragma
+           and then
+             (Pragma_Name (N) = Nam
+               or else (Nam = Name_Interrupt_Priority
+                         and then Pragma_Name (N) = Name_Priority))
+         then
             return N;
          end if;
 
@@ -6088,6 +6141,30 @@ 
       return Empty;
    end Get_Rep_Pragma;
 
+   -------------------------------
+   -- Get_Rep_Pragma_For_Entity --
+   -------------------------------
+
+   function Get_Rep_Pragma_For_Entity
+     (E : Entity_Id; Nam : Name_Id) return Node_Id
+   is
+      Par : constant Entity_Id := Nearest_Ancestor (E);
+      --  In case of a derived type or subtype, this node represents the parent
+      --  type of type E.
+
+      Prag : constant Node_Id := Get_Rep_Pragma (E, Nam);
+
+   begin
+      if No (Par) then
+         return Prag;
+
+      elsif not Present_In_Rep_Item (Par, Prag) then
+         return Prag;
+      end if;
+
+      return Empty;
+   end Get_Rep_Pragma_For_Entity;
+
    ------------------------
    -- Has_Attach_Handler --
    ------------------------
@@ -6112,18 +6189,6 @@ 
       return False;
    end Has_Attach_Handler;
 
-   -------------------------------------
-   -- Has_Attribute_Definition_Clause --
-   -------------------------------------
-
-   function Has_Attribute_Definition_Clause
-     (E  : Entity_Id;
-      Id : Attribute_Id) return Boolean
-   is
-   begin
-      return Present (Get_Attribute_Definition_Clause (E, Id));
-   end Has_Attribute_Definition_Clause;
-
    -----------------
    -- Has_Entries --
    -----------------
@@ -6185,6 +6250,15 @@ 
       return False;
    end Has_Interrupt_Handler;
 
+   ------------------
+   -- Has_Rep_Item --
+   ------------------
+
+   function Has_Rep_Item (E : Entity_Id; Nam : Name_Id) return Boolean is
+   begin
+      return Present (Get_Rep_Item (E, Nam));
+   end Has_Rep_Item;
+
    --------------------
    -- Has_Rep_Pragma --
    --------------------
@@ -6194,6 +6268,17 @@ 
       return Present (Get_Rep_Pragma (E, Nam));
    end Has_Rep_Pragma;
 
+   -------------------------------
+   -- Has_Rep_Pragma_For_Entity --
+   -------------------------------
+
+   function Has_Rep_Pragma_For_Entity
+     (E : Entity_Id; Nam : Name_Id) return Boolean
+   is
+   begin
+      return Present (Get_Rep_Pragma_For_Entity (E, Nam));
+   end Has_Rep_Pragma_For_Entity;
+
    --------------------
    -- Has_Unmodified --
    --------------------
@@ -6972,6 +7057,27 @@ 
       return Ekind (Id);
    end Parameter_Mode;
 
+   -------------------------
+   -- Present_In_Rep_Item --
+   -------------------------
+
+   function Present_In_Rep_Item (E : Entity_Id; N : Node_Id) return Boolean is
+      Ritem : Node_Id;
+
+   begin
+      Ritem := First_Rep_Item (E);
+
+      while Present (Ritem) loop
+         if Ritem = N then
+            return True;
+         end if;
+
+         Next_Rep_Item (Ritem);
+      end loop;
+
+      return False;
+   end Present_In_Rep_Item;
+
    --------------------------
    -- Primitive_Operations --
    --------------------------
@@ -7654,7 +7760,6 @@ 
       W ("Itype_Printed",                   Flag202 (Id));
       W ("Kill_Elaboration_Checks",         Flag32  (Id));
       W ("Kill_Range_Checks",               Flag33  (Id));
-      W ("Kill_Tag_Checks",                 Flag34  (Id));
       W ("Known_To_Have_Preelab_Init",      Flag207 (Id));
       W ("Low_Bound_Tested",                Flag205 (Id));
       W ("Machine_Radix_10",                Flag84  (Id));
Index: einfo.ads
===================================================================
--- einfo.ads	(revision 188444)
+++ einfo.ads	(working copy)
@@ -729,11 +729,11 @@ 
 --       declared the entity. Normally this is just the Parent of the entity.
 --       One exception arises with child units, where the parent of the entity
 --       is a selected component/defining program unit name. Another exception
---       is that if the entity is an incomplete type that has been completed,
---       then we obtain the declaration node denoted by the full type, i.e. the
---       full type declaration node. Also note that for subprograms, this
---       returns the {function,procedure}_specification, not the subprogram_
---       declaration.
+--       is that if the entity is an incomplete type that has been completed or
+--       a private type, then we obtain the declaration node denoted by the
+--       full type, i.e. the full type declaration node. Also note that for
+--       subprograms, this returns the {function,procedure}_specification, not
+--       the subprogram_declaration.
 
 --    Default_Aspect_Component_Value (Node19)
 --       Present in array types. Holds the static value specified in a
@@ -2907,13 +2907,6 @@ 
 --       This is currently only used in one odd situation in Sem_Ch3 for
 --       record types, and it would be good to get rid of it???
 
---    Kill_Tag_Checks (Flag34)
---       Present in all entities. Set by the expander to kill elaboration
---       checks which are known not to be needed. Equivalent in effect to
---       the use of pragma Suppress (Tag_Checks) for that entity except
---       that the result is permanent and cannot be undone by a subsequent
---       pragma Unsuppress.
-
 --    Known_To_Have_Preelab_Init (Flag207)
 --       Present in all type and subtype entities. If set, then the type is
 --       known to have preelaborable initialization. In the case of a partial
@@ -4852,7 +4845,6 @@ 
    --    Is_VMS_Exception                    (Flag133)
    --    Kill_Elaboration_Checks             (Flag32)
    --    Kill_Range_Checks                   (Flag33)
-   --    Kill_Tag_Checks                     (Flag34)
    --    Low_Bound_Tested                    (Flag205)
    --    Materialize_Entity                  (Flag168)
    --    Needs_Debug_Info                    (Flag147)
@@ -6310,7 +6302,6 @@ 
    function Itype_Printed                       (Id : E) return B;
    function Kill_Elaboration_Checks             (Id : E) return B;
    function Kill_Range_Checks                   (Id : E) return B;
-   function Kill_Tag_Checks                     (Id : E) return B;
    function Known_To_Have_Preelab_Init          (Id : E) return B;
    function Last_Assignment                     (Id : E) return N;
    function Last_Entity                         (Id : E) return E;
@@ -6907,7 +6898,6 @@ 
    procedure Set_Itype_Printed                   (Id : E; V : B := True);
    procedure Set_Kill_Elaboration_Checks         (Id : E; V : B := True);
    procedure Set_Kill_Range_Checks               (Id : E; V : B := True);
-   procedure Set_Kill_Tag_Checks                 (Id : E; V : B := True);
    procedure Set_Known_To_Have_Preelab_Init      (Id : E; V : B := True);
    procedure Set_Last_Assignment                 (Id : E; V : N);
    procedure Set_Last_Entity                     (Id : E; V : E);
@@ -7200,15 +7190,25 @@ 
    --  value returned is the N_Attribute_Definition_Clause node, otherwise
    --  Empty is returned.
 
+   function Get_Rep_Item
+     (E   : Entity_Id;
+      Nam : Name_Id) return Node_Id;
+   --  Searches the Rep_Item chain for a given entity E, for the first
+   --  occurrence of a rep item (pragma, attribute definition clause, or aspect
+   --  specification) whose name matches the given name. If one is found, it is
+   --  returned, otherwise Empty is returned. A special case is that when Nam
+   --  is Name_Priority, the call will also find Interrupt_Priority.
+
    function Get_Rep_Item_For_Entity
      (E   : Entity_Id;
       Nam : Name_Id) return Node_Id;
    --  Searches the Rep_Item chain for a given entity E, for an instance of a
    --  rep item (pragma, attribute definition clause, or aspect specification)
    --  whose name matches the given name. If one is found, it is returned,
-   --  otherwise Empty is returned. Unlike the other Get routines for the
-   --  Rep_Item chain, this only returns items whose entity matches E (it
-   --  does not return items from the parent chain).
+   --  otherwise Empty is returned. This routine only returns items whose
+   --  entity matches E (it does not return items from the parent chain). A
+   --  special case is that when Nam is Name_Priority, the call will also find
+   --  Interrupt_Priority.
 
    function Get_Record_Representation_Clause (E : Entity_Id) return Node_Id;
    --  Searches the Rep_Item chain for a given entity E, for a record
@@ -7218,20 +7218,34 @@ 
    function Get_Rep_Pragma (E : Entity_Id; Nam : Name_Id) return Node_Id;
    --  Searches the Rep_Item chain for the given entity E, for an instance
    --  a representation pragma with the given name Nam. If found then the
-   --  value returned is the N_Pragma node, otherwise Empty is returned.
+   --  value returned is the N_Pragma node, otherwise Empty is returned. A
+   --  special case is that when Nam is Name_Priority, the call will also find
+   --  Interrupt_Priority.
 
+   function Get_Rep_Pragma_For_Entity
+     (E : Entity_Id; Nam : Name_Id) return Node_Id;
+   --  Same as Get_Rep_Pragma except that this routine returns a pragma that
+   --  doesn't appear in the Rep Item chain of the parent of E (if any).
+
+   function Has_Rep_Item (E : Entity_Id; Nam : Name_Id) return Boolean;
+   --  Searches the Rep_Item chain for the given entity E, for an instance
+   --  of rep item with the given name Nam. If found then True is returned,
+   --  otherwise False indicates that no matching entry was found.
+
    function Has_Rep_Pragma (E : Entity_Id; Nam : Name_Id) return Boolean;
    --  Searches the Rep_Item chain for the given entity E, for an instance
    --  of representation pragma with the given name Nam. If found then True
    --  is returned, otherwise False indicates that no matching entry was found.
 
-   function Has_Attribute_Definition_Clause
-     (E  : Entity_Id;
-      Id : Attribute_Id) return Boolean;
-   --  Searches the Rep_Item chain for a given entity E, for an instance of an
-   --  attribute definition clause with the given attribute Id. If found, True
-   --  is returned, otherwise False indicates that no matching entry was found.
+   function Has_Rep_Pragma_For_Entity
+     (E : Entity_Id; Nam : Name_Id) return Boolean;
+   --  Same as Has_Rep_Pragma except that this routine doesn't return True if
+   --  the representation pragma is also present in the Rep Item chain of the
+   --  parent of E (if any).
 
+   function Present_In_Rep_Item (E : Entity_Id; N : Node_Id) return Boolean;
+   --  Return True if N is present in the Rep_Item chain for a given entity E
+
    procedure Record_Rep_Item (E : Entity_Id; N : Node_Id);
    --  N is the node for a representation pragma, representation clause, an
    --  attribute definition clause, or an aspect specification that applies to
@@ -7650,7 +7664,6 @@ 
    pragma Inline (Itype_Printed);
    pragma Inline (Kill_Elaboration_Checks);
    pragma Inline (Kill_Range_Checks);
-   pragma Inline (Kill_Tag_Checks);
    pragma Inline (Known_To_Have_Preelab_Init);
    pragma Inline (Last_Assignment);
    pragma Inline (Last_Entity);
@@ -8056,7 +8069,6 @@ 
    pragma Inline (Set_Itype_Printed);
    pragma Inline (Set_Kill_Elaboration_Checks);
    pragma Inline (Set_Kill_Range_Checks);
-   pragma Inline (Set_Kill_Tag_Checks);
    pragma Inline (Set_Known_To_Have_Preelab_Init);
    pragma Inline (Set_Last_Assignment);
    pragma Inline (Set_Last_Entity);
Index: checks.adb
===================================================================
--- checks.adb	(revision 188428)
+++ checks.adb	(working copy)
@@ -7378,12 +7378,10 @@ 
 
    function Tag_Checks_Suppressed (E : Entity_Id) return Boolean is
    begin
-      if Present (E) then
-         if Kill_Tag_Checks (E) then
-            return True;
-         elsif Checks_May_Be_Suppressed (E) then
-            return Is_Check_Suppressed (E, Tag_Check);
-         end if;
+      if Present (E)
+        and then Checks_May_Be_Suppressed (E)
+      then
+         return Is_Check_Suppressed (E, Tag_Check);
       end if;
 
       return Scope_Suppress (Tag_Check);
Index: sem_prag.adb
===================================================================
--- sem_prag.adb	(revision 188441)
+++ sem_prag.adb	(working copy)
@@ -571,10 +571,9 @@ 
       --  error message for bad placement is given.
 
       procedure Check_Duplicate_Pragma (E : Entity_Id);
-      --  Check if a pragma of the same name as the current pragma is already
+      --  Check if a rep item of the same name as the current pragma is already
       --  chained as a rep pragma to the given entity. If so give a message
       --  about the duplicate, and then raise Pragma_Exit so does not return.
-      --  Also checks for delayed aspect specification node in the chain.
 
       procedure Check_Duplicated_Export_Name (Nam : Node_Id);
       --  Nam is an N_String_Literal node containing the external name set by
@@ -1598,7 +1597,8 @@ 
       ----------------------------
 
       procedure Check_Duplicate_Pragma (E : Entity_Id) is
-         P : Node_Id;
+         Id : Entity_Id := E;
+         P  : Node_Id;
 
       begin
          --  Nothing to do if this pragma comes from an aspect specification,
@@ -1610,7 +1610,8 @@ 
          end if;
 
          --  Otherwise current pragma may duplicate previous pragma or a
-         --  previously given aspect specification for the same pragma.
+         --  previously given aspect specification or attribute definition
+         --  clause for the same pragma.
 
          P := Get_Rep_Item_For_Entity (E, Pragma_Name (N));
 
@@ -1618,12 +1619,25 @@ 
             Error_Msg_Name_1 := Pragma_Name (N);
             Error_Msg_Sloc := Sloc (P);
 
+            --  For a single protected or a single task object, the error is
+            --  issued on the original entity.
+
+            if Ekind (Id) = E_Task_Type
+              or else Ekind (Id) = E_Protected_Type
+            then
+               Id := Defining_Identifier (Original_Node (Parent (Id)));
+            end if;
+
             if Nkind (P) = N_Aspect_Specification
               or else From_Aspect_Specification (P)
             then
-               Error_Msg_NE ("aspect% for & previously given#", N, E);
+               Error_Msg_NE ("aspect% for & previously given#", N, Id);
+
+            elsif Nkind (P) = N_Pragma then
+               Error_Msg_NE ("pragma% for & duplicates pragma#", N, Id);
+
             else
-               Error_Msg_NE ("pragma% for & duplicates pragma#", N, E);
+               Error_Msg_NE ("pragma% for & duplicates clause#", N, Id);
             end if;
 
             raise Pragma_Exit;
@@ -2917,7 +2931,7 @@ 
       end Pragma_Misplaced;
 
       ------------------------------------
-      -- Process Atomic_Shared_Volatile --
+      -- Process_Atomic_Shared_Volatile --
       ------------------------------------
 
       procedure Process_Atomic_Shared_Volatile is
@@ -6597,6 +6611,7 @@ 
                end if;
 
                Set_Is_Ada_2005_Only (Entity (E_Id));
+               Record_Rep_Item (Entity (E_Id), N);
 
             else
                Check_Arg_Count (0);
@@ -6644,6 +6659,7 @@ 
                end if;
 
                Set_Is_Ada_2012_Only (Entity (E_Id));
+               Record_Rep_Item (Entity (E_Id), N);
 
             else
                Check_Arg_Count (0);
@@ -7149,6 +7165,7 @@ 
                Error_Pragma_Arg ("inappropriate entity for pragma%", Arg1);
             end if;
          end Atomic_Components;
+
          --------------------
          -- Attach_Handler --
          --------------------
@@ -7931,6 +7948,7 @@ 
          when Pragma_CPU => CPU : declare
             P   : constant Node_Id := Parent (N);
             Arg : Node_Id;
+            Ent : Entity_Id;
 
          begin
             Ada_2012_Pragma;
@@ -7945,6 +7963,12 @@ 
                Arg := Get_Pragma_Arg (Arg1);
                Analyze_And_Resolve (Arg, Any_Integer);
 
+               Ent := Defining_Unit_Name (Specification (P));
+
+               if Nkind (Ent) = N_Defining_Program_Unit_Name then
+                  Ent := Defining_Identifier (Ent);
+               end if;
+
                --  Must be static
 
                if not Is_Static_Expression (Arg) then
@@ -7984,6 +8008,7 @@ 
 
             elsif Nkind (P) = N_Task_Definition then
                Arg := Get_Pragma_Arg (Arg1);
+               Ent := Defining_Identifier (Parent (P));
 
                --  The expression must be analyzed in the special manner
                --  described in "Handling of Default and Per-Object
@@ -7997,15 +8022,12 @@ 
                Pragma_Misplaced;
             end if;
 
-            if Has_Pragma_CPU (P) then
-               Error_Pragma ("duplicate pragma% not allowed");
-            else
-               Set_Has_Pragma_CPU (P, True);
+            --  Check duplicate pragma before we chain the pragma in the Rep
+            --  Item chain of Ent.
 
-               if Nkind (P) = N_Task_Definition then
-                  Record_Rep_Item (Defining_Identifier (Parent (P)), N);
-               end if;
-            end if;
+            Check_Duplicate_Pragma (Ent);
+
+            Record_Rep_Item (Ent, N);
          end CPU;
 
          -----------
@@ -8249,6 +8271,8 @@ 
                     or else Ekind (E) = E_Exception
                   then
                      Set_Discard_Names (E);
+                     Record_Rep_Item (E, N);
+
                   else
                      Error_Pragma_Arg
                        ("inappropriate entity for pragma%", Arg1);
@@ -8267,6 +8291,7 @@ 
          when Pragma_Dispatching_Domain => Dispatching_Domain : declare
             P   : constant Node_Id := Parent (N);
             Arg : Node_Id;
+            Ent : Entity_Id;
 
          begin
             Ada_2012_Pragma;
@@ -8282,6 +8307,7 @@ 
 
             if Nkind (P) = N_Task_Definition then
                Arg := Get_Pragma_Arg (Arg1);
+               Ent := Defining_Identifier (Parent (P));
 
                --  The expression must be analyzed in the special manner
                --  described in "Handling of Default and Per-Object
@@ -8289,21 +8315,18 @@ 
 
                Preanalyze_Spec_Expression (Arg, RTE (RE_Dispatching_Domain));
 
+               --  Check duplicate pragma before we chain the pragma in the Rep
+               --  Item chain of Ent.
+
+               Check_Duplicate_Pragma (Ent);
+
+               Record_Rep_Item (Ent, N);
+
             --  Anything else is incorrect
 
             else
                Pragma_Misplaced;
             end if;
-
-            if Has_Pragma_Dispatching_Domain (P) then
-               Error_Pragma ("duplicate pragma% not allowed");
-            else
-               Set_Has_Pragma_Dispatching_Domain (P, True);
-
-               if Nkind (P) = N_Task_Definition then
-                  Record_Rep_Item (Defining_Identifier (Parent (P)), N);
-               end if;
-            end if;
          end Dispatching_Domain;
 
          ---------------
@@ -10235,6 +10258,7 @@ 
          when Pragma_Interrupt_Priority => Interrupt_Priority : declare
             P   : constant Node_Id := Parent (N);
             Arg : Node_Id;
+            Ent : Entity_Id;
 
          begin
             Check_Ada_83_Warning;
@@ -10255,12 +10279,15 @@ 
                Pragma_Misplaced;
                return;
 
-            elsif Has_Pragma_Priority (P) then
-               Error_Pragma ("duplicate pragma% not allowed");
+            else
+               Ent := Defining_Identifier (Parent (P));
 
-            else
-               Set_Has_Pragma_Priority (P, True);
-               Record_Rep_Item (Defining_Identifier (Parent (P)), N);
+               --  Check duplicate pragma before we chain the pragma in the Rep
+               --  Item chain of Ent.
+
+               Check_Duplicate_Pragma (Ent);
+
+               Record_Rep_Item (Ent, N);
             end if;
          end Interrupt_Priority;
 
@@ -12295,6 +12322,7 @@ 
          when Pragma_Priority => Priority : declare
             P   : constant Node_Id := Parent (N);
             Arg : Node_Id;
+            Ent : Entity_Id;
 
          begin
             Check_No_Identifiers;
@@ -12305,6 +12333,12 @@ 
             if Nkind (P) = N_Subprogram_Body then
                Check_In_Main_Program;
 
+               Ent := Defining_Unit_Name (Specification (P));
+
+               if Nkind (Ent) = N_Defining_Program_Unit_Name then
+                  Ent := Defining_Identifier (Ent);
+               end if;
+
                Arg := Get_Pragma_Arg (Arg1);
                Analyze_And_Resolve (Arg, Standard_Integer);
 
@@ -12356,6 +12390,7 @@ 
 
             elsif Nkind_In (P, N_Protected_Definition, N_Task_Definition) then
                Arg := Get_Pragma_Arg (Arg1);
+               Ent := Defining_Identifier (Parent (P));
 
                --  The expression must be analyzed in the special manner
                --  described in "Handling of Default and Per-Object
@@ -12373,16 +12408,12 @@ 
                Pragma_Misplaced;
             end if;
 
-            if Has_Pragma_Priority (P) then
-               Error_Pragma ("duplicate pragma% not allowed");
-            else
-               Set_Has_Pragma_Priority (P, True);
+            --  Check duplicate pragma before we chain the pragma in the Rep
+            --  Item chain of Ent.
 
-               if Nkind_In (P, N_Protected_Definition, N_Task_Definition) then
-                  Record_Rep_Item (Defining_Identifier (Parent (P)), N);
-                  --  exp_ch9 should use this ???
-               end if;
-            end if;
+            Check_Duplicate_Pragma (Ent);
+
+            Record_Rep_Item (Ent, N);
          end Priority;
 
          -----------------------------------
@@ -12968,26 +12999,24 @@ 
             if Nkind (P) = N_Subprogram_Body then
                Check_In_Main_Program;
 
-            --  Tasks
+            --  Only Task and subprogram cases allowed
 
-            elsif Nkind (P) = N_Task_Definition then
-               null;
-
-            --  Anything else is incorrect
-
-            else
+            elsif Nkind (P) /= N_Task_Definition then
                Pragma_Misplaced;
             end if;
 
+            --  Check duplicate pragma before we set the corresponding flag
+
             if Has_Relative_Deadline_Pragma (P) then
                Error_Pragma ("duplicate pragma% not allowed");
-            else
-               Set_Has_Relative_Deadline_Pragma (P, True);
+            end if;
 
-               if Nkind (P) = N_Task_Definition then
-                  Record_Rep_Item (Defining_Identifier (Parent (P)), N);
-               end if;
-            end if;
+            --  Set Has_Relative_Deadline_Pragma only for tasks. Note that
+            --  Relative_Deadline pragma node cannot be inserted in the Rep
+            --  Item chain of Ent since it is rewritten by the expander as a
+            --  procedure call statement that will break the chain.
+
+            Set_Has_Relative_Deadline_Pragma (P, True);
          end Relative_Deadline;
 
          ------------------------
@@ -13458,7 +13487,6 @@ 
                end if;
 
                Record_Rep_Item (Defining_Identifier (Parent (P)), N);
-               --  ???  exp_ch9 should use this!
             end if;
          end Storage_Size;
 
@@ -13877,7 +13905,8 @@ 
          --  pragma Task_Info (EXPRESSION);
 
          when Pragma_Task_Info => Task_Info : declare
-            P : constant Node_Id := Parent (N);
+            P   : constant Node_Id := Parent (N);
+            Ent : Entity_Id;
 
          begin
             GNAT_Pragma;
@@ -13896,11 +13925,13 @@ 
                return;
             end if;
 
-            if Has_Task_Info_Pragma (P) then
-               Error_Pragma ("duplicate pragma% not allowed");
-            else
-               Set_Has_Task_Info_Pragma (P, True);
-            end if;
+            Ent := Defining_Identifier (Parent (P));
+
+            --  Check duplicate pragma before we chain the pragma in the Rep
+            --  Item chain of Ent.
+
+            Check_Duplicate_Pragma (Ent);
+            Record_Rep_Item (Ent, N);
          end Task_Info;
 
          ---------------
@@ -13912,6 +13943,7 @@ 
          when Pragma_Task_Name => Task_Name : declare
             P   : constant Node_Id := Parent (N);
             Arg : Node_Id;
+            Ent : Entity_Id;
 
          begin
             Check_No_Identifiers;
@@ -13930,12 +13962,13 @@ 
                Pragma_Misplaced;
             end if;
 
-            if Has_Task_Name_Pragma (P) then
-               Error_Pragma ("duplicate pragma% not allowed");
-            else
-               Set_Has_Task_Name_Pragma (P, True);
-               Record_Rep_Item (Defining_Identifier (Parent (P)), N);
-            end if;
+            Ent := Defining_Identifier (Parent (P));
+
+            --  Check duplicate pragma before we chain the pragma in the Rep
+            --  Item chain of Ent.
+
+            Check_Duplicate_Pragma (Ent);
+            Record_Rep_Item (Ent, N);
          end Task_Name;
 
          ------------------
@@ -14143,6 +14176,7 @@ 
             Check_Arg_Is_Local_Name (Arg1);
 
             Find_Type (Type_Id);
+
             Typ := Entity (Type_Id);
 
             if Typ = Any_Type
@@ -14287,6 +14321,7 @@ 
             end if;
 
             Set_Universal_Aliasing (Implementation_Base_Type (E_Id));
+            Record_Rep_Item (E_Id, N);
          end Universal_Alias;
 
          --------------------
Index: freeze.adb
===================================================================
--- freeze.adb	(revision 188445)
+++ freeze.adb	(working copy)
@@ -49,6 +49,7 @@ 
 with Sem_Ch6;  use Sem_Ch6;
 with Sem_Ch7;  use Sem_Ch7;
 with Sem_Ch8;  use Sem_Ch8;
+with Sem_Ch9;  use Sem_Ch9;
 with Sem_Ch13; use Sem_Ch13;
 with Sem_Eval; use Sem_Eval;
 with Sem_Mech; use Sem_Mech;
@@ -1323,6 +1324,11 @@ 
             --  for a description of how we handle aspect visibility).
 
             elsif Has_Delayed_Aspects (E) then
+               --  Retrieve the visibility to the discriminants in order to
+               --  analyze properly the aspects.
+
+               Push_Scope_And_Install_Discriminants (E);
+
                declare
                   Ritem : Node_Id;
 
@@ -1339,6 +1345,8 @@ 
                      Ritem := Next_Rep_Item (Ritem);
                   end loop;
                end;
+
+               Uninstall_Discriminants_And_Pop_Scope (E);
             end if;
 
             --  If an incomplete type is still not frozen, this may be a
@@ -1536,6 +1544,10 @@ 
       procedure Add_To_Result (N : Node_Id);
       --  N is a freezing action to be appended to the Result
 
+      function After_Last_Declaration return Boolean;
+      --  If Loc is a freeze_entity that appears after the last declaration
+      --  in the scope, inhibit error messages on late completion.
+
       procedure Check_Current_Instance (Comp_Decl : Node_Id);
       --  Check that an Access or Unchecked_Access attribute with a prefix
       --  which is the current instance type can only be applied when the type
@@ -1546,10 +1558,6 @@ 
       --  integer literal without an explicit corresponding size clause. The
       --  caller has checked that Utype is a modular integer type.
 
-      function After_Last_Declaration return Boolean;
-      --  If Loc is a freeze_entity that appears after the last declaration
-      --  in the scope, inhibit error messages on late completion.
-
       procedure Freeze_Record_Type (Rec : Entity_Id);
       --  Freeze each component, handle some representation clauses, and freeze
       --  primitive operations if this is a tagged type.
@@ -2513,39 +2521,15 @@ 
          end;
       end if;
 
-      --  Deal with delayed aspect specifications. The analysis of the aspect
-      --  is required to be delayed to the freeze point, so we evaluate the
-      --  pragma or attribute definition clause in the tree at this point.
+      --  Deal with delayed aspect specifications. The analysis of the
+      --  aspect is required to be delayed to the freeze point, so we
+      --  evaluate the pragma or attribute definition clause in the tree at
+      --  this point. We also analyze the aspect specification node at the
+      --  freeze point when the aspect doesn't correspond to
+      --  pragma/attribute definition clause.
 
       if Has_Delayed_Aspects (E) then
-         declare
-            Ritem : Node_Id;
-            Aitem : Node_Id;
-
-         begin
-            --  Look for aspect specification entries for this entity
-
-            Ritem := First_Rep_Item (E);
-            while Present (Ritem) loop
-               if Nkind (Ritem) = N_Aspect_Specification
-                 and then Entity (Ritem) = E
-                 and then Is_Delayed_Aspect (Ritem)
-                 and then Scope (E) = Current_Scope
-               then
-                  Aitem := Aspect_Rep_Item (Ritem);
-
-                  --  Skip if this is an aspect with no corresponding pragma
-                  --  or attribute definition node (such as Default_Value).
-
-                  if Present (Aitem) then
-                     Set_Parent (Aitem, Ritem);
-                     Analyze (Aitem);
-                  end if;
-               end if;
-
-               Next_Rep_Item (Ritem);
-            end loop;
-         end;
+         Evaluate_Aspects_At_Freeze_Point (E);
       end if;
 
       --  Here to freeze the entity
@@ -2555,7 +2539,6 @@ 
       --  Case of entity being frozen is other than a type
 
       if not Is_Type (E) then
-
          --  If entity is exported or imported and does not have an external
          --  name, now is the time to provide the appropriate default name.
          --  Skip this if the entity is stubbed, since we don't need a name
Index: sem_util.adb
===================================================================
--- sem_util.adb	(revision 188445)
+++ sem_util.adb	(working copy)
@@ -2259,10 +2259,35 @@ 
             end if;
 
             if Wmsg then
+               --  Check whether the context is an Init_Proc
+
                if Inside_Init_Proc then
-                  Error_Msg_NEL
-                    ("\?& will be raised for objects of this type",
-                     N, Standard_Constraint_Error, Eloc);
+                  declare
+                     Conc_Typ : constant Entity_Id :=
+                                  Corresponding_Concurrent_Type
+                                    (Entity (Parameter_Type (First
+                                      (Parameter_Specifications
+                                        (Parent (Current_Scope))))));
+
+                  begin
+                     --  Don't complain if the corresponding concurrent type
+                     --  doesn't come from source (i.e. a single task/protected
+                     --  object).
+
+                     if Present (Conc_Typ)
+                       and then not Comes_From_Source (Conc_Typ)
+                     then
+                        Error_Msg_NEL
+                          ("\?& will be raised at run time",
+                           N, Standard_Constraint_Error, Eloc);
+
+                     else
+                        Error_Msg_NEL
+                          ("\?& will be raised for objects of this type",
+                           N, Standard_Constraint_Error, Eloc);
+                     end if;
+                  end;
+
                else
                   Error_Msg_NEL
                     ("\?& will be raised at run time",
Index: sem_attr.adb
===================================================================
--- sem_attr.adb	(revision 188445)
+++ sem_attr.adb	(working copy)
@@ -2215,6 +2215,14 @@ 
            Attribute_Variable_Indexing    =>
          Error_Msg_N ("illegal attribute", N);
 
+      --  Attributes related to Ada 2012 aspects. Attribute definition clause
+      --  exists for these, but they cannot be queried.
+
+      when Attribute_CPU                |
+           Attribute_Dispatching_Domain |
+           Attribute_Interrupt_Priority =>
+         Error_Msg_N ("illegal attribute", N);
+
       ------------------
       -- Abort_Signal --
       ------------------
@@ -6286,12 +6294,18 @@ 
 
          --  Attributes related to Ada 2012 iterators (placeholder ???)
 
-         when Attribute_Constant_Indexing    => null;
-         when Attribute_Default_Iterator     => null;
-         when Attribute_Implicit_Dereference => null;
-         when Attribute_Iterator_Element     => null;
-         when Attribute_Variable_Indexing    => null;
+         when Attribute_Constant_Indexing    |
+              Attribute_Default_Iterator     |
+              Attribute_Implicit_Dereference |
+              Attribute_Iterator_Element     |
+              Attribute_Variable_Indexing    => null;
 
+         --  Atributes related to Ada 2012 aspects
+
+         when Attribute_CPU                |
+              Attribute_Dispatching_Domain |
+              Attribute_Interrupt_Priority => null;
+
       --------------
       -- Adjacent --
       --------------
Index: exp_ch13.adb
===================================================================
--- exp_ch13.adb	(revision 188428)
+++ exp_ch13.adb	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2012, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -165,15 +165,31 @@ 
 
             --  If the type is a task type, then assign the value of the
             --  storage size to the Size variable associated with the task.
-            --    task_typeZ := expression
+            --  Insert the assignment right after the declaration of the Size
+            --  variable.
 
+            --  Generate:
+
+            --  task_typeZ := expression
+
             if Ekind (Ent) = E_Task_Type then
-               Insert_Action (N,
-                 Make_Assignment_Statement (Loc,
-                   Name => New_Reference_To (Storage_Size_Variable (Ent), Loc),
-                   Expression =>
-                     Convert_To (RTE (RE_Size_Type), Expression (N))));
+               declare
+                  Assign : Node_Id;
 
+               begin
+                  Assign :=
+                    Make_Assignment_Statement (Loc,
+                      Name =>
+                        New_Reference_To (Storage_Size_Variable (Ent), Loc),
+                      Expression =>
+                        Convert_To (RTE (RE_Size_Type), Expression (N)));
+
+                  Insert_After
+                    (Parent (Storage_Size_Variable (Entity (N))), Assign);
+
+                  Analyze (Assign);
+               end;
+
             --  For Storage_Size for an access type, create a variable to hold
             --  the value of the specified size with name typeV and expand an
             --  assignment statement to initialize this value.
Index: snames.adb-tmpl
===================================================================
--- snames.adb-tmpl	(revision 188428)
+++ snames.adb-tmpl	(working copy)
@@ -209,10 +209,16 @@ 
    begin
       if N = Name_AST_Entry then
          return Pragma_AST_Entry;
+      elsif N = Name_CPU then
+         return Pragma_CPU;
+      elsif N = Name_Dispatching_Domain then
+         return Pragma_Dispatching_Domain;
       elsif N = Name_Fast_Math then
          return Pragma_Fast_Math;
       elsif N = Name_Interface then
          return Pragma_Interface;
+      elsif N = Name_Interrupt_Priority then
+         return Pragma_Interrupt_Priority;
       elsif N = Name_Priority then
          return Pragma_Priority;
       elsif N = Name_Relative_Deadline then
@@ -410,8 +416,11 @@ 
    begin
       return N in First_Pragma_Name .. Last_Pragma_Name
         or else N = Name_AST_Entry
+        or else N = Name_CPU
+        or else N = Name_Dispatching_Domain
         or else N = Name_Fast_Math
         or else N = Name_Interface
+        or else N = Name_Interrupt_Priority
         or else N = Name_Relative_Deadline
         or else N = Name_Priority
         or else N = Name_Storage_Size
Index: sem_ch13.adb
===================================================================
--- sem_ch13.adb	(revision 188441)
+++ sem_ch13.adb	(working copy)
@@ -46,6 +46,7 @@ 
 with Sem_Ch3;  use Sem_Ch3;
 with Sem_Ch6;  use Sem_Ch6;
 with Sem_Ch8;  use Sem_Ch8;
+with Sem_Ch9;  use Sem_Ch9;
 with Sem_Dim;  use Sem_Dim;
 with Sem_Eval; use Sem_Eval;
 with Sem_Res;  use Sem_Res;
@@ -693,27 +694,28 @@ 
       L : constant List_Id := Aspect_Specifications (N);
 
       Ins_Node : Node_Id := N;
-      --  Insert pragmas (except Pre/Post/Invariant/Predicate) after this node
+      --  Insert pragmas/attribute definition clause after this node when no
+      --  delayed analysis is required.
 
       --  The general processing involves building an attribute definition
-      --  clause or a pragma node that corresponds to the aspect. Then one
-      --  of two things happens:
+      --  clause or a pragma node that corresponds to the aspect. Then in order
+      --  to delay the evaluation of this aspect to the freeze point, we attach
+      --  the corresponding pragma/attribute definition clause to the aspect
+      --  specification node, which is then placed in the Rep Item chain. In
+      --  this case we mark the entity by setting the flag Has_Delayed_Aspects
+      --  and we evaluate the rep item at the freeze point. When the aspect
+      --  doesn't have a corresponding pragma/attribute definition clause, then
+      --  its analysis is simply delayed at the freeze point.
 
-      --  If we are required to delay the evaluation of this aspect to the
-      --  freeze point, we attach the corresponding pragma/attribute definition
-      --  clause to the aspect specification node, which is then placed in the
-      --  Rep Item chain. In this case we mark the entity by setting the flag
-      --  Has_Delayed_Aspects and we evaluate the rep item at the freeze point.
+      --  Some special cases don't require delay analysis, thus the aspect is
+      --  analyzed right now.
 
-      --  If no delay is required, we just insert the pragma or attribute
-      --  after the declaration, and it will get processed by the normal
-      --  circuit. The From_Aspect_Specification flag is set on the pragma
-      --  or attribute definition node in either case to activate special
-      --  processing (e.g. not traversing the list of homonyms for inline).
+      --  Note that there is a special handling for
+      --  Pre/Post/Test_Case/Contract_Case aspects. In this case, we do not
+      --  have to worry about delay issues, since the pragmas themselves deal
+      --  with delay of visibility for the expression analysis. Thus, we just
+      --  insert the pragma after the node N.
 
-      Delay_Required : Boolean := False;
-      --  Set True if delay is required
-
    begin
       pragma Assert (Present (L));
 
@@ -722,82 +724,98 @@ 
       Aspect := First (L);
       Aspect_Loop : while Present (Aspect) loop
          declare
+            Expr : constant Node_Id    := Expression (Aspect);
+            Id   : constant Node_Id    := Identifier (Aspect);
             Loc  : constant Source_Ptr := Sloc (Aspect);
-            Id   : constant Node_Id    := Identifier (Aspect);
-            Expr : constant Node_Id    := Expression (Aspect);
             Nam  : constant Name_Id    := Chars (Id);
             A_Id : constant Aspect_Id  := Get_Aspect_Id (Nam);
             Anod : Node_Id;
 
+            Delay_Required : Boolean := True;
+            --  Set False if delay is not required
+
             Eloc : Source_Ptr := No_Location;
             --  Source location of expression, modified when we split PPC's. It
             --  is set below when Expr is present.
 
-            procedure Check_False_Aspect_For_Derived_Type;
-            --  This procedure checks for the case of a false aspect for a
-            --  derived type, which improperly tries to cancel an aspect
-            --  inherited from the parent;
+            procedure Analyze_Aspect_External_Or_Link_Name;
+            --  This routine performs the analysis of the External_Name or
+            --  Link_Name aspects.
 
-            -----------------------------------------
-            -- Check_False_Aspect_For_Derived_Type --
-            -----------------------------------------
+            procedure Analyze_Aspect_Implicit_Dereference;
+            --  This routine performs the analysis of the Implicit_Dereference
+            --  aspects.
 
-            procedure Check_False_Aspect_For_Derived_Type is
+            ------------------------------------------
+            -- Analyze_Aspect_External_Or_Link_Name --
+            ------------------------------------------
+
+            procedure Analyze_Aspect_External_Or_Link_Name is
             begin
-               --  We are only checking derived types
+               --  Verify that there is an Import/Export aspect defined for the
+               --  entity. The processing of that aspect in turn checks that
+               --  there is a Convention aspect declared. The pragma is
+               --  constructed when processing the Convention aspect.
 
-               if not Is_Derived_Type (E) then
-                  return;
-               end if;
+               declare
+                  A : Node_Id;
 
-               case A_Id is
-                  when Aspect_Atomic | Aspect_Shared =>
-                     if not Is_Atomic (E) then
-                        return;
-                     end if;
+               begin
+                  A := First (L);
 
-                  when Aspect_Atomic_Components =>
-                     if not Has_Atomic_Components (E) then
-                        return;
-                     end if;
+                  while Present (A) loop
+                     exit when Chars (Identifier (A)) = Name_Export
+                       or else Chars (Identifier (A)) = Name_Import;
+                     Next (A);
+                  end loop;
 
-                  when Aspect_Discard_Names =>
-                     if not Discard_Names (E) then
-                        return;
-                     end if;
+                  if No (A) then
+                     Error_Msg_N
+                       ("Missing Import/Export for Link/External name",
+                         Aspect);
+                  end if;
+               end;
+            end Analyze_Aspect_External_Or_Link_Name;
 
-                  when Aspect_Pack =>
-                     if not Is_Packed (E) then
-                        return;
-                     end if;
+            -----------------------------------------
+            -- Analyze_Aspect_Implicit_Dereference --
+            -----------------------------------------
 
-                  when Aspect_Unchecked_Union =>
-                     if not Is_Unchecked_Union (E) then
-                        return;
-                     end if;
+            procedure Analyze_Aspect_Implicit_Dereference is
+            begin
+               if not Is_Type (E)
+                 or else not Has_Discriminants (E)
+               then
+                  Error_Msg_N
+                    ("Aspect must apply to a type with discriminants", N);
 
-                  when Aspect_Volatile =>
-                     if not Is_Volatile (E) then
-                        return;
-                     end if;
+               else
+                  declare
+                     Disc : Entity_Id;
 
-                  when Aspect_Volatile_Components =>
-                     if not Has_Volatile_Components (E) then
-                        return;
-                     end if;
+                  begin
+                     Disc := First_Discriminant (E);
 
-                  when others =>
-                     return;
-               end case;
+                     while Present (Disc) loop
+                        if Chars (Expr) = Chars (Disc)
+                          and then Ekind (Etype (Disc)) =
+                                     E_Anonymous_Access_Type
+                        then
+                           Set_Has_Implicit_Dereference (E);
+                           Set_Has_Implicit_Dereference (Disc);
+                           return;
+                        end if;
 
-               --  Fall through means we are canceling an inherited aspect
+                        Next_Discriminant (Disc);
+                     end loop;
 
-               Error_Msg_Name_1 := Nam;
-               Error_Msg_NE
-                 ("derived type& inherits aspect%, cannot cancel", Expr, E);
-            end Check_False_Aspect_For_Derived_Type;
+                     --  Error if no proper access discriminant.
 
-         --  Start of processing for Aspect_Loop
+                     Error_Msg_NE
+                      ("not an access discriminant of&", Expr, E);
+                  end;
+               end if;
+            end Analyze_Aspect_Implicit_Dereference;
 
          begin
             --  Skip aspect if already analyzed (not clear if this is needed)
@@ -926,199 +944,25 @@ 
                when No_Aspect =>
                   raise Program_Error;
 
-               --  Aspects taking an optional boolean argument
+               --  Case 1: Aspects corresponding to attribute definition
+               --  clauses.
 
-               when Boolean_Aspects =>
-                  Set_Is_Boolean_Aspect (Aspect);
-
-                  --  Special treatment for Aspect_Lock_Free since it is the
-                  --  only Boolean_Aspect that doesn't correspond to a pragma.
-
-                  if A_Id = Aspect_Lock_Free then
-                     if Ekind (E) /= E_Protected_Type then
-                        Error_Msg_N
-                          ("aspect % only applies to protected objects",
-                           Aspect);
-                     end if;
-
-                     --  Set the Uses_Lock_Free flag to True if there is no
-                     --  expression or if the expression is True.
-
-                     if No (Expr) or else Is_True (Static_Boolean (Expr)) then
-                        Set_Uses_Lock_Free (E);
-                     end if;
-
-                     goto Continue;
-
-                  --  For Import/Export, Verify that there is an aspect
-                  --  Convention that will incorporate the Import/Export
-                  --  aspect, and eventual Link/External names.
-
-                  elsif A_Id = Aspect_Import or else A_Id = Aspect_Export then
-                     declare
-                        A : Node_Id;
-
-                     begin
-                        A := First (L);
-                        while Present (A) loop
-                           exit when Chars (Identifier (A)) = Name_Convention;
-                           Next (A);
-                        end loop;
-
-                        if No (A) then
-                           Error_Msg_N
-                             ("missing Convention aspect for Export/Import",
-                                 Aspect);
-                        end if;
-                     end;
-
-                     goto Continue;
-                  end if;
-
-                  --  For all other aspects we just create a matching pragma
-                  --  and insert it, if the expression is missing or set to
-                  --  True. If the expression is False, we can ignore the
-                  --  aspect with the exception that in the case of a derived
-                  --  type, we must check for an illegal attempt to cancel an
-                  --  inherited aspect.
-
-                  if Present (Expr)
-                    and then Is_False (Static_Boolean (Expr))
-                  then
-                     Check_False_Aspect_For_Derived_Type;
-                     goto Continue;
-                  end if;
-
-                  --  If True, build corresponding pragma node
-
-                  Aitem :=
-                    Make_Pragma (Loc,
-                      Pragma_Argument_Associations => New_List (Ent),
-                      Pragma_Identifier            =>
-                        Make_Identifier (Sloc (Id), Chars (Id)));
-
-                  --  Never need to delay for boolean aspects
-
-                  pragma Assert (not Delay_Required);
-
-               --  Library unit aspects. These are boolean aspects, but we
-               --  have to do special things with the insertion, since the
-               --  pragma belongs inside the declarations of a package.
-
-               when Library_Unit_Aspects =>
-                  if Present (Expr)
-                    and then Is_False (Static_Boolean (Expr))
-                  then
-                     goto Continue;
-                  end if;
-
-                  --  Build corresponding pragma node
-
-                  Aitem :=
-                    Make_Pragma (Loc,
-                      Pragma_Argument_Associations => New_List (Ent),
-                      Pragma_Identifier            =>
-                        Make_Identifier (Sloc (Id), Chars (Id)));
-
-                  --  This requires special handling in the case of a package
-                  --  declaration, the pragma needs to be inserted in the list
-                  --  of declarations for the associated package. There is no
-                  --  issue of visibility delay for these aspects.
-
-                  if Nkind (N) = N_Package_Declaration then
-                     if Nkind (Parent (N)) /= N_Compilation_Unit then
-                        Error_Msg_N
-                          ("incorrect context for library unit aspect&", Id);
-                     else
-                        Prepend
-                          (Aitem, Visible_Declarations (Specification (N)));
-                     end if;
-
-                     goto Continue;
-                  end if;
-
-                  --  If not package declaration, no delay is required
-
-                  pragma Assert (not Delay_Required);
-
-               --  Aspects related to container iterators. These aspects denote
-               --  subprograms, and thus must be delayed.
-
-               when Aspect_Constant_Indexing    |
-                    Aspect_Variable_Indexing    =>
-
-                  if not Is_Type (E) or else not Is_Tagged_Type (E) then
-                     Error_Msg_N ("indexing applies to a tagged type", N);
-                  end if;
-
-                  Aitem :=
-                    Make_Attribute_Definition_Clause (Loc,
-                      Name       => Ent,
-                      Chars      => Chars (Id),
-                      Expression => Relocate_Node (Expr));
-
-                  Delay_Required := True;
-                  Set_Is_Delayed_Aspect (Aspect);
-
-               when Aspect_Default_Iterator     |
-                    Aspect_Iterator_Element     =>
-
-                  Aitem :=
-                    Make_Attribute_Definition_Clause (Loc,
-                      Name       => Ent,
-                      Chars      => Chars (Id),
-                      Expression => Relocate_Node (Expr));
-
-                  Delay_Required := True;
-                  Set_Is_Delayed_Aspect (Aspect);
-
-               when Aspect_Implicit_Dereference =>
-                  if not Is_Type (E)
-                    or else not Has_Discriminants (E)
-                  then
-                     Error_Msg_N
-                       ("Aspect must apply to a type with discriminants", N);
-                     goto Continue;
-
-                  else
-                     declare
-                        Disc : Entity_Id;
-
-                     begin
-                        Disc := First_Discriminant (E);
-                        while Present (Disc) loop
-                           if Chars (Expr) = Chars (Disc)
-                             and then Ekind (Etype (Disc)) =
-                               E_Anonymous_Access_Type
-                           then
-                              Set_Has_Implicit_Dereference (E);
-                              Set_Has_Implicit_Dereference (Disc);
-                              goto Continue;
-                           end if;
-
-                           Next_Discriminant (Disc);
-                        end loop;
-
-                        --  Error if no proper access discriminant.
-
-                        Error_Msg_NE
-                         ("not an access discriminant of&", Expr, E);
-                     end;
-
-                     goto Continue;
-                  end if;
-
-               --  Aspects corresponding to attribute definition clauses
-
                when Aspect_Address              |
                     Aspect_Alignment            |
                     Aspect_Bit_Order            |
                     Aspect_Component_Size       |
+                    Aspect_Constant_Indexing    |
+                    Aspect_CPU                  |
+                    Aspect_Default_Iterator     |
+                    Aspect_Dispatching_Domain   |
                     Aspect_External_Tag         |
                     Aspect_Input                |
+                    Aspect_Interrupt_Priority   |
+                    Aspect_Iterator_Element     |
                     Aspect_Machine_Radix        |
                     Aspect_Object_Size          |
                     Aspect_Output               |
+                    Aspect_Priority             |
                     Aspect_Read                 |
                     Aspect_Scalar_Storage_Order |
                     Aspect_Size                 |
@@ -1128,8 +972,20 @@ 
                     Aspect_Storage_Size         |
                     Aspect_Stream_Size          |
                     Aspect_Value_Size           |
+                    Aspect_Variable_Indexing    |
                     Aspect_Write                =>
 
+                  --  Indexing aspects apply only to tagged type
+
+                  if (A_Id = Aspect_Constant_Indexing
+                       or else A_Id = Aspect_Variable_Indexing)
+                    and then not (Is_Type (E)
+                                   and then Is_Tagged_Type (E))
+                  then
+                     Error_Msg_N ("indexing applies to a tagged type", N);
+                     goto Continue;
+                  end if;
+
                   --  Construct the attribute definition clause
 
                   Aitem :=
@@ -1138,23 +994,13 @@ 
                       Chars      => Chars (Id),
                       Expression => Relocate_Node (Expr));
 
-                  --  A delay is required except in the common case where
-                  --  the expression is a literal, in which case it is fine
-                  --  to take care of it right away.
+               --  Case 2: Aspects cooresponding to pragmas
 
-                  if Nkind_In (Expr, N_Integer_Literal, N_String_Literal) then
-                     pragma Assert (not Delay_Required);
-                     null;
-                  else
-                     Delay_Required := True;
-                     Set_Is_Delayed_Aspect (Aspect);
-                  end if;
+               --  Case 2a: Aspects corresponding to pragmas with two
+               --  arguments, where the first argument is a local name
+               --  referring to the entity, and the second argument is the
+               --  aspect definition expression.
 
-               --  Aspects corresponding to pragmas with two arguments, where
-               --  the first argument is a local name referring to the entity,
-               --  and the second argument is the aspect definition expression
-               --  which is an expression that does not get analyzed.
-
                when Aspect_Suppress   |
                     Aspect_Unsuppress =>
 
@@ -1168,11 +1014,6 @@ 
                       Pragma_Identifier            =>
                         Make_Identifier (Sloc (Id), Chars (Id)));
 
-                  --  We don't have to play the delay game here, since the only
-                  --  values are check names which don't get analyzed anyway.
-
-                  pragma Assert (not Delay_Required);
-
                when Aspect_Synchronization =>
 
                   --  The aspect corresponds to pragma Implemented.
@@ -1186,12 +1027,54 @@ 
                       Pragma_Identifier            =>
                         Make_Identifier (Sloc (Id), Name_Implemented));
 
-                  pragma Assert (not Delay_Required);
+                  --  No delay is required since the only values are: By_Entry
+                  --  | By_Protected_Procedure | By_Any | Optional which don't
+                  --  get analyzed anyway.
 
-               --  Aspects corresponding to pragmas with two arguments, where
-               --  the second argument is a local name referring to the entity,
-               --  and the first argument is the aspect definition expression.
+                  Delay_Required := False;
 
+               when Aspect_Attach_Handler =>
+                  Aitem :=
+                    Make_Pragma (Loc,
+                      Pragma_Identifier            =>
+                        Make_Identifier (Sloc (Id), Name_Attach_Handler),
+                      Pragma_Argument_Associations =>
+                        New_List (Ent, Relocate_Node (Expr)));
+
+               when Aspect_Dynamic_Predicate |
+                    Aspect_Predicate         |
+                    Aspect_Static_Predicate  =>
+
+                  --  Construct the pragma (always a pragma Predicate, with
+                  --  flags recording whether it is static/dynamic).
+
+                  Aitem :=
+                    Make_Pragma (Loc,
+                      Pragma_Argument_Associations =>
+                        New_List (Ent, Relocate_Node (Expr)),
+                      Class_Present                => Class_Present (Aspect),
+                      Pragma_Identifier            =>
+                        Make_Identifier (Sloc (Id), Name_Predicate));
+
+                  --  If the type is private, indicate that its completion
+                  --  has a freeze node, because that is the one that will be
+                  --  visible at freeze time.
+
+                  Set_Has_Predicates (E);
+
+                  if Is_Private_Type (E)
+                    and then Present (Full_View (E))
+                  then
+                     Set_Has_Predicates (Full_View (E));
+                     Set_Has_Delayed_Aspects (Full_View (E));
+                     Ensure_Freeze_Node (Full_View (E));
+                  end if;
+
+               --  Case 2b: Aspects corresponding to pragmas with two
+               --  arguments, where the second argument is a local name
+               --  referring to the entity, and the first argument is the
+               --  aspect definition expression.
+
                when Aspect_Convention  =>
 
                   --  The aspect may be part of the specification of an import
@@ -1215,56 +1098,36 @@ 
                      L_Assoc  := Empty;
                      E_Assoc  := Empty;
 
-                     --  Loop to look for Import/Export/Link_Name/External_Name
-
                      A := First (L);
                      while Present (A) loop
                         A_Name := Chars (Identifier (A));
 
-                        --  Import/Export
-
                         if A_Name = Name_Import
-                             or else
-                           A_Name = Name_Export
+                          or else A_Name = Name_Export
                         then
-                           --  Forbid duplicates, at most one can appear
-
                            if Found then
-                              Error_Msg_Name_1 := A_Name;
-                              Error_Msg_Name_2 := P_Name;
-                              Error_Msg_N
-                                ("% aspect conflicts with previous % aspect",
-                                 A);
+                              Error_Msg_N ("conflicting", A);
                            else
                               Found := True;
                            end if;
 
-                           --  Record name of pragma to generate
-
                            P_Name := A_Name;
 
-                        --  Capture Link_Name
-
                         elsif A_Name = Name_Link_Name then
                            L_Assoc := Make_Pragma_Argument_Association (Loc,
-                              Chars      => A_Name,
+                              Chars => A_Name,
                               Expression => Relocate_Node (Expression (A)));
 
-                        --  Capture External_Name
-
                         elsif A_Name = Name_External_Name then
                            E_Assoc := Make_Pragma_Argument_Association (Loc,
-                              Chars      => A_Name,
+                              Chars => A_Name,
                               Expression => Relocate_Node (Expression (A)));
                         end if;
 
                         Next (A);
                      end loop;
 
-                     --  Construct pragma
-
                      Arg_List := New_List (Relocate_Node (Expr), Ent);
-
                      if Present (L_Assoc) then
                         Append_To (Arg_List, L_Assoc);
                      end if;
@@ -1296,103 +1159,89 @@ 
                   --  We don't have to play the delay game here, since the only
                   --  values are ON/OFF which don't get analyzed anyway.
 
-                  pragma Assert (not Delay_Required);
+                  Delay_Required := False;
 
-               --  Default_Value and Default_Component_Value aspects. These
-               --  are specially handled because they have no corresponding
-               --  pragmas or attributes.
+               --  Case 2c: Aspects corresponding to pragmas with three
+               --  arguments.
 
-               when Aspect_Default_Value | Aspect_Default_Component_Value =>
-                  Error_Msg_Name_1 := Chars (Id);
+               --  Invariant aspects have a first argument that references the
+               --  entity, a second argument that is the expression and a third
+               --  argument that is an appropriate message.
 
-                  if not Is_Type (E) then
-                     Error_Msg_N ("aspect% can only apply to a type", Id);
-                     goto Continue;
+               when Aspect_Invariant      |
+                    Aspect_Type_Invariant =>
 
-                  elsif not Is_First_Subtype (E) then
-                     Error_Msg_N ("aspect% cannot apply to subtype", Id);
-                     goto Continue;
+                  --  Analysis of the pragma will verify placement legality:
+                  --  an invariant must apply to a private type, or appear in
+                  --  the private part of a spec and apply to a completion.
 
-                  elsif A_Id = Aspect_Default_Value
-                    and then not Is_Scalar_Type (E)
-                  then
-                     Error_Msg_N
-                       ("aspect% can only be applied to scalar type", Id);
-                     goto Continue;
+                  --  Construct the pragma
 
-                  elsif A_Id = Aspect_Default_Component_Value then
-                     if not Is_Array_Type (E) then
-                        Error_Msg_N
-                          ("aspect% can only be applied to array type", Id);
-                        goto Continue;
-                     elsif not Is_Scalar_Type (Component_Type (E)) then
-                        Error_Msg_N
-                          ("aspect% requires scalar components", Id);
-                        goto Continue;
-                     end if;
-                  end if;
+                  Aitem :=
+                    Make_Pragma (Loc,
+                      Pragma_Argument_Associations =>
+                        New_List (Ent, Relocate_Node (Expr)),
+                      Class_Present                => Class_Present (Aspect),
+                      Pragma_Identifier            =>
+                        Make_Identifier (Sloc (Id), Name_Invariant));
 
-                  Aitem := Empty;
-                  Delay_Required := True;
-                  Set_Is_Delayed_Aspect (Aspect);
-                  Set_Has_Default_Aspect (Base_Type (Entity (Ent)));
+                  --  Add message unless exception messages are suppressed
 
-                  if Is_Scalar_Type (E) then
-                     Set_Default_Aspect_Value (Entity (Ent), Expr);
-                  else
-                     Set_Default_Aspect_Component_Value (Entity (Ent), Expr);
+                  if not Opt.Exception_Locations_Suppressed then
+                     Append_To (Pragma_Argument_Associations (Aitem),
+                       Make_Pragma_Argument_Association (Eloc,
+                         Chars      => Name_Message,
+                         Expression =>
+                           Make_String_Literal (Eloc,
+                             Strval => "failed invariant from "
+                                       & Build_Location_String (Eloc))));
                   end if;
 
-               when Aspect_Attach_Handler =>
-                  Aitem :=
-                    Make_Pragma (Loc,
-                      Pragma_Identifier            =>
-                        Make_Identifier (Sloc (Id), Name_Attach_Handler),
-                      Pragma_Argument_Associations =>
-                        New_List (Ent, Relocate_Node (Expr)));
+                  --  For Invariant case, insert immediately after the entity
+                  --  declaration. We do not have to worry about delay issues
+                  --  since the pragma processing takes care of this.
 
-                  Set_From_Aspect_Specification (Aitem, True);
-                  Set_Corresponding_Aspect (Aitem, Aspect);
+                  Set_Is_Delayed_Aspect (Aspect);
+                  Delay_Required := False;
 
-                  pragma Assert (not Delay_Required);
+               --  Case 3 : Aspects that don't correspond to pragma/attribute
+               --  definition clause.
 
-               when Aspect_Priority           |
-                    Aspect_Interrupt_Priority |
-                    Aspect_Dispatching_Domain |
-                    Aspect_CPU                =>
-                  declare
-                     Pname : Name_Id;
+               --  Case 3a: The aspects listed below don't correspond to
+               --  pragmas/attributes but do require delayed analysis.
 
-                  begin
-                     if A_Id = Aspect_Priority then
-                        Pname := Name_Priority;
+               when Aspect_Default_Value           |
+                    Aspect_Default_Component_Value =>
+                  Aitem := Empty;
 
-                     elsif A_Id = Aspect_Interrupt_Priority then
-                        Pname := Name_Interrupt_Priority;
+               --  Case 3b: The aspects listed below don't correspond to
+               --  pragmas/attributes and don't need delayed analysis.
 
-                     elsif A_Id = Aspect_CPU then
-                        Pname := Name_CPU;
+               --  For Implicit_Dereference, External_Name and Link_Name, only
+               --  the legality checks are done during the analysis, thus no
+               --  delay is required.
 
-                     else
-                        Pname := Name_Dispatching_Domain;
-                     end if;
+               when Aspect_Implicit_Dereference =>
+                  Analyze_Aspect_Implicit_Dereference;
+                  goto Continue;
 
-                     Aitem :=
-                       Make_Pragma (Loc,
-                           Pragma_Identifier            =>
-                             Make_Identifier (Sloc (Id), Pname),
-                           Pragma_Argument_Associations =>
-                             New_List
-                               (Make_Pragma_Argument_Association
-                                  (Sloc       => Sloc (Id),
-                                   Expression => Relocate_Node (Expr))));
+               when Aspect_External_Name |
+                    Aspect_Link_Name     =>
+                  Analyze_Aspect_External_Or_Link_Name;
+                  goto Continue;
 
-                     Set_From_Aspect_Specification (Aitem, True);
-                     Set_Corresponding_Aspect (Aitem, Aspect);
+               when Aspect_Dimension =>
+                  Analyze_Aspect_Dimension (N, Id, Expr);
+                  goto Continue;
 
-                     pragma Assert (not Delay_Required);
-                  end;
+               when Aspect_Dimension_System =>
+                  Analyze_Aspect_Dimension_System (N, Id, Expr);
+                  goto Continue;
 
+               --  Case 4: Special handling for aspects
+               --  Pre/Post/Test_Case/Contract_Case whose corresponding pragmas
+               --  take care of the delay.
+
                --  Aspects Pre/Post generate Precondition/Postcondition pragmas
                --  with a first argument that is the expression, and a second
                --  argument that is an informative message if the test fails.
@@ -1493,97 +1342,6 @@ 
                   goto Continue;
                end;
 
-               --  Invariant aspects generate a corresponding pragma with a
-               --  first argument that is the entity, a second argument that is
-               --  the expression and a third argument that is an appropriate
-               --  message. This is inserted right after the declaration, to
-               --  get the required pragma placement. The pragma processing
-               --  takes care of the required delay.
-
-               when Aspect_Invariant      |
-                    Aspect_Type_Invariant =>
-
-                  --  Analysis of the pragma will verify placement legality:
-                  --  an invariant must apply to a private type, or appear in
-                  --  the private part of a spec and apply to a completion.
-
-                  --  Construct the pragma
-
-                  Aitem :=
-                    Make_Pragma (Loc,
-                      Pragma_Argument_Associations =>
-                        New_List (Ent, Relocate_Node (Expr)),
-                      Class_Present                => Class_Present (Aspect),
-                      Pragma_Identifier            =>
-                        Make_Identifier (Sloc (Id), Name_Invariant));
-
-                  --  Add message unless exception messages are suppressed
-
-                  if not Opt.Exception_Locations_Suppressed then
-                     Append_To (Pragma_Argument_Associations (Aitem),
-                       Make_Pragma_Argument_Association (Eloc,
-                         Chars      => Name_Message,
-                         Expression =>
-                           Make_String_Literal (Eloc,
-                             Strval => "failed invariant from "
-                                       & Build_Location_String (Eloc))));
-                  end if;
-
-                  Set_From_Aspect_Specification (Aitem, True);
-                  Set_Corresponding_Aspect (Aitem, Aspect);
-                  Set_Is_Delayed_Aspect (Aspect);
-
-                  --  For Invariant case, insert immediately after the entity
-                  --  declaration. We do not have to worry about delay issues
-                  --  since the pragma processing takes care of this.
-
-                  Insert_After (N, Aitem);
-                  goto Continue;
-
-               --  Predicate aspects generate a corresponding pragma with a
-               --  first argument that is the entity, and the second argument
-               --  is the expression.
-
-               when Aspect_Dynamic_Predicate |
-                    Aspect_Predicate         |
-                    Aspect_Static_Predicate  =>
-
-                  --  Construct the pragma (always a pragma Predicate, with
-                  --  flags recording whether it is static/dynamic).
-
-                  Aitem :=
-                    Make_Pragma (Loc,
-                      Pragma_Argument_Associations =>
-                        New_List (Ent, Relocate_Node (Expr)),
-                      Class_Present                => Class_Present (Aspect),
-                      Pragma_Identifier            =>
-                        Make_Identifier (Sloc (Id), Name_Predicate));
-
-                  Set_From_Aspect_Specification (Aitem, True);
-                  Set_Corresponding_Aspect (Aitem, Aspect);
-
-                  --  Make sure we have a freeze node (it might otherwise be
-                  --  missing in cases like subtype X is Y, and we would not
-                  --  have a place to build the predicate function).
-
-                  --  If the type is private, indicate that its completion
-                  --  has a freeze node, because that is the one that will be
-                  --  visible at freeze time.
-
-                  Set_Has_Predicates (E);
-
-                  if Is_Private_Type (E)
-                    and then Present (Full_View (E))
-                  then
-                     Set_Has_Predicates (Full_View (E));
-                     Set_Has_Delayed_Aspects (Full_View (E));
-                     Ensure_Freeze_Node (Full_View (E));
-                  end if;
-
-                  Ensure_Freeze_Node (E);
-                  Set_Is_Delayed_Aspect (Aspect);
-                  Delay_Required := True;
-
                when Aspect_Contract_Case |
                     Aspect_Test_Case     =>
                   declare
@@ -1655,188 +1413,195 @@ 
                                     Pragma_Argument_Associations =>
                                       Args);
 
-                     Set_From_Aspect_Specification (Aitem, True);
-                     Set_Corresponding_Aspect (Aitem, Aspect);
-                     Set_Is_Delayed_Aspect (Aspect);
+                     Delay_Required := False;
+                  end;
 
-                     --  Insert immediately after the entity declaration
+               --  Case 5: Special handling for aspects with an optional
+               --  boolean argument.
 
-                     Insert_After (N, Aitem);
+               --  In the general case, the corresponding pragma cannot be
+               --  generated yet because the evaluation of the boolean needs to
+               --  be delayed til the freeze point.
 
-                     goto Continue;
-                  end;
+               when Boolean_Aspects      |
+                    Library_Unit_Aspects =>
 
-               when Aspect_Dimension =>
-                  Analyze_Aspect_Dimension (N, Id, Expr);
-                  goto Continue;
+                  Set_Is_Boolean_Aspect (Aspect);
 
-               when Aspect_Dimension_System =>
-                  Analyze_Aspect_Dimension_System (N, Id, Expr);
-                  goto Continue;
+                  --  Lock_Free aspect only apply to protected objects
 
-               when Aspect_External_Name |
-                    Aspect_Link_Name     =>
+                  if A_Id = Aspect_Lock_Free then
+                     if Ekind (E) /= E_Protected_Type then
+                        Error_Msg_N
+                          ("aspect % only applies to a protected object",
+                           Aspect);
 
-                  --  Verify that there is an Import/Export aspect defined for
-                  --  the entity. The processing of that aspect in turn checks
-                  --  that there is a Convention aspect declared. The pragma is
-                  --  constructed when processing the Convention aspect.
+                     else
+                        --  Set the Uses_Lock_Free flag to True if there is no
+                        --  expression or if the expression is True. ??? The
+                        --  evaluation of this aspect should be delayed to the
+                        --  freeze point.
 
-                  declare
-                     A : Node_Id;
-
-                  begin
-                     A := First (L);
-                     while Present (A) loop
-                        exit when Chars (Identifier (A)) = Name_Export
-                          or else Chars (Identifier (A)) = Name_Import;
-                        Next (A);
-                     end loop;
-
-                     if No (A) then
-                        Error_Msg_N
-                          ("Missing Import/Export for Link/External name",
-                               Aspect);
+                        if No (Expr)
+                          or else Is_True (Static_Boolean (Expr))
+                        then
+                           Set_Uses_Lock_Free (E);
+                        end if;
                      end if;
-                  end;
 
-                  goto Continue;
-            end case;
+                     goto Continue;
 
-            --  If a delay is required, we delay the freeze (not much point in
-            --  delaying the aspect if we don't delay the freeze!). The pragma
-            --  or attribute clause if there is one is then attached to the
-            --  aspect specification which is placed in the rep item list.
+                  elsif A_Id = Aspect_Import
+                    or else A_Id = Aspect_Export
+                  then
 
-            if Delay_Required then
-               if Present (Aitem) then
-                  Set_From_Aspect_Specification (Aitem, True);
+                     --  Verify that there is an aspect Convention that will
+                     --  incorporate the Import/Export aspect, and eventual
+                     --  Link/External names.
 
-                  if Nkind (Aitem) = N_Pragma then
-                     Set_Corresponding_Aspect (Aitem, Aspect);
-                  end if;
+                     declare
+                        A : Node_Id;
 
-                  Set_Is_Delayed_Aspect (Aitem);
-                  Set_Aspect_Rep_Item (Aspect, Aitem);
-               end if;
+                     begin
+                        A := First (L);
+                        while Present (A) loop
+                           exit when Chars (Identifier (A)) = Name_Convention;
+                           Next (A);
+                        end loop;
 
-               Ensure_Freeze_Node (E);
-               Set_Has_Delayed_Aspects (E);
-               Record_Rep_Item (E, Aspect);
+                        if No (A) then
+                           Error_Msg_N
+                             ("missing Convention aspect for Export/Import",
+                                 Aspect);
+                        end if;
+                     end;
 
-            --  If no delay required, insert the pragma/clause in the tree
+                     goto Continue;
+                  end if;
 
-            else
-               Set_From_Aspect_Specification (Aitem, True);
+                  --  This requires special handling in the case of a package
+                  --  declaration, the pragma needs to be inserted in the list
+                  --  of declarations for the associated package. There is no
+                  --  issue of visibility delay for these aspects.
 
-               if Nkind (Aitem) = N_Pragma then
-                  Set_Corresponding_Aspect (Aitem, Aspect);
-               end if;
+                  if A_Id in Library_Unit_Aspects
+                    and then Nkind (N) = N_Package_Declaration
+                    and then Nkind (Parent (N)) /= N_Compilation_Unit
+                  then
+                     Error_Msg_N
+                        ("incorrect context for library unit aspect&", Id);
+                     goto Continue;
+                  end if;
 
-               --  If this is a compilation unit, we will put the pragma in
-               --  the Pragmas_After list of the N_Compilation_Unit_Aux node.
+                  --  Special handling when the aspect has no expression. In
+                  --  this case the value is considered to be True. Thus, we
+                  --  simply insert the pragma, no delay is required.
 
-               if Nkind (Parent (Ins_Node)) = N_Compilation_Unit then
-                  declare
-                     Aux : constant Node_Id :=
-                             Aux_Decls_Node (Parent (Ins_Node));
+                  if No (Expr) then
+                     Aitem :=
+                       Make_Pragma (Loc,
+                         Pragma_Argument_Associations => New_List (Ent),
+                         Pragma_Identifier            =>
+                           Make_Identifier (Sloc (Id), Chars (Id)));
 
-                  begin
-                     pragma Assert (Nkind (Aux) = N_Compilation_Unit_Aux);
+                     Delay_Required := False;
 
-                     if No (Pragmas_After (Aux)) then
-                        Set_Pragmas_After (Aux, Empty_List);
-                     end if;
+                  --  In general cases, the corresponding pragma/attribute
+                  --  definition clause will be inserted later at the freezing
+                  --  point.
 
-                     --  For Pre_Post put at start of list, otherwise at end
+                  else
+                     Aitem := Empty;
+                  end if;
+            end case;
 
-                     if A_Id in Pre_Post_Aspects then
-                        Prepend (Aitem, Pragmas_After (Aux));
-                     else
-                        Append (Aitem, Pragmas_After (Aux));
-                     end if;
-                  end;
+            --  Attach the corresponding pragma/attribute definition clause to
+            --  the aspect specification node.
 
-               --  Here if not compilation unit case
+            if Present (Aitem) then
+               Set_From_Aspect_Specification (Aitem, True);
 
-               else
-                  case A_Id is
+               if Nkind (Aitem) = N_Pragma then
+                  Set_Corresponding_Aspect (Aitem, Aspect);
+               end if;
+            end if;
 
-                     --  For Pre/Post cases, insert immediately after the
-                     --  entity declaration, since that is the required pragma
-                     --  placement.
+            --  In the context of a compilation unit, we directly put the
+            --  pragma in the Pragmas_After list of the
+            --  N_Compilation_Unit_Aux node. No delay is required here.
 
-                     when Pre_Post_Aspects =>
-                        Insert_After (N, Aitem);
+            if Nkind (Parent (N)) = N_Compilation_Unit
+              and then (Present (Aitem) or else Is_Boolean_Aspect (Aspect))
+            then
+               declare
+                  Aux : constant Node_Id := Aux_Decls_Node (Parent (N));
 
-                     --  For Priority aspects, insert into the task or
-                     --  protected definition, which we need to create if it's
-                     --  not there. The same applies to CPU and
-                     --  Dispatching_Domain but only to tasks.
+               begin
+                  pragma Assert (Nkind (Aux) = N_Compilation_Unit_Aux);
 
-                     when Aspect_Priority           |
-                          Aspect_Interrupt_Priority |
-                          Aspect_Dispatching_Domain |
-                          Aspect_CPU                =>
-                        declare
-                           T : Node_Id; -- the type declaration
-                           L : List_Id; -- list of decls of task/protected
+                  --  For a Boolean aspect, create the corresponding pragma if
+                  --  no expression or if the value is True.
 
-                        begin
-                           if Nkind (N) = N_Object_Declaration then
-                              T := Parent (Etype (Defining_Identifier (N)));
-                           else
-                              T := N;
-                           end if;
+                  if Is_Boolean_Aspect (Aspect)
+                    and then No (Aitem)
+                  then
+                     if Is_True (Static_Boolean (Expr)) then
+                        Aitem :=
+                          Make_Pragma (Loc,
+                            Pragma_Argument_Associations => New_List (Ent),
+                            Pragma_Identifier            =>
+                              Make_Identifier (Sloc (Id), Chars (Id)));
 
-                           if Nkind (T) = N_Protected_Type_Declaration
-                             and then A_Id /= Aspect_Dispatching_Domain
-                             and then A_Id /= Aspect_CPU
-                           then
-                              pragma Assert
-                                (Present (Protected_Definition (T)));
+                        Set_From_Aspect_Specification (Aitem, True);
+                        Set_Corresponding_Aspect (Aitem, Aspect);
 
-                              L := Visible_Declarations
-                                     (Protected_Definition (T));
+                     else
+                        goto Continue;
+                     end if;
+                  end if;
 
-                           elsif Nkind (T) = N_Task_Type_Declaration then
-                              if No (Task_Definition (T)) then
-                                 Set_Task_Definition
-                                   (T,
-                                    Make_Task_Definition
-                                      (Sloc (T),
-                                       Visible_Declarations => New_List,
-                                       End_Label => Empty));
-                              end if;
+                  if No (Pragmas_After (Aux)) then
+                     Set_Pragmas_After (Aux, Empty_List);
+                  end if;
 
-                              L := Visible_Declarations (Task_Definition (T));
+                  Append (Aitem, Pragmas_After (Aux));
+                  goto Continue;
+               end;
+            end if;
 
-                           else
-                              raise Program_Error;
-                           end if;
+            --  The evaluation of the aspect is delayed to the freezing point.
+            --  The pragma or attribute clause if there is one is then attached
+            --  to the aspect specification which is placed in the rep item
+            --  list.
 
-                           Prepend (Aitem, To => L);
+            if Delay_Required then
+               if Present (Aitem) then
+                  Set_Is_Delayed_Aspect (Aitem);
+                  Set_Aspect_Rep_Item (Aspect, Aitem);
+                  Set_Parent (Aitem, Aspect);
+               end if;
 
-                           --  Analyze rewritten pragma. Otherwise, its
-                           --  analysis is done too late, after the task or
-                           --  protected object has been created.
+               Set_Is_Delayed_Aspect (Aspect);
+               Set_Has_Delayed_Aspects (E);
+               Record_Rep_Item (E, Aspect);
 
-                           Analyze (Aitem);
-                        end;
+            --  When delay is not required and the context is not a compilation
+            --  unit, we simply insert the pragma/attribute definition clause
+            --  in sequence.
 
-                     --  For all other cases, insert in sequence
-
-                     when others =>
-                        Insert_After (Ins_Node, Aitem);
-                        Ins_Node := Aitem;
-                  end case;
-               end if;
+            else
+               Insert_After (Ins_Node, Aitem);
+               Ins_Node := Aitem;
             end if;
          end;
 
       <<Continue>>
          Next (Aspect);
       end loop Aspect_Loop;
+
+      if Has_Delayed_Aspects (E) then
+         Ensure_Freeze_Node (E);
+      end if;
    end Analyze_Aspect_Specifications;
 
    -----------------------
@@ -2293,18 +2058,29 @@ 
             return False;
          end if;
 
-         --  Otherwise current clause may duplicate previous clause or a
-         --  previously given aspect specification for the same aspect.
+         --  Otherwise current clause may duplicate previous clause, or a
+         --  previously given pragma or aspect specification for the same
+         --  aspect.
 
          A := Get_Rep_Item_For_Entity (U_Ent, Chars (N));
 
          if Present (A) then
-            if Entity (A) = U_Ent then
-               Error_Msg_Name_1 := Chars (N);
-               Error_Msg_Sloc := Sloc (A);
+            Error_Msg_Name_1 := Chars (N);
+            Error_Msg_Sloc := Sloc (A);
+
+            if Nkind (A) = N_Aspect_Specification
+              or else From_Aspect_Specification (A)
+            then
                Error_Msg_NE ("aspect% for & previously given#", N, U_Ent);
-               return True;
+
+            elsif Nkind (A) = N_Pragma then
+               Error_Msg_NE ("clause% for & duplicates pragma#", N, U_Ent);
+
+            else
+               Error_Msg_NE ("clause% for & duplicates clause#", N, U_Ent);
             end if;
+
+            return True;
          end if;
 
          return False;
@@ -2436,9 +2212,13 @@ 
       if Etype (Nam) = Any_Type then
          return;
 
-      --  Must be declared in current scope
+      --  Must be declared in current scope or in case of an aspect
+      --  specification, must be the current scope.
 
-      elsif Scope (Ent) /= Current_Scope then
+      elsif Scope (Ent) /= Current_Scope
+        and then (not From_Aspect_Specification (N)
+                   or else Ent /= Current_Scope)
+      then
          Error_Msg_N ("entity must be declared in this scope", Nam);
          return;
 
@@ -2963,6 +2743,44 @@ 
          when Attribute_Constant_Indexing =>
             Check_Indexing_Functions;
 
+         ---------
+         -- CPU --
+         ---------
+
+         when Attribute_CPU => CPU :
+         begin
+            --  CPU attribute definition clause not allowed except from aspect
+            --  specification.
+
+            if From_Aspect_Specification (N) then
+               if not Is_Task_Type (U_Ent) then
+                  Error_Msg_N ("CPU can only be defined for task", Nam);
+
+               elsif Duplicate_Clause then
+                  null;
+
+               else
+                  --  The expression must be analyzed in the special manner
+                  --  described in "Handling of Default and Per-Object
+                  --  Expressions" in sem.ads.
+
+                  --  The visibility to the discriminants must be restored
+
+                  Push_Scope_And_Install_Discriminants (U_Ent);
+                  Preanalyze_Spec_Expression (Expr, RTE (RE_CPU_Range));
+                  Uninstall_Discriminants_And_Pop_Scope (U_Ent);
+
+                  if not Is_Static_Expression (Expr) then
+                     Check_Restriction (Static_Priorities, Expr);
+                  end if;
+               end if;
+
+            else
+               Error_Msg_N
+                 ("attribute& cannot be set with definition clause", N);
+            end if;
+         end CPU;
+
          ----------------------
          -- Default_Iterator --
          ----------------------
@@ -2996,6 +2814,45 @@ 
             end if;
          end Default_Iterator;
 
+         ------------------------
+         -- Dispatching_Domain --
+         ------------------------
+
+         when Attribute_Dispatching_Domain => Dispatching_Domain :
+         begin
+            --  Dispatching_Domain attribute definition clause not allowed
+            --  except from aspect specification.
+
+            if From_Aspect_Specification (N) then
+               if not Is_Task_Type (U_Ent) then
+                  Error_Msg_N ("Dispatching_Domain can only be defined" &
+                               "for task",
+                               Nam);
+
+               elsif Duplicate_Clause then
+                  null;
+
+               else
+                  --  The expression must be analyzed in the special manner
+                  --  described in "Handling of Default and Per-Object
+                  --  Expressions" in sem.ads.
+
+                  --  The visibility to the discriminants must be restored
+
+                  Push_Scope_And_Install_Discriminants (U_Ent);
+
+                  Preanalyze_Spec_Expression
+                    (Expr, RTE (RE_Dispatching_Domain));
+
+                  Uninstall_Discriminants_And_Pop_Scope (U_Ent);
+               end if;
+
+            else
+               Error_Msg_N
+                 ("attribute& cannot be set with definition clause", N);
+            end if;
+         end Dispatching_Domain;
+
          ------------------
          -- External_Tag --
          ------------------
@@ -3055,6 +2912,48 @@ 
             Analyze_Stream_TSS_Definition (TSS_Stream_Input);
             Set_Has_Specified_Stream_Input (Ent);
 
+         ------------------------
+         -- Interrupt_Priority --
+         ------------------------
+
+         when Attribute_Interrupt_Priority => Interrupt_Priority :
+         begin
+            --  Interrupt_Priority attribute definition clause not allowed
+            --  except from aspect specification.
+
+            if From_Aspect_Specification (N) then
+               if not (Is_Protected_Type (U_Ent)
+                        or else Is_Task_Type (U_Ent))
+               then
+                  Error_Msg_N
+                    ("Interrupt_Priority can only be defined for task" &
+                     "and protected object",
+                     Nam);
+
+               elsif Duplicate_Clause then
+                  null;
+
+               else
+                  --  The expression must be analyzed in the special manner
+                  --  described in "Handling of Default and Per-Object
+                  --  Expressions" in sem.ads.
+
+                  --  The visibility to the discriminants must be restored
+
+                  Push_Scope_And_Install_Discriminants (U_Ent);
+
+                  Preanalyze_Spec_Expression
+                    (Expr, RTE (RE_Interrupt_Priority));
+
+                  Uninstall_Discriminants_And_Pop_Scope (U_Ent);
+               end if;
+
+            else
+               Error_Msg_N
+                 ("attribute& cannot be set with definition clause", N);
+            end if;
+         end Interrupt_Priority;
+
          ----------------------
          -- Iterator_Element --
          ----------------------
@@ -3147,6 +3046,49 @@ 
             Analyze_Stream_TSS_Definition (TSS_Stream_Output);
             Set_Has_Specified_Stream_Output (Ent);
 
+         --------------
+         -- Priority --
+         --------------
+
+         when Attribute_Priority => Priority :
+         begin
+            --  Priority attribute definition clause not allowed except from
+            --  aspect specification.
+
+            if From_Aspect_Specification (N) then
+               if not (Is_Protected_Type (U_Ent)
+                        or else Is_Task_Type (U_Ent))
+               then
+                  Error_Msg_N
+                    ("Priority can only be defined for task and protected" &
+                     "object",
+                     Nam);
+
+               elsif Duplicate_Clause then
+                  null;
+
+               else
+                  --  The expression must be analyzed in the special manner
+                  --  described in "Handling of Default and Per-Object
+                  --  Expressions" in sem.ads.
+
+                  --  The visibility to the discriminants must be restored
+
+                  Push_Scope_And_Install_Discriminants (U_Ent);
+                  Preanalyze_Spec_Expression (Expr, Standard_Integer);
+                  Uninstall_Discriminants_And_Pop_Scope (U_Ent);
+
+                  if not Is_Static_Expression (Expr) then
+                     Check_Restriction (Static_Priorities, Expr);
+                  end if;
+               end if;
+
+            else
+               Error_Msg_N
+                 ("attribute& cannot be set with definition clause", N);
+            end if;
+         end Priority;
+
          ----------
          -- Read --
          ----------
@@ -3508,7 +3450,6 @@ 
 
          when Attribute_Storage_Size => Storage_Size : declare
             Btype : constant Entity_Id := Base_Type (U_Ent);
-            Sprag : Node_Id;
 
          begin
             if Is_Task_Type (U_Ent) then
@@ -3551,16 +3492,6 @@ 
                   then
                      Set_No_Pool_Assigned (Btype);
                   end if;
-
-               else -- Is_Task_Type (U_Ent)
-                  Sprag := Get_Rep_Pragma (Btype, Name_Storage_Size);
-
-                  if Present (Sprag) then
-                     Error_Msg_Sloc := Sloc (Sprag);
-                     Error_Msg_N
-                       ("Storage_Size already specified#", Nam);
-                     return;
-                  end if;
                end if;
 
                Set_Has_Storage_Size_Clause (Btype);
@@ -4221,7 +4152,14 @@ 
       --  the subtype name in the saved expression so that they will not cause
       --  trouble in the preanalysis.
 
-      if Has_Delayed_Aspects (E) then
+      if Has_Delayed_Aspects (E)
+        and then Scope (E) = Current_Scope
+      then
+         --  Retrieve the visibility to the discriminants in order to properly
+         --  analyze the aspects.
+
+         Push_Scope_And_Install_Discriminants (E);
+
          declare
             Ritem : Node_Id;
 
@@ -4233,7 +4171,6 @@ 
                if Nkind (Ritem) = N_Aspect_Specification
                  and then Entity (Ritem) = E
                  and then Is_Delayed_Aspect (Ritem)
-                 and then Scope (E) = Current_Scope
                then
                   Check_Aspect_At_Freeze_Point (Ritem);
                end if;
@@ -4241,6 +4178,8 @@ 
                Next_Rep_Item (Ritem);
             end loop;
          end;
+
+         Uninstall_Discriminants_And_Pop_Scope (E);
       end if;
    end Analyze_Freeze_Entity;
 
@@ -6185,18 +6124,17 @@ 
    procedure Check_Aspect_At_End_Of_Declarations (ASN : Node_Id) is
       Ent   : constant Entity_Id := Entity     (ASN);
       Ident : constant Node_Id   := Identifier (ASN);
+      A_Id  : constant Aspect_Id := Get_Aspect_Id (Chars (Ident));
 
+      End_Decl_Expr : constant Node_Id := Entity (Ident);
+      --  Expression to be analyzed at end of declarations
+
       Freeze_Expr : constant Node_Id := Expression (ASN);
       --  Expression from call to Check_Aspect_At_Freeze_Point
 
-      End_Decl_Expr : constant Node_Id := Entity (Ident);
-      --  Expression to be analyzed at end of declarations
-
       T : constant Entity_Id := Etype (Freeze_Expr);
       --  Type required for preanalyze call
 
-      A_Id : constant Aspect_Id := Get_Aspect_Id (Chars (Ident));
-
       Err : Boolean;
       --  Set False if error
 
@@ -6206,9 +6144,14 @@ 
       --  preanalyzed just after the freeze point.
 
    begin
+      --  Case of aspects Dimension, Dimension_System and Synchronization
+
+      if A_Id = Aspect_Synchronization then
+         return;
+
       --  Case of stream attributes, just have to compare entities
 
-      if A_Id = Aspect_Input  or else
+      elsif A_Id = Aspect_Input  or else
          A_Id = Aspect_Output or else
          A_Id = Aspect_Read   or else
          A_Id = Aspect_Write
@@ -6286,11 +6229,11 @@ 
       Ident : constant Node_Id := Identifier (ASN);
       --  Identifier (use Entity field to save expression)
 
-      T : Entity_Id;
+      A_Id : constant Aspect_Id := Get_Aspect_Id (Chars (Ident));
+
+      T    : Entity_Id := Empty;
       --  Type required for preanalyze call
 
-      A_Id : constant Aspect_Id := Get_Aspect_Id (Chars (Ident));
-
    begin
       --  On entry to this procedure, Entity (Ident) contains a copy of the
       --  original expression from the aspect, saved for this purpose.
@@ -6312,34 +6255,17 @@ 
          when No_Aspect =>
             raise Program_Error;
 
-         --  Library unit aspects should be impossible (never delayed)
+         --  Aspects taking an optional boolean argument.
 
-         when Library_Unit_Aspects =>
-            raise Program_Error;
+         when Boolean_Aspects      |
+              Library_Unit_Aspects =>
+            T := Standard_Boolean;
 
-         --  Aspects taking an optional boolean argument. Should be impossible
-         --  since these are never delayed.
-
-         when Boolean_Aspects =>
-            raise Program_Error;
-
-         --  Contract_Case aspects apply to subprograms, hence should never be
-         --  delayed.
-
-         when Aspect_Contract_Case =>
-            raise Program_Error;
-
-         --  Test_Case aspects apply to entries and subprograms, hence should
-         --  never be delayed.
-
-         when Aspect_Test_Case =>
-            raise Program_Error;
-
          when Aspect_Attach_Handler =>
             T := RTE (RE_Interrupt_ID);
 
          when Aspect_Convention =>
-            null;
+            return;
 
          --  Default_Value is resolved with the type entity in question
 
@@ -6400,13 +6326,19 @@ 
               Aspect_Value_Size     =>
             T := Any_Integer;
 
-         --  Stream attribute. Special case, the expression is just an entity
+         when Aspect_Synchronization =>
+            return;
+
+         --  Special case, the expression of these aspects is just an entity
          --  that does not need any resolution, so just analyze.
 
-         when Aspect_Input  |
-              Aspect_Output |
-              Aspect_Read   |
-              Aspect_Write  =>
+         when Aspect_Input           |
+              Aspect_Output          |
+              Aspect_Read            |
+              Aspect_Suppress        |
+              Aspect_Unsuppress      |
+              Aspect_Warnings        |
+              Aspect_Write           =>
             Analyze (Expression (ASN));
             return;
 
@@ -6416,34 +6348,30 @@ 
          when Aspect_Constant_Indexing    |
               Aspect_Default_Iterator     |
               Aspect_Iterator_Element     |
-              Aspect_Implicit_Dereference |
               Aspect_Variable_Indexing    =>
             Analyze (Expression (ASN));
             return;
 
-         --  Suppress/Unsuppress/Synchronization/Warnings should not be delayed
+         --  Invariant/Predicate take boolean expressions
 
-         when Aspect_Suppress        |
-              Aspect_Unsuppress      |
-              Aspect_Synchronization |
-              Aspect_Warnings        =>
-            raise Program_Error;
-
-         --  Pre/Post/Invariant/Predicate take boolean expressions
-
          when Aspect_Dynamic_Predicate |
               Aspect_Invariant         |
-              Aspect_Pre               |
-              Aspect_Precondition      |
-              Aspect_Post              |
-              Aspect_Postcondition     |
               Aspect_Predicate         |
               Aspect_Static_Predicate  |
               Aspect_Type_Invariant    =>
             T := Standard_Boolean;
 
-         when Aspect_Dimension        |
-              Aspect_Dimension_System =>
+         --  Here is the list of aspects that don't require delay analysis.
+
+         when Aspect_Contract_Case        |
+              Aspect_Dimension            |
+              Aspect_Dimension_System     |
+              Aspect_Implicit_Dereference |
+              Aspect_Post                 |
+              Aspect_Postcondition        |
+              Aspect_Pre                  |
+              Aspect_Precondition         |
+              Aspect_Test_Case     =>
             raise Program_Error;
 
       end case;
@@ -7661,6 +7589,227 @@ 
       end if;
    end Check_Size;
 
+   --------------------------------------
+   -- Evaluate_Aspects_At_Freeze_Point --
+   --------------------------------------
+
+   procedure Evaluate_Aspects_At_Freeze_Point (E : Entity_Id) is
+      ASN   : Node_Id;
+      A_Id  : Aspect_Id;
+      Ritem : Node_Id;
+
+      procedure Analyze_Aspect_Default_Value (ASN : Node_Id);
+      --  This routine analyzes an Aspect_Default_Value or
+      --  Aspect_Default_Component_Value denoted by the aspect specification
+      --  node ASN.
+
+      procedure Make_Pragma_From_Boolean_Aspect (ASN : Node_Id);
+      --  Given an aspect specification node ASN whose expression is an
+      --  optional Boolean, this routines creates the corresponding pragma at
+      --  the freezing point.
+
+      ----------------------------------
+      -- Analyze_Aspect_Default_Value --
+      ----------------------------------
+
+      procedure Analyze_Aspect_Default_Value (ASN : Node_Id) is
+         Ent  : constant Entity_Id := Entity (ASN);
+         Expr : constant Node_Id   := Expression (ASN);
+         Id   : constant Node_Id   := Identifier (ASN);
+
+      begin
+         Error_Msg_Name_1 := Chars (Id);
+
+         if not Is_Type (Ent) then
+            Error_Msg_N ("aspect% can only apply to a type", Id);
+            return;
+
+         elsif not Is_First_Subtype (Ent) then
+            Error_Msg_N ("aspect% cannot apply to subtype", Id);
+            return;
+
+         elsif A_Id = Aspect_Default_Value
+           and then not Is_Scalar_Type (Ent)
+         then
+            Error_Msg_N ("aspect% can only be applied to scalar type", Id);
+            return;
+
+         elsif A_Id = Aspect_Default_Component_Value then
+            if not Is_Array_Type (Ent) then
+               Error_Msg_N ("aspect% can only be applied to array type", Id);
+               return;
+
+            elsif not Is_Scalar_Type (Component_Type (Ent)) then
+               Error_Msg_N ("aspect% requires scalar components", Id);
+               return;
+            end if;
+         end if;
+
+         Set_Has_Default_Aspect (Base_Type (Ent));
+
+         if Is_Scalar_Type (Ent) then
+            Set_Default_Aspect_Value (Ent, Expr);
+         else
+            Set_Default_Aspect_Component_Value (Ent, Expr);
+         end if;
+      end Analyze_Aspect_Default_Value;
+
+      -------------------------------------
+      -- Make_Pragma_From_Boolean_Aspect --
+      -------------------------------------
+
+      procedure Make_Pragma_From_Boolean_Aspect (ASN : Node_Id) is
+         Ident  : constant Node_Id    := Identifier (ASN);
+         A_Name : constant Name_Id    := Chars (Ident);
+         A_Id   : constant Aspect_Id  := Get_Aspect_Id (A_Name);
+         Ent    : constant Entity_Id  := Entity (ASN);
+         Expr   : constant Node_Id    := Expression (ASN);
+         Loc    : constant Source_Ptr := Sloc (ASN);
+
+         Prag : Node_Id;
+
+         procedure Check_False_Aspect_For_Derived_Type;
+         --  This procedure checks for the case of a false aspect for a derived
+         --  type, which improperly tries to cancel an aspect inherited from
+         --  the parent.
+
+         -----------------------------------------
+         -- Check_False_Aspect_For_Derived_Type --
+         -----------------------------------------
+
+         procedure Check_False_Aspect_For_Derived_Type is
+            Par : Node_Id;
+
+         begin
+            --  We are only checking derived types
+
+            if not Is_Derived_Type (E) then
+               return;
+            end if;
+
+            Par := Nearest_Ancestor (E);
+
+            case A_Id is
+               when Aspect_Atomic | Aspect_Shared =>
+                  if not Is_Atomic (Par) then
+                     return;
+                  end if;
+
+               when Aspect_Atomic_Components =>
+                  if not Has_Atomic_Components (Par) then
+                     return;
+                  end if;
+
+               when Aspect_Discard_Names =>
+                  if not Discard_Names (Par) then
+                     return;
+                  end if;
+
+               when Aspect_Pack =>
+                  if not Is_Packed (Par) then
+                     return;
+                  end if;
+
+               when Aspect_Unchecked_Union =>
+                  if not Is_Unchecked_Union (Par) then
+                     return;
+                  end if;
+
+               when Aspect_Volatile =>
+                  if not Is_Volatile (Par) then
+                     return;
+                  end if;
+
+               when Aspect_Volatile_Components =>
+                  if not Has_Volatile_Components (Par) then
+                     return;
+                  end if;
+
+               when others =>
+                  return;
+            end case;
+
+            --  Fall through means we are canceling an inherited aspect
+
+            Error_Msg_Name_1 := A_Name;
+            Error_Msg_NE ("derived type& inherits aspect%, cannot cancel",
+                          Expr,
+                          E);
+
+         end Check_False_Aspect_For_Derived_Type;
+
+      --  Start of processing for Make_Pragma_From_Boolean_Aspect
+
+      begin
+         if Is_False (Static_Boolean (Expr)) then
+            Check_False_Aspect_For_Derived_Type;
+
+         else
+            Prag :=
+              Make_Pragma (Loc,
+                Pragma_Argument_Associations => New_List (
+                  New_Occurrence_Of (Ent, Sloc (Ident))),
+                Pragma_Identifier            =>
+                  Make_Identifier (Sloc (Ident), Chars (Ident)));
+
+            Set_From_Aspect_Specification (Prag, True);
+            Set_Corresponding_Aspect (Prag, ASN);
+            Set_Aspect_Rep_Item (ASN, Prag);
+            Set_Is_Delayed_Aspect (Prag);
+            Set_Parent (Prag, ASN);
+         end if;
+
+      end Make_Pragma_From_Boolean_Aspect;
+
+   --  Start of processing for Evaluate_Aspects_At_Freeze_Point
+
+   begin
+      --  Must be declared in current scope
+
+      if Scope (E) /= Current_Scope then
+         return;
+      end if;
+
+      --  Look for aspect specification entries for this entity
+
+      ASN := First_Rep_Item (E);
+
+      while Present (ASN) loop
+         if Nkind (ASN) = N_Aspect_Specification
+           and then Entity (ASN) = E
+           and then Is_Delayed_Aspect (ASN)
+         then
+            A_Id := Get_Aspect_Id (Chars (Identifier (ASN)));
+
+            case A_Id is
+               --  For aspects whose expression is an optional Boolean, make
+               --  the corresponding pragma at the freezing point.
+
+               when Boolean_Aspects      |
+                    Library_Unit_Aspects =>
+                  Make_Pragma_From_Boolean_Aspect (ASN);
+
+               --  Special handling for aspects that don't correspond to
+               --  pragmas/attributes.
+
+               when Aspect_Default_Value           |
+                    Aspect_Default_Component_Value =>
+                  Analyze_Aspect_Default_Value (ASN);
+
+               when others => null;
+            end case;
+
+            Ritem := Aspect_Rep_Item (ASN);
+
+            if Present (Ritem) then
+               Analyze (Ritem);
+            end if;
+         end if;
+
+         Next_Rep_Item (ASN);
+      end loop;
+   end Evaluate_Aspects_At_Freeze_Point;
+
    -------------------------
    -- Get_Alignment_Value --
    -------------------------
Index: sem_ch13.ads
===================================================================
--- sem_ch13.ads	(revision 188428)
+++ sem_ch13.ads	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2012, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -237,7 +237,7 @@ 
    --  The visibility of aspects is tricky. First, the visibility is delayed
    --  to the freeze point. This is not too complicated, what we do is simply
    --  to leave the aspect "laying in wait" for the freeze point, and at that
-   --  point materialize and analye the corresponding attribute definition
+   --  point materialize and analyze the corresponding attribute definition
    --  clause or pragma. There is some special processing for preconditions
    --  and postonditions, where the pragmas themselves deal with the required
    --  delay, but basically the approach is the same, delay analysis of the
@@ -307,4 +307,8 @@ 
    --  Performs the processing described above at the freeze all point, and
    --  issues appropriate error messages if the visibility has indeed changed.
    --  Again, ASN is the N_Aspect_Specification node for the aspect.
+
+   procedure Evaluate_Aspects_At_Freeze_Point (E : Entity_Id);
+   --  This routines evaluates all the delayed aspects for entity E at freezing
+   --  point.
 end Sem_Ch13;
Index: snames.ads-tmpl
===================================================================
--- snames.ads-tmpl	(revision 188438)
+++ snames.ads-tmpl	(working copy)
@@ -374,7 +374,13 @@ 
    Name_Default_Storage_Pool           : constant Name_Id := N + $; -- Ada 12
    Name_Disable_Atomic_Synchronization : constant Name_Id := N + $; -- GNAT
    Name_Discard_Names                  : constant Name_Id := N + $;
-   Name_Dispatching_Domain             : constant Name_Id := N + $; -- Ada 12
+
+   --  Note: Dispatching_Domain is not in this list because its name matches
+   --  the name of the corresponding attribute. However, it is included in the
+   --  definition of the type Pragma_Id, and the functions Get_Pragma_Id and
+   --  Is_Pragma_Id correctly recognize and process Dispatching_Domain.
+   --  Dispatching_Domain is a standard Ada 2012 pragma.
+
    Name_Elaboration_Checks             : constant Name_Id := N + $; -- GNAT
    Name_Eliminate                      : constant Name_Id := N + $; -- GNAT
    Name_Enable_Atomic_Synchronization  : constant Name_Id := N + $; -- GNAT
@@ -456,7 +462,13 @@ 
    Name_CPP_Constructor                : constant Name_Id := N + $; -- GNAT
    Name_CPP_Virtual                    : constant Name_Id := N + $; -- GNAT
    Name_CPP_Vtable                     : constant Name_Id := N + $; -- GNAT
-   Name_CPU                            : constant Name_Id := N + $; -- Ada 12
+
+   --  Note: CPU is not in this list because its name matches the name of
+   --  the corresponding attribute. However, it is included in the definition
+   --  of the type Pragma_Id, and the functions Get_Pragma_Id and Is_Pragma_Id
+   --  correctly recognize and process CPU. CPU is a standard Ada 2012
+   --  pragma.
+
    Name_Debug                          : constant Name_Id := N + $; -- GNAT
    Name_Elaborate                      : constant Name_Id := N + $; -- Ada 83
    Name_Elaborate_All                  : constant Name_Id := N + $;
@@ -489,11 +501,16 @@ 
    --  Note: Interface is not in this list because its name matches an Ada 05
    --  keyword. However it is included in the definition of the type
    --  Attribute_Id, and the functions Get_Pragma_Id and Is_Pragma_Id correctly
-   --  recognize and process Name_Storage_Size.
+   --  recognize and process Name_Interface.
 
    Name_Interface_Name                 : constant Name_Id := N + $; -- GNAT
    Name_Interrupt_Handler              : constant Name_Id := N + $;
-   Name_Interrupt_Priority             : constant Name_Id := N + $;
+
+   --  Note: Interrupt_Priority is not in this list because its name matches
+   --  the name of the corresponding attribute. However, it is included in the
+   --  definition of the type Pragma_Id, and the functions Get_Pragma_Id and
+   --  Is_Pragma_Id correctly recognize and process Interrupt_Priority.
+
    Name_Invariant                      : constant Name_Id := N + $; -- GNAT
    Name_Java_Constructor               : constant Name_Id := N + $; -- GNAT
    Name_Java_Interface                 : constant Name_Id := N + $; -- GNAT
@@ -754,6 +771,7 @@ 
    Name_Constant_Indexing              : constant Name_Id := N + $; -- GNAT
    Name_Constrained                    : constant Name_Id := N + $;
    Name_Count                          : constant Name_Id := N + $;
+   Name_CPU                            : constant Name_Id := N + $; -- Ada 12
    Name_Default_Bit_Order              : constant Name_Id := N + $; -- GNAT
    Name_Default_Iterator               : constant Name_Id := N + $; -- GNAT
    Name_Definite                       : constant Name_Id := N + $;
@@ -761,6 +779,7 @@ 
    Name_Denorm                         : constant Name_Id := N + $;
    Name_Descriptor_Size                : constant Name_Id := N + $;
    Name_Digits                         : constant Name_Id := N + $;
+   Name_Dispatching_Domain             : constant Name_Id := N + $; -- Ada 12
    Name_Elaborated                     : constant Name_Id := N + $; -- GNAT
    Name_Emax                           : constant Name_Id := N + $; -- Ada 83
    Name_Enabled                        : constant Name_Id := N + $; -- GNAT
@@ -782,6 +801,7 @@ 
    Name_Img                            : constant Name_Id := N + $; -- GNAT
    Name_Implicit_Dereference           : constant Name_Id := N + $; -- GNAT
    Name_Integer_Value                  : constant Name_Id := N + $; -- GNAT
+   Name_Interrupt_Priority             : constant Name_Id := N + $; -- Ada 12
    Name_Invalid_Value                  : constant Name_Id := N + $; -- GNAT
    Name_Iterator_Element               : constant Name_Id := N + $; -- GNAT
    Name_Large                          : constant Name_Id := N + $; -- Ada 83
@@ -1329,6 +1349,7 @@ 
       Attribute_Constant_Indexing,
       Attribute_Constrained,
       Attribute_Count,
+      Attribute_CPU,
       Attribute_Default_Bit_Order,
       Attribute_Default_Iterator,
       Attribute_Definite,
@@ -1336,6 +1357,7 @@ 
       Attribute_Denorm,
       Attribute_Descriptor_Size,
       Attribute_Digits,
+      Attribute_Dispatching_Domain,
       Attribute_Elaborated,
       Attribute_Emax,
       Attribute_Enabled,
@@ -1357,6 +1379,7 @@ 
       Attribute_Img,
       Attribute_Implicit_Dereference,
       Attribute_Integer_Value,
+      Attribute_Interrupt_Priority,
       Attribute_Invalid_Value,
       Attribute_Iterator_Element,
       Attribute_Large,
@@ -1576,7 +1599,6 @@ 
       Pragma_Default_Storage_Pool,
       Pragma_Disable_Atomic_Synchronization,
       Pragma_Discard_Names,
-      Pragma_Dispatching_Domain,
       Pragma_Elaboration_Checks,
       Pragma_Eliminate,
       Pragma_Enable_Atomic_Synchronization,
@@ -1644,7 +1666,6 @@ 
       Pragma_CPP_Constructor,
       Pragma_CPP_Virtual,
       Pragma_CPP_Vtable,
-      Pragma_CPU,
       Pragma_Debug,
       Pragma_Elaborate,
       Pragma_Elaborate_All,
@@ -1675,7 +1696,6 @@ 
       Pragma_Inspection_Point,
       Pragma_Interface_Name,
       Pragma_Interrupt_Handler,
-      Pragma_Interrupt_Priority,
       Pragma_Invariant,
       Pragma_Java_Constructor,
       Pragma_Java_Interface,
@@ -1749,8 +1769,11 @@ 
       --  match existing attribute names.
 
       Pragma_AST_Entry,
+      Pragma_CPU,
+      Pragma_Dispatching_Domain,
       Pragma_Fast_Math,
       Pragma_Interface,
+      Pragma_Interrupt_Priority,
       Pragma_Priority,
       Pragma_Storage_Size,
       Pragma_Storage_Unit,
@@ -1829,8 +1852,9 @@ 
 
    function Is_Pragma_Name (N : Name_Id) return Boolean;
    --  Test to see if the name N is the name of a recognized pragma. Note that
-   --  pragmas AST_Entry, Fast_Math, Priority, Storage_Size, and Storage_Unit
-   --  are recognized as pragmas by this function even though their names are
+   --  pragmas AST_Entry, CPU, Dispatching_Domain, Fast_Math,
+   --  Interrupt_Priority, Priority, Storage_Size, and Storage_Unit are
+   --  recognized as pragmas by this function even though their names are
    --  separate from the other pragma names. For this reason, clients should
    --  always use this function, rather than do range tests on Name_Id values.
 
@@ -1870,9 +1894,9 @@ 
    --  Returns Id of pragma corresponding to given name. Returns Unknown_Pragma
    --  if N is not a name of a known (Ada defined or GNAT-specific) pragma.
    --  Note that the function also works correctly for names of pragmas that
-   --  are not included in the main list of pragma Names (AST_Entry, Priority,
-   --  Storage_Size, and Storage_Unit (e.g. Name_Storage_Size returns
-   --  Pragma_Storage_Size).
+   --  are not included in the main list of pragma Names (AST_Entry, CPU,
+   --  Dispatching_Domain, Interrupt_Priority, Priority, Storage_Size, and
+   --  Storage_Unit (e.g. Name_Storage_Size returns Pragma_Storage_Size).
 
    function Get_Queuing_Policy_Id (N : Name_Id) return Queuing_Policy_Id;
    --  Returns Id of queuing policy corresponding to given name. It is an error
Index: exp_ch3.adb
===================================================================
--- exp_ch3.adb	(revision 188428)
+++ exp_ch3.adb	(working copy)
@@ -2636,6 +2636,99 @@ 
                      Actions := Build_Assignment (Id, Expression (Decl));
                   end if;
 
+               --  CPU, Dispatching_Domain, Priority and Size components are
+               --  filled with the corresponding rep item expression of the
+               --  concurrent type (if any).
+
+               elsif Ekind (Scope (Id)) = E_Record_Type
+                 and then Present (Corresponding_Concurrent_Type (Scope (Id)))
+                 and then (Chars (Id) = Name_uCPU
+                            or else Chars (Id) = Name_uDispatching_Domain
+                            or else Chars (Id) = Name_uPriority)
+               then
+                  declare
+                     Exp   : Node_Id;
+                     Nam   : Name_Id;
+                     Ritem : Node_Id;
+
+                  begin
+                     if Chars (Id) = Name_uCPU then
+                        Nam := Name_CPU;
+
+                     elsif Chars (Id) = Name_uDispatching_Domain then
+                        Nam := Name_Dispatching_Domain;
+
+                     elsif Chars (Id) = Name_uPriority then
+                        Nam := Name_Priority;
+                     end if;
+
+                     --  Get the Rep Item (aspect specification, attribute
+                     --  definition clause or pragma) of the corresponding
+                     --  concurrent type.
+
+                     Ritem :=
+                       Get_Rep_Item
+                         (Corresponding_Concurrent_Type (Scope (Id)), Nam);
+
+                     if Present (Ritem) then
+                        --  Pragma case
+
+                        if Nkind (Ritem) = N_Pragma then
+                           Exp := First (Pragma_Argument_Associations (Ritem));
+
+                           if Nkind (Exp) = N_Pragma_Argument_Association then
+                              Exp := Expression (Exp);
+                           end if;
+
+                           --  Conversion for Priority expression
+
+                           if Nam = Name_Priority then
+                              if Pragma_Name (Ritem) = Name_Priority
+                                and then not GNAT_Mode
+                              then
+                                 Exp := Convert_To (RTE (RE_Priority), Exp);
+                              else
+                                 Exp :=
+                                   Convert_To (RTE (RE_Any_Priority), Exp);
+                              end if;
+                           end if;
+
+                        --  Aspect/Attribute definition clause case
+
+                        else
+                           Exp := Expression (Ritem);
+
+                           --  Conversion for Priority expression
+
+                           if Nam = Name_Priority then
+                              if Chars (Ritem) = Name_Priority
+                                and then not GNAT_Mode
+                              then
+                                 Exp := Convert_To (RTE (RE_Priority), Exp);
+                              else
+                                 Exp :=
+                                   Convert_To (RTE (RE_Any_Priority), Exp);
+                              end if;
+                           end if;
+                        end if;
+
+                        --  Conversion for Dispatching_Domain value
+
+                        if Nam = Name_Dispatching_Domain then
+                           Exp :=
+                             Unchecked_Convert_To
+                               (RTE (RE_Dispatching_Domain_Access), Exp);
+                        end if;
+
+                        Actions := Build_Assignment (Id, Exp);
+
+                     --  Nothing needed if no Rep Item
+
+                     else
+                        Actions := No_List;
+                     end if;
+                  end;
+
                --  Composite component with its own Init_Proc
 
                elsif not Is_Interface (Typ)