Index: par-ch9.adb
===================================================================
--- par-ch9.adb	(revision 165283)
+++ par-ch9.adb	(working copy)
@@ -900,7 +900,7 @@ package body Ch9 is
          Discard_Junk_Node (P_Expression_No_Right_Paren);
       end if;
 
-      TF_Semicolon;
+      P_Aspect_Specifications (Decl_Node);
       return Decl_Node;
 
    exception
Index: sem_ch3.adb
===================================================================
--- sem_ch3.adb	(revision 165295)
+++ sem_ch3.adb	(working copy)
@@ -23,6 +23,7 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
+with Aspects;  use Aspects;
 with Atree;    use Atree;
 with Checks;   use Checks;
 with Debug;    use Debug;
@@ -1113,7 +1114,7 @@ package body Sem_Ch3 is
                else
                   if From_With_Type (Typ) then
 
-                     --  AI05-151 : incomplete types are allowed in all basic
+                     --  AI05-151: Incomplete types are allowed in all basic
                      --  declarations, including access to subprograms.
 
                      if Ada_Version >= Ada_2012 then
@@ -1618,6 +1619,7 @@ package body Sem_Ch3 is
    procedure Analyze_Component_Declaration (N : Node_Id) is
       Id : constant Entity_Id := Defining_Identifier (N);
       E  : constant Node_Id   := Expression (N);
+      AS : constant List_Id   := Aspect_Specifications (N);
       T  : Entity_Id;
       P  : Entity_Id;
 
@@ -1944,6 +1946,7 @@ package body Sem_Ch3 is
       end if;
 
       Set_Original_Record_Component (Id, Id);
+      Analyze_Aspect_Specifications (N, Id, AS);
    end Analyze_Component_Declaration;
 
    --------------------------
@@ -2069,2099 +2072,2112 @@ package body Sem_Ch3 is
       end loop;
    end Analyze_Declarations;
 
-   ----------------------------------
-   -- Analyze_Incomplete_Type_Decl --
-   ----------------------------------
+   -----------------------------------
+   -- Analyze_Full_Type_Declaration --
+   -----------------------------------
 
-   procedure Analyze_Incomplete_Type_Decl (N : Node_Id) is
-      F : constant Boolean := Is_Pure (Current_Scope);
-      T : Entity_Id;
+   procedure Analyze_Full_Type_Declaration (N : Node_Id) is
+      Def    : constant Node_Id   := Type_Definition (N);
+      Def_Id : constant Entity_Id := Defining_Identifier (N);
+      AS     : constant List_Id   := Aspect_Specifications (N);
+      T      : Entity_Id;
+      Prev   : Entity_Id;
 
-   begin
-      Generate_Definition (Defining_Identifier (N));
+      Is_Remote : constant Boolean :=
+                    (Is_Remote_Types (Current_Scope)
+                       or else Is_Remote_Call_Interface (Current_Scope))
+                    and then not (In_Private_Part (Current_Scope)
+                                    or else In_Package_Body (Current_Scope));
 
-      --  Process an incomplete declaration. The identifier must not have been
-      --  declared already in the scope. However, an incomplete declaration may
-      --  appear in the private part of a package, for a private type that has
-      --  already been declared.
+      procedure Check_Ops_From_Incomplete_Type;
+      --  If there is a tagged incomplete partial view of the type, transfer
+      --  its operations to the full view, and indicate that the type of the
+      --  controlling parameter (s) is this full view.
 
-      --  In this case, the discriminants (if any) must match
+      ------------------------------------
+      -- Check_Ops_From_Incomplete_Type --
+      ------------------------------------
 
-      T := Find_Type_Name (N);
+      procedure Check_Ops_From_Incomplete_Type is
+         Elmt   : Elmt_Id;
+         Formal : Entity_Id;
+         Op     : Entity_Id;
 
-      Set_Ekind (T, E_Incomplete_Type);
-      Init_Size_Align (T);
-      Set_Is_First_Subtype (T, True);
-      Set_Etype (T, T);
+      begin
+         if Prev /= T
+           and then Ekind (Prev) = E_Incomplete_Type
+           and then Is_Tagged_Type (Prev)
+           and then Is_Tagged_Type (T)
+         then
+            Elmt := First_Elmt (Primitive_Operations (Prev));
+            while Present (Elmt) loop
+               Op := Node (Elmt);
+               Prepend_Elmt (Op, Primitive_Operations (T));
 
-      --  Ada 2005 (AI-326): Minimum decoration to give support to tagged
-      --  incomplete types.
+               Formal := First_Formal (Op);
+               while Present (Formal) loop
+                  if Etype (Formal) = Prev then
+                     Set_Etype (Formal, T);
+                  end if;
 
-      if Tagged_Present (N) then
-         Set_Is_Tagged_Type (T);
-         Make_Class_Wide_Type (T);
-         Set_Primitive_Operations (T, New_Elmt_List);
-      end if;
+                  Next_Formal (Formal);
+               end loop;
 
-      Push_Scope (T);
+               if Etype (Op) = Prev then
+                  Set_Etype (Op, T);
+               end if;
 
-      Set_Stored_Constraint (T, No_Elist);
+               Next_Elmt (Elmt);
+            end loop;
+         end if;
+      end Check_Ops_From_Incomplete_Type;
 
-      if Present (Discriminant_Specifications (N)) then
-         Process_Discriminants (N);
-      end if;
+   --  Start of processing for Analyze_Full_Type_Declaration
 
-      End_Scope;
+   begin
+      Prev := Find_Type_Name (N);
 
-      --  If the type has discriminants, non-trivial subtypes may be
-      --  declared before the full view of the type. The full views of those
-      --  subtypes will be built after the full view of the type.
+      --  The full view, if present, now points to the current type
 
-      Set_Private_Dependents (T, New_Elmt_List);
-      Set_Is_Pure (T, F);
-   end Analyze_Incomplete_Type_Decl;
+      --  Ada 2005 (AI-50217): If the type was previously decorated when
+      --  imported through a LIMITED WITH clause, it appears as incomplete
+      --  but has no full view.
 
-   -----------------------------------
-   -- Analyze_Interface_Declaration --
-   -----------------------------------
+      --  If the incomplete view is tagged, a class_wide type has been
+      --  created already. Use it for the full view as well, to prevent
+      --  multiple incompatible class-wide types that may be  created for
+      --  self-referential anonymous access components.
 
-   procedure Analyze_Interface_Declaration (T : Entity_Id; Def : Node_Id) is
-      CW : constant Entity_Id := Class_Wide_Type (T);
+      if Ekind (Prev) = E_Incomplete_Type
+        and then Present (Full_View (Prev))
+      then
+         T := Full_View (Prev);
 
-   begin
-      Set_Is_Tagged_Type (T);
+         if Is_Tagged_Type (Prev)
+           and then Present (Class_Wide_Type (Prev))
+         then
+            Set_Ekind (T, Ekind (Prev));         --  will be reset later
+            Set_Class_Wide_Type (T, Class_Wide_Type (Prev));
+            Set_Etype (Class_Wide_Type (T), T);
+         end if;
 
-      Set_Is_Limited_Record (T, Limited_Present (Def)
-                                  or else Task_Present (Def)
-                                  or else Protected_Present (Def)
-                                  or else Synchronized_Present (Def));
+      else
+         T := Prev;
+      end if;
 
-      --  Type is abstract if full declaration carries keyword, or if previous
-      --  partial view did.
+      Set_Is_Pure (T, Is_Pure (Current_Scope));
 
-      Set_Is_Abstract_Type (T);
-      Set_Is_Interface (T);
+      --  We set the flag Is_First_Subtype here. It is needed to set the
+      --  corresponding flag for the Implicit class-wide-type created
+      --  during tagged types processing.
 
-      --  Type is a limited interface if it includes the keyword limited, task,
-      --  protected, or synchronized.
+      Set_Is_First_Subtype (T, True);
 
-      Set_Is_Limited_Interface
-        (T, Limited_Present (Def)
-              or else Protected_Present (Def)
-              or else Synchronized_Present (Def)
-              or else Task_Present (Def));
+      --  Only composite types other than array types are allowed to have
+      --  discriminants.
 
-      Set_Interfaces (T, New_Elmt_List);
-      Set_Primitive_Operations (T, New_Elmt_List);
+      case Nkind (Def) is
 
-      --  Complete the decoration of the class-wide entity if it was already
-      --  built (i.e. during the creation of the limited view)
+         --  For derived types, the rule will be checked once we've figured
+         --  out the parent type.
 
-      if Present (CW) then
-         Set_Is_Interface (CW);
-         Set_Is_Limited_Interface      (CW, Is_Limited_Interface (T));
-      end if;
+         when N_Derived_Type_Definition =>
+            null;
 
-      --  Check runtime support for synchronized interfaces
+         --  For record types, discriminants are allowed
 
-      if VM_Target = No_VM
-        and then (Is_Task_Interface (T)
-                    or else Is_Protected_Interface (T)
-                    or else Is_Synchronized_Interface (T))
-        and then not RTE_Available (RE_Select_Specific_Data)
-      then
-         Error_Msg_CRT ("synchronized interfaces", T);
-      end if;
-   end Analyze_Interface_Declaration;
+         when N_Record_Definition =>
+            null;
 
-   -----------------------------
-   -- Analyze_Itype_Reference --
-   -----------------------------
+         when others =>
+            if Present (Discriminant_Specifications (N)) then
+               Error_Msg_N
+                 ("elementary or array type cannot have discriminants",
+                  Defining_Identifier
+                  (First (Discriminant_Specifications (N))));
+            end if;
+      end case;
 
-   --  Nothing to do. This node is placed in the tree only for the benefit of
-   --  back end processing, and has no effect on the semantic processing.
+      --  Elaborate the type definition according to kind, and generate
+      --  subsidiary (implicit) subtypes where needed. We skip this if it was
+      --  already done (this happens during the reanalysis that follows a call
+      --  to the high level optimizer).
 
-   procedure Analyze_Itype_Reference (N : Node_Id) is
-   begin
-      pragma Assert (Is_Itype (Itype (N)));
-      null;
-   end Analyze_Itype_Reference;
+      if not Analyzed (T) then
+         Set_Analyzed (T);
 
-   --------------------------------
-   -- Analyze_Number_Declaration --
-   --------------------------------
+         case Nkind (Def) is
 
-   procedure Analyze_Number_Declaration (N : Node_Id) is
-      Id    : constant Entity_Id := Defining_Identifier (N);
-      E     : constant Node_Id   := Expression (N);
-      T     : Entity_Id;
-      Index : Interp_Index;
-      It    : Interp;
+            when N_Access_To_Subprogram_Definition =>
+               Access_Subprogram_Declaration (T, Def);
 
-   begin
-      Generate_Definition (Id);
-      Enter_Name (Id);
+               --  If this is a remote access to subprogram, we must create the
+               --  equivalent fat pointer type, and related subprograms.
 
-      --  This is an optimization of a common case of an integer literal
+               if Is_Remote then
+                  Process_Remote_AST_Declaration (N);
+               end if;
 
-      if Nkind (E) = N_Integer_Literal then
-         Set_Is_Static_Expression (E, True);
-         Set_Etype                (E, Universal_Integer);
+               --  Validate categorization rule against access type declaration
+               --  usually a violation in Pure unit, Shared_Passive unit.
 
-         Set_Etype     (Id, Universal_Integer);
-         Set_Ekind     (Id, E_Named_Integer);
-         Set_Is_Frozen (Id, True);
-         return;
-      end if;
+               Validate_Access_Type_Declaration (T, N);
 
-      Set_Is_Pure (Id, Is_Pure (Current_Scope));
+            when N_Access_To_Object_Definition =>
+               Access_Type_Declaration (T, Def);
 
-      --  Process expression, replacing error by integer zero, to avoid
-      --  cascaded errors or aborts further along in the processing
+               --  Validate categorization rule against access type declaration
+               --  usually a violation in Pure unit, Shared_Passive unit.
 
-      --  Replace Error by integer zero, which seems least likely to
-      --  cause cascaded errors.
+               Validate_Access_Type_Declaration (T, N);
 
-      if E = Error then
-         Rewrite (E, Make_Integer_Literal (Sloc (E), Uint_0));
-         Set_Error_Posted (E);
-      end if;
+               --  If we are in a Remote_Call_Interface package and define a
+               --  RACW, then calling stubs and specific stream attributes
+               --  must be added.
 
-      Analyze (E);
+               if Is_Remote
+                 and then Is_Remote_Access_To_Class_Wide_Type (Def_Id)
+               then
+                  Add_RACW_Features (Def_Id);
+               end if;
 
-      --  Verify that the expression is static and numeric. If
-      --  the expression is overloaded, we apply the preference
-      --  rule that favors root numeric types.
+               --  Set no strict aliasing flag if config pragma seen
 
-      if not Is_Overloaded (E) then
-         T := Etype (E);
+               if Opt.No_Strict_Aliasing then
+                  Set_No_Strict_Aliasing (Base_Type (Def_Id));
+               end if;
 
-      else
-         T := Any_Type;
+            when N_Array_Type_Definition =>
+               Array_Type_Declaration (T, Def);
 
-         Get_First_Interp (E, Index, It);
-         while Present (It.Typ) loop
-            if (Is_Integer_Type (It.Typ)
-                 or else Is_Real_Type (It.Typ))
-              and then (Scope (Base_Type (It.Typ))) = Standard_Standard
-            then
-               if T = Any_Type then
-                  T := It.Typ;
-
-               elsif It.Typ = Universal_Real
-                 or else It.Typ = Universal_Integer
-               then
-                  --  Choose universal interpretation over any other
-
-                  T := It.Typ;
-                  exit;
-               end if;
-            end if;
-
-            Get_Next_Interp (Index, It);
-         end loop;
-      end if;
+            when N_Derived_Type_Definition =>
+               Derived_Type_Declaration (T, N, T /= Def_Id);
 
-      if Is_Integer_Type (T)  then
-         Resolve (E, T);
-         Set_Etype (Id, Universal_Integer);
-         Set_Ekind (Id, E_Named_Integer);
+            when N_Enumeration_Type_Definition =>
+               Enumeration_Type_Declaration (T, Def);
 
-      elsif Is_Real_Type (T) then
+            when N_Floating_Point_Definition =>
+               Floating_Point_Type_Declaration (T, Def);
 
-         --  Because the real value is converted to universal_real, this is a
-         --  legal context for a universal fixed expression.
+            when N_Decimal_Fixed_Point_Definition =>
+               Decimal_Fixed_Point_Type_Declaration (T, Def);
 
-         if T = Universal_Fixed then
-            declare
-               Loc  : constant Source_Ptr := Sloc (N);
-               Conv : constant Node_Id := Make_Type_Conversion (Loc,
-                        Subtype_Mark =>
-                          New_Occurrence_Of (Universal_Real, Loc),
-                        Expression => Relocate_Node (E));
+            when N_Ordinary_Fixed_Point_Definition =>
+               Ordinary_Fixed_Point_Type_Declaration (T, Def);
 
-            begin
-               Rewrite (E, Conv);
-               Analyze (E);
-            end;
+            when N_Signed_Integer_Type_Definition =>
+               Signed_Integer_Type_Declaration (T, Def);
 
-         elsif T = Any_Fixed then
-            Error_Msg_N ("illegal context for mixed mode operation", E);
+            when N_Modular_Type_Definition =>
+               Modular_Type_Declaration (T, Def);
 
-            --  Expression is of the form : universal_fixed * integer. Try to
-            --  resolve as universal_real.
+            when N_Record_Definition =>
+               Record_Type_Declaration (T, N, Prev);
 
-            T := Universal_Real;
-            Set_Etype (E, T);
-         end if;
+            --  If declaration has a parse error, nothing to elaborate.
 
-         Resolve (E, T);
-         Set_Etype (Id, Universal_Real);
-         Set_Ekind (Id, E_Named_Real);
+            when N_Error =>
+               null;
 
-      else
-         Wrong_Type (E, Any_Numeric);
-         Resolve (E, T);
+            when others =>
+               raise Program_Error;
 
-         Set_Etype               (Id, T);
-         Set_Ekind               (Id, E_Constant);
-         Set_Never_Set_In_Source (Id, True);
-         Set_Is_True_Constant    (Id, True);
-         return;
+         end case;
       end if;
 
-      if Nkind_In (E, N_Integer_Literal, N_Real_Literal) then
-         Set_Etype (E, Etype (Id));
+      if Etype (T) = Any_Type then
+         goto Leave;
       end if;
 
-      if not Is_OK_Static_Expression (E) then
-         Flag_Non_Static_Expr
-           ("non-static expression used in number declaration!", E);
-         Rewrite (E, Make_Integer_Literal (Sloc (N), 1));
-         Set_Etype (E, Any_Type);
-      end if;
-   end Analyze_Number_Declaration;
+      --  Some common processing for all types
 
-   --------------------------------
-   -- Analyze_Object_Declaration --
-   --------------------------------
+      Set_Depends_On_Private (T, Has_Private_Component (T));
+      Check_Ops_From_Incomplete_Type;
 
-   procedure Analyze_Object_Declaration (N : Node_Id) is
-      Loc   : constant Source_Ptr := Sloc (N);
-      Id    : constant Entity_Id  := Defining_Identifier (N);
-      T     : Entity_Id;
-      Act_T : Entity_Id;
+      --  Both the declared entity, and its anonymous base type if one
+      --  was created, need freeze nodes allocated.
 
-      E : Node_Id := Expression (N);
-      --  E is set to Expression (N) throughout this routine. When
-      --  Expression (N) is modified, E is changed accordingly.
+      declare
+         B : constant Entity_Id := Base_Type (T);
 
-      Prev_Entity : Entity_Id := Empty;
+      begin
+         --  In the case where the base type differs from the first subtype, we
+         --  pre-allocate a freeze node, and set the proper link to the first
+         --  subtype. Freeze_Entity will use this preallocated freeze node when
+         --  it freezes the entity.
 
-      function Count_Tasks (T : Entity_Id) return Uint;
-      --  This function is called when a non-generic library level object of a
-      --  task type is declared. Its function is to count the static number of
-      --  tasks declared within the type (it is only called if Has_Tasks is set
-      --  for T). As a side effect, if an array of tasks with non-static bounds
-      --  or a variant record type is encountered, Check_Restrictions is called
-      --  indicating the count is unknown.
+         --  This does not apply if the base type is a generic type, whose
+         --  declaration is independent of the current derived definition.
 
-      -----------------
-      -- Count_Tasks --
-      -----------------
+         if B /= T and then not Is_Generic_Type (B) then
+            Ensure_Freeze_Node (B);
+            Set_First_Subtype_Link (Freeze_Node (B), T);
+         end if;
 
-      function Count_Tasks (T : Entity_Id) return Uint is
-         C : Entity_Id;
-         X : Node_Id;
-         V : Uint;
+         --  A type that is imported through a limited_with clause cannot
+         --  generate any code, and thus need not be frozen. However, an access
+         --  type with an imported designated type needs a finalization list,
+         --  which may be referenced in some other package that has non-limited
+         --  visibility on the designated type. Thus we must create the
+         --  finalization list at the point the access type is frozen, to
+         --  prevent unsatisfied references at link time.
 
-      begin
-         if Is_Task_Type (T) then
-            return Uint_1;
+         if not From_With_Type (T) or else Is_Access_Type (T) then
+            Set_Has_Delayed_Freeze (T);
+         end if;
+      end;
 
-         elsif Is_Record_Type (T) then
-            if Has_Discriminants (T) then
-               Check_Restriction (Max_Tasks, N);
-               return Uint_0;
+      --  Case where T is the full declaration of some private type which has
+      --  been swapped in Defining_Identifier (N).
 
-            else
-               V := Uint_0;
-               C := First_Component (T);
-               while Present (C) loop
-                  V := V + Count_Tasks (Etype (C));
-                  Next_Component (C);
-               end loop;
+      if T /= Def_Id and then Is_Private_Type (Def_Id) then
+         Process_Full_View (N, T, Def_Id);
 
-               return V;
-            end if;
+         --  Record the reference. The form of this is a little strange, since
+         --  the full declaration has been swapped in. So the first parameter
+         --  here represents the entity to which a reference is made which is
+         --  the "real" entity, i.e. the one swapped in, and the second
+         --  parameter provides the reference location.
 
-         elsif Is_Array_Type (T) then
-            X := First_Index (T);
-            V := Count_Tasks (Component_Type (T));
-            while Present (X) loop
-               C := Etype (X);
+         --  Also, we want to kill Has_Pragma_Unreferenced temporarily here
+         --  since we don't want a complaint about the full type being an
+         --  unwanted reference to the private type
 
-               if not Is_Static_Subtype (C) then
-                  Check_Restriction (Max_Tasks, N);
-                  return Uint_0;
-               else
-                  V := V * (UI_Max (Uint_0,
-                                    Expr_Value (Type_High_Bound (C)) -
-                                    Expr_Value (Type_Low_Bound (C)) + Uint_1));
-               end if;
+         declare
+            B : constant Boolean := Has_Pragma_Unreferenced (T);
+         begin
+            Set_Has_Pragma_Unreferenced (T, False);
+            Generate_Reference (T, T, 'c');
+            Set_Has_Pragma_Unreferenced (T, B);
+         end;
 
-               Next_Index (X);
-            end loop;
+         Set_Completion_Referenced (Def_Id);
 
-            return V;
+      --  For completion of incomplete type, process incomplete dependents
+      --  and always mark the full type as referenced (it is the incomplete
+      --  type that we get for any real reference).
 
-         else
-            return Uint_0;
-         end if;
-      end Count_Tasks;
+      elsif Ekind (Prev) = E_Incomplete_Type then
+         Process_Incomplete_Dependents (N, T, Prev);
+         Generate_Reference (Prev, Def_Id, 'c');
+         Set_Completion_Referenced (Def_Id);
 
-   --  Start of processing for Analyze_Object_Declaration
+      --  If not private type or incomplete type completion, this is a real
+      --  definition of a new entity, so record it.
 
-   begin
-      --  There are three kinds of implicit types generated by an
-      --  object declaration:
+      else
+         Generate_Definition (Def_Id);
+      end if;
 
-      --   1. Those for generated by the original Object Definition
+      if Chars (Scope (Def_Id)) = Name_System
+        and then Chars (Def_Id) = Name_Address
+        and then Is_Predefined_File_Name (Unit_File_Name (Get_Source_Unit (N)))
+      then
+         Set_Is_Descendent_Of_Address (Def_Id);
+         Set_Is_Descendent_Of_Address (Base_Type (Def_Id));
+         Set_Is_Descendent_Of_Address (Prev);
+      end if;
 
-      --   2. Those generated by the Expression
+      Set_Optimize_Alignment_Flags (Def_Id);
+      Check_Eliminated (Def_Id);
 
-      --   3. Those used to constrained the Object Definition with the
-      --       expression constraints when it is unconstrained
+      <<Leave>> Analyze_Aspect_Specifications (N, Def_Id, AS);
+   end Analyze_Full_Type_Declaration;
 
-      --  They must be generated in this order to avoid order of elaboration
-      --  issues. Thus the first step (after entering the name) is to analyze
-      --  the object definition.
+   ----------------------------------
+   -- Analyze_Incomplete_Type_Decl --
+   ----------------------------------
 
-      if Constant_Present (N) then
-         Prev_Entity := Current_Entity_In_Scope (Id);
+   procedure Analyze_Incomplete_Type_Decl (N : Node_Id) is
+      F : constant Boolean := Is_Pure (Current_Scope);
+      T : Entity_Id;
 
-         if Present (Prev_Entity)
-           and then
-             --  If the homograph is an implicit subprogram, it is overridden
-             --  by the current declaration.
+   begin
+      Generate_Definition (Defining_Identifier (N));
 
-             ((Is_Overloadable (Prev_Entity)
-                and then Is_Inherited_Operation (Prev_Entity))
+      --  Process an incomplete declaration. The identifier must not have been
+      --  declared already in the scope. However, an incomplete declaration may
+      --  appear in the private part of a package, for a private type that has
+      --  already been declared.
 
-               --  The current object is a discriminal generated for an entry
-               --  family index. Even though the index is a constant, in this
-               --  particular context there is no true constant redeclaration.
-               --  Enter_Name will handle the visibility.
+      --  In this case, the discriminants (if any) must match
 
-               or else
-                (Is_Discriminal (Id)
-                   and then Ekind (Discriminal_Link (Id)) =
-                              E_Entry_Index_Parameter)
+      T := Find_Type_Name (N);
 
-               --  The current object is the renaming for a generic declared
-               --  within the instance.
+      Set_Ekind (T, E_Incomplete_Type);
+      Init_Size_Align (T);
+      Set_Is_First_Subtype (T, True);
+      Set_Etype (T, T);
 
-               or else
-                (Ekind (Prev_Entity) = E_Package
-                  and then Nkind (Parent (Prev_Entity)) =
-                                         N_Package_Renaming_Declaration
-                  and then not Comes_From_Source (Prev_Entity)
-                  and then Is_Generic_Instance (Renamed_Entity (Prev_Entity))))
-         then
-            Prev_Entity := Empty;
-         end if;
+      --  Ada 2005 (AI-326): Minimum decoration to give support to tagged
+      --  incomplete types.
+
+      if Tagged_Present (N) then
+         Set_Is_Tagged_Type (T);
+         Make_Class_Wide_Type (T);
+         Set_Primitive_Operations (T, New_Elmt_List);
       end if;
 
-      if Present (Prev_Entity) then
-         Constant_Redeclaration (Id, N, T);
+      Push_Scope (T);
 
-         Generate_Reference (Prev_Entity, Id, 'c');
-         Set_Completion_Referenced (Id);
+      Set_Stored_Constraint (T, No_Elist);
 
-         if Error_Posted (N) then
+      if Present (Discriminant_Specifications (N)) then
+         Process_Discriminants (N);
+      end if;
 
-            --  Type mismatch or illegal redeclaration, Do not analyze
-            --  expression to avoid cascaded errors.
+      End_Scope;
 
-            T := Find_Type_Of_Object (Object_Definition (N), N);
-            Set_Etype (Id, T);
-            Set_Ekind (Id, E_Variable);
-            return;
-         end if;
+      --  If the type has discriminants, non-trivial subtypes may be
+      --  declared before the full view of the type. The full views of those
+      --  subtypes will be built after the full view of the type.
 
-      --  In the normal case, enter identifier at the start to catch premature
-      --  usage in the initialization expression.
+      Set_Private_Dependents (T, New_Elmt_List);
+      Set_Is_Pure (T, F);
+   end Analyze_Incomplete_Type_Decl;
 
-      else
-         Generate_Definition (Id);
-         Enter_Name (Id);
+   -----------------------------------
+   -- Analyze_Interface_Declaration --
+   -----------------------------------
 
-         Mark_Coextensions (N, Object_Definition (N));
+   procedure Analyze_Interface_Declaration (T : Entity_Id; Def : Node_Id) is
+      CW : constant Entity_Id := Class_Wide_Type (T);
 
-         T := Find_Type_Of_Object (Object_Definition (N), N);
+   begin
+      Set_Is_Tagged_Type (T);
 
-         if Nkind (Object_Definition (N)) = N_Access_Definition
-           and then Present
-             (Access_To_Subprogram_Definition (Object_Definition (N)))
-           and then Protected_Present
-             (Access_To_Subprogram_Definition (Object_Definition (N)))
-         then
-            T := Replace_Anonymous_Access_To_Protected_Subprogram (N);
-         end if;
+      Set_Is_Limited_Record (T, Limited_Present (Def)
+                                  or else Task_Present (Def)
+                                  or else Protected_Present (Def)
+                                  or else Synchronized_Present (Def));
 
-         if Error_Posted (Id) then
-            Set_Etype (Id, T);
-            Set_Ekind (Id, E_Variable);
-            return;
-         end if;
-      end if;
+      --  Type is abstract if full declaration carries keyword, or if previous
+      --  partial view did.
 
-      --  Ada 2005 (AI-231): Propagate the null-excluding attribute and carry
-      --  out some static checks
+      Set_Is_Abstract_Type (T);
+      Set_Is_Interface (T);
 
-      if Ada_Version >= Ada_2005
-        and then Can_Never_Be_Null (T)
-      then
-         --  In case of aggregates we must also take care of the correct
-         --  initialization of nested aggregates bug this is done at the
-         --  point of the analysis of the aggregate (see sem_aggr.adb)
+      --  Type is a limited interface if it includes the keyword limited, task,
+      --  protected, or synchronized.
 
-         if Present (Expression (N))
-           and then Nkind (Expression (N)) = N_Aggregate
-         then
-            null;
+      Set_Is_Limited_Interface
+        (T, Limited_Present (Def)
+              or else Protected_Present (Def)
+              or else Synchronized_Present (Def)
+              or else Task_Present (Def));
 
-         else
-            declare
-               Save_Typ : constant Entity_Id := Etype (Id);
-            begin
-               Set_Etype (Id, T); --  Temp. decoration for static checks
-               Null_Exclusion_Static_Checks (N);
-               Set_Etype (Id, Save_Typ);
-            end;
-         end if;
-      end if;
+      Set_Interfaces (T, New_Elmt_List);
+      Set_Primitive_Operations (T, New_Elmt_List);
 
-      Set_Is_Pure (Id, Is_Pure (Current_Scope));
+      --  Complete the decoration of the class-wide entity if it was already
+      --  built (i.e. during the creation of the limited view)
 
-      --  If deferred constant, make sure context is appropriate. We detect
-      --  a deferred constant as a constant declaration with no expression.
-      --  A deferred constant can appear in a package body if its completion
-      --  is by means of an interface pragma.
+      if Present (CW) then
+         Set_Is_Interface (CW);
+         Set_Is_Limited_Interface      (CW, Is_Limited_Interface (T));
+      end if;
 
-      if Constant_Present (N)
-        and then No (E)
+      --  Check runtime support for synchronized interfaces
+
+      if VM_Target = No_VM
+        and then (Is_Task_Interface (T)
+                    or else Is_Protected_Interface (T)
+                    or else Is_Synchronized_Interface (T))
+        and then not RTE_Available (RE_Select_Specific_Data)
       then
-         --  A deferred constant may appear in the declarative part of the
-         --  following constructs:
+         Error_Msg_CRT ("synchronized interfaces", T);
+      end if;
+   end Analyze_Interface_Declaration;
 
-         --     blocks
-         --     entry bodies
-         --     extended return statements
-         --     package specs
-         --     package bodies
-         --     subprogram bodies
-         --     task bodies
+   -----------------------------
+   -- Analyze_Itype_Reference --
+   -----------------------------
 
-         --  When declared inside a package spec, a deferred constant must be
-         --  completed by a full constant declaration or pragma Import. In all
-         --  other cases, the only proper completion is pragma Import. Extended
-         --  return statements are flagged as invalid contexts because they do
-         --  not have a declarative part and so cannot accommodate the pragma.
+   --  Nothing to do. This node is placed in the tree only for the benefit of
+   --  back end processing, and has no effect on the semantic processing.
 
-         if Ekind (Current_Scope) = E_Return_Statement then
-            Error_Msg_N
-              ("invalid context for deferred constant declaration (RM 7.4)",
-               N);
-            Error_Msg_N
-              ("\declaration requires an initialization expression",
-                N);
-            Set_Constant_Present (N, False);
+   procedure Analyze_Itype_Reference (N : Node_Id) is
+   begin
+      pragma Assert (Is_Itype (Itype (N)));
+      null;
+   end Analyze_Itype_Reference;
 
-         --  In Ada 83, deferred constant must be of private type
+   --------------------------------
+   -- Analyze_Number_Declaration --
+   --------------------------------
 
-         elsif not Is_Private_Type (T) then
-            if Ada_Version = Ada_83 and then Comes_From_Source (N) then
-               Error_Msg_N
-                 ("(Ada 83) deferred constant must be private type", N);
-            end if;
-         end if;
+   procedure Analyze_Number_Declaration (N : Node_Id) is
+      Id    : constant Entity_Id := Defining_Identifier (N);
+      E     : constant Node_Id   := Expression (N);
+      T     : Entity_Id;
+      Index : Interp_Index;
+      It    : Interp;
 
-      --  If not a deferred constant, then object declaration freezes its type
+   begin
+      Generate_Definition (Id);
+      Enter_Name (Id);
 
-      else
-         Check_Fully_Declared (T, N);
-         Freeze_Before (N, T);
-      end if;
+      --  This is an optimization of a common case of an integer literal
 
-      --  If the object was created by a constrained array definition, then
-      --  set the link in both the anonymous base type and anonymous subtype
-      --  that are built to represent the array type to point to the object.
+      if Nkind (E) = N_Integer_Literal then
+         Set_Is_Static_Expression (E, True);
+         Set_Etype                (E, Universal_Integer);
 
-      if Nkind (Object_Definition (Declaration_Node (Id))) =
-                        N_Constrained_Array_Definition
-      then
-         Set_Related_Array_Object (T, Id);
-         Set_Related_Array_Object (Base_Type (T), Id);
+         Set_Etype     (Id, Universal_Integer);
+         Set_Ekind     (Id, E_Named_Integer);
+         Set_Is_Frozen (Id, True);
+         return;
       end if;
 
-      --  Special checks for protected objects not at library level
-
-      if Is_Protected_Type (T)
-        and then not Is_Library_Level_Entity (Id)
-      then
-         Check_Restriction (No_Local_Protected_Objects, Id);
+      Set_Is_Pure (Id, Is_Pure (Current_Scope));
 
-         --  Protected objects with interrupt handlers must be at library level
+      --  Process expression, replacing error by integer zero, to avoid
+      --  cascaded errors or aborts further along in the processing
 
-         --  Ada 2005: this test is not needed (and the corresponding clause
-         --  in the RM is removed) because accessibility checks are sufficient
-         --  to make handlers not at the library level illegal.
+      --  Replace Error by integer zero, which seems least likely to
+      --  cause cascaded errors.
 
-         if Has_Interrupt_Handler (T)
-           and then Ada_Version < Ada_2005
-         then
-            Error_Msg_N
-              ("interrupt object can only be declared at library level", Id);
-         end if;
+      if E = Error then
+         Rewrite (E, Make_Integer_Literal (Sloc (E), Uint_0));
+         Set_Error_Posted (E);
       end if;
 
-      --  The actual subtype of the object is the nominal subtype, unless
-      --  the nominal one is unconstrained and obtained from the expression.
-
-      Act_T := T;
+      Analyze (E);
 
-      --  Process initialization expression if present and not in error
+      --  Verify that the expression is static and numeric. If
+      --  the expression is overloaded, we apply the preference
+      --  rule that favors root numeric types.
 
-      if Present (E) and then E /= Error then
+      if not Is_Overloaded (E) then
+         T := Etype (E);
 
-         --  Generate an error in case of CPP class-wide object initialization.
-         --  Required because otherwise the expansion of the class-wide
-         --  assignment would try to use 'size to initialize the object
-         --  (primitive that is not available in CPP tagged types).
+      else
+         T := Any_Type;
 
-         if Is_Class_Wide_Type (Act_T)
-           and then
-             (Is_CPP_Class (Root_Type (Etype (Act_T)))
-               or else
-                 (Present (Full_View (Root_Type (Etype (Act_T))))
-                    and then
-                      Is_CPP_Class (Full_View (Root_Type (Etype (Act_T))))))
-         then
-            Error_Msg_N
-              ("predefined assignment not available for 'C'P'P tagged types",
-               E);
-         end if;
-
-         Mark_Coextensions (N, E);
-         Analyze (E);
-
-         --  In case of errors detected in the analysis of the expression,
-         --  decorate it with the expected type to avoid cascaded errors
-
-         if No (Etype (E)) then
-            Set_Etype (E, T);
-         end if;
-
-         --  If an initialization expression is present, then we set the
-         --  Is_True_Constant flag. It will be reset if this is a variable
-         --  and it is indeed modified.
-
-         Set_Is_True_Constant (Id, True);
+         Get_First_Interp (E, Index, It);
+         while Present (It.Typ) loop
+            if (Is_Integer_Type (It.Typ)
+                 or else Is_Real_Type (It.Typ))
+              and then (Scope (Base_Type (It.Typ))) = Standard_Standard
+            then
+               if T = Any_Type then
+                  T := It.Typ;
 
-         --  If we are analyzing a constant declaration, set its completion
-         --  flag after analyzing and resolving the expression.
+               elsif It.Typ = Universal_Real
+                 or else It.Typ = Universal_Integer
+               then
+                  --  Choose universal interpretation over any other
 
-         if Constant_Present (N) then
-            Set_Has_Completion (Id);
-         end if;
+                  T := It.Typ;
+                  exit;
+               end if;
+            end if;
 
-         --  Set type and resolve (type may be overridden later on)
+            Get_Next_Interp (Index, It);
+         end loop;
+      end if;
 
-         Set_Etype (Id, T);
+      if Is_Integer_Type (T)  then
          Resolve (E, T);
+         Set_Etype (Id, Universal_Integer);
+         Set_Ekind (Id, E_Named_Integer);
 
-         --  If E is null and has been replaced by an N_Raise_Constraint_Error
-         --  node (which was marked already-analyzed), we need to set the type
-         --  to something other than Any_Access in order to keep gigi happy.
-
-         if Etype (E) = Any_Access then
-            Set_Etype (E, T);
-         end if;
-
-         --  If the object is an access to variable, the initialization
-         --  expression cannot be an access to constant.
+      elsif Is_Real_Type (T) then
 
-         if Is_Access_Type (T)
-           and then not Is_Access_Constant (T)
-           and then Is_Access_Type (Etype (E))
-           and then Is_Access_Constant (Etype (E))
-         then
-            Error_Msg_N
-              ("access to variable cannot be initialized "
-               & "with an access-to-constant expression", E);
-         end if;
+         --  Because the real value is converted to universal_real, this is a
+         --  legal context for a universal fixed expression.
 
-         if not Assignment_OK (N) then
-            Check_Initialization (T, E);
-         end if;
+         if T = Universal_Fixed then
+            declare
+               Loc  : constant Source_Ptr := Sloc (N);
+               Conv : constant Node_Id := Make_Type_Conversion (Loc,
+                        Subtype_Mark =>
+                          New_Occurrence_Of (Universal_Real, Loc),
+                        Expression => Relocate_Node (E));
 
-         Check_Unset_Reference (E);
+            begin
+               Rewrite (E, Conv);
+               Analyze (E);
+            end;
 
-         --  If this is a variable, then set current value. If this is a
-         --  declared constant of a scalar type with a static expression,
-         --  indicate that it is always valid.
+         elsif T = Any_Fixed then
+            Error_Msg_N ("illegal context for mixed mode operation", E);
 
-         if not Constant_Present (N) then
-            if Compile_Time_Known_Value (E) then
-               Set_Current_Value (Id, E);
-            end if;
+            --  Expression is of the form : universal_fixed * integer. Try to
+            --  resolve as universal_real.
 
-         elsif Is_Scalar_Type (T)
-           and then Is_OK_Static_Expression (E)
-         then
-            Set_Is_Known_Valid (Id);
+            T := Universal_Real;
+            Set_Etype (E, T);
          end if;
 
-         --  Deal with setting of null flags
+         Resolve (E, T);
+         Set_Etype (Id, Universal_Real);
+         Set_Ekind (Id, E_Named_Real);
 
-         if Is_Access_Type (T) then
-            if Known_Non_Null (E) then
-               Set_Is_Known_Non_Null (Id, True);
-            elsif Known_Null (E)
-              and then not Can_Never_Be_Null (Id)
-            then
-               Set_Is_Known_Null (Id, True);
-            end if;
-         end if;
+      else
+         Wrong_Type (E, Any_Numeric);
+         Resolve (E, T);
 
-         --  Check incorrect use of dynamically tagged expressions.
+         Set_Etype               (Id, T);
+         Set_Ekind               (Id, E_Constant);
+         Set_Never_Set_In_Source (Id, True);
+         Set_Is_True_Constant    (Id, True);
+         return;
+      end if;
 
-         if Is_Tagged_Type (T) then
-            Check_Dynamically_Tagged_Expression
-              (Expr        => E,
-               Typ         => T,
-               Related_Nod => N);
-         end if;
+      if Nkind_In (E, N_Integer_Literal, N_Real_Literal) then
+         Set_Etype (E, Etype (Id));
+      end if;
 
-         Apply_Scalar_Range_Check (E, T);
-         Apply_Static_Length_Check (E, T);
+      if not Is_OK_Static_Expression (E) then
+         Flag_Non_Static_Expr
+           ("non-static expression used in number declaration!", E);
+         Rewrite (E, Make_Integer_Literal (Sloc (N), 1));
+         Set_Etype (E, Any_Type);
       end if;
+   end Analyze_Number_Declaration;
 
-      --  If the No_Streams restriction is set, check that the type of the
-      --  object is not, and does not contain, any subtype derived from
-      --  Ada.Streams.Root_Stream_Type. Note that we guard the call to
-      --  Has_Stream just for efficiency reasons. There is no point in
-      --  spending time on a Has_Stream check if the restriction is not set.
+   --------------------------------
+   -- Analyze_Object_Declaration --
+   --------------------------------
 
-      if Restriction_Check_Required (No_Streams) then
-         if Has_Stream (T) then
-            Check_Restriction (No_Streams, N);
-         end if;
-      end if;
+   procedure Analyze_Object_Declaration (N : Node_Id) is
+      Loc   : constant Source_Ptr := Sloc (N);
+      Id    : constant Entity_Id  := Defining_Identifier (N);
+      AS    : constant List_Id    := Aspect_Specifications (N);
+      T     : Entity_Id;
+      Act_T : Entity_Id;
 
-      --  Case of unconstrained type
+      E : Node_Id := Expression (N);
+      --  E is set to Expression (N) throughout this routine. When
+      --  Expression (N) is modified, E is changed accordingly.
 
-      if Is_Indefinite_Subtype (T) then
+      Prev_Entity : Entity_Id := Empty;
 
-         --  Nothing to do in deferred constant case
+      function Count_Tasks (T : Entity_Id) return Uint;
+      --  This function is called when a non-generic library level object of a
+      --  task type is declared. Its function is to count the static number of
+      --  tasks declared within the type (it is only called if Has_Tasks is set
+      --  for T). As a side effect, if an array of tasks with non-static bounds
+      --  or a variant record type is encountered, Check_Restrictions is called
+      --  indicating the count is unknown.
 
-         if Constant_Present (N) and then No (E) then
-            null;
+      -----------------
+      -- Count_Tasks --
+      -----------------
 
-         --  Case of no initialization present
+      function Count_Tasks (T : Entity_Id) return Uint is
+         C : Entity_Id;
+         X : Node_Id;
+         V : Uint;
 
-         elsif No (E) then
-            if No_Initialization (N) then
-               null;
+      begin
+         if Is_Task_Type (T) then
+            return Uint_1;
 
-            elsif Is_Class_Wide_Type (T) then
-               Error_Msg_N
-                 ("initialization required in class-wide declaration ", N);
+         elsif Is_Record_Type (T) then
+            if Has_Discriminants (T) then
+               Check_Restriction (Max_Tasks, N);
+               return Uint_0;
 
             else
-               Error_Msg_N
-                 ("unconstrained subtype not allowed (need initialization)",
-                  Object_Definition (N));
+               V := Uint_0;
+               C := First_Component (T);
+               while Present (C) loop
+                  V := V + Count_Tasks (Etype (C));
+                  Next_Component (C);
+               end loop;
 
-               if Is_Record_Type (T) and then Has_Discriminants (T) then
-                  Error_Msg_N
-                    ("\provide initial value or explicit discriminant values",
-                     Object_Definition (N));
+               return V;
+            end if;
 
-                  Error_Msg_NE
-                    ("\or give default discriminant values for type&",
-                     Object_Definition (N), T);
+         elsif Is_Array_Type (T) then
+            X := First_Index (T);
+            V := Count_Tasks (Component_Type (T));
+            while Present (X) loop
+               C := Etype (X);
 
-               elsif Is_Array_Type (T) then
-                  Error_Msg_N
-                    ("\provide initial value or explicit array bounds",
-                     Object_Definition (N));
+               if not Is_Static_Subtype (C) then
+                  Check_Restriction (Max_Tasks, N);
+                  return Uint_0;
+               else
+                  V := V * (UI_Max (Uint_0,
+                                    Expr_Value (Type_High_Bound (C)) -
+                                    Expr_Value (Type_Low_Bound (C)) + Uint_1));
                end if;
-            end if;
-
-         --  Case of initialization present but in error. Set initial
-         --  expression as absent (but do not make above complaints)
 
-         elsif E = Error then
-            Set_Expression (N, Empty);
-            E := Empty;
+               Next_Index (X);
+            end loop;
 
-         --  Case of initialization present
+            return V;
 
          else
-            --  Not allowed in Ada 83
+            return Uint_0;
+         end if;
+      end Count_Tasks;
 
-            if not Constant_Present (N) then
-               if Ada_Version = Ada_83
-                 and then Comes_From_Source (Object_Definition (N))
-               then
-                  Error_Msg_N
-                    ("(Ada 83) unconstrained variable not allowed",
-                     Object_Definition (N));
-               end if;
-            end if;
+   --  Start of processing for Analyze_Object_Declaration
 
-            --  Now we constrain the variable from the initializing expression
+   begin
+      --  There are three kinds of implicit types generated by an
+      --  object declaration:
 
-            --  If the expression is an aggregate, it has been expanded into
-            --  individual assignments. Retrieve the actual type from the
-            --  expanded construct.
+      --   1. Those for generated by the original Object Definition
 
-            if Is_Array_Type (T)
-              and then No_Initialization (N)
-              and then Nkind (Original_Node (E)) = N_Aggregate
-            then
-               Act_T := Etype (E);
+      --   2. Those generated by the Expression
 
-            --  In case of class-wide interface object declarations we delay
-            --  the generation of the equivalent record type declarations until
-            --  its expansion because there are cases in they are not required.
+      --   3. Those used to constrained the Object Definition with the
+      --       expression constraints when it is unconstrained
 
-            elsif Is_Interface (T) then
-               null;
+      --  They must be generated in this order to avoid order of elaboration
+      --  issues. Thus the first step (after entering the name) is to analyze
+      --  the object definition.
 
-            else
-               Expand_Subtype_From_Expr (N, T, Object_Definition (N), E);
-               Act_T := Find_Type_Of_Object (Object_Definition (N), N);
-            end if;
+      if Constant_Present (N) then
+         Prev_Entity := Current_Entity_In_Scope (Id);
 
-            Set_Is_Constr_Subt_For_U_Nominal (Act_T);
+         if Present (Prev_Entity)
+           and then
+             --  If the homograph is an implicit subprogram, it is overridden
+             --  by the current declaration.
 
-            if Aliased_Present (N) then
-               Set_Is_Constr_Subt_For_UN_Aliased (Act_T);
-            end if;
+             ((Is_Overloadable (Prev_Entity)
+                and then Is_Inherited_Operation (Prev_Entity))
 
-            Freeze_Before (N, Act_T);
-            Freeze_Before (N, T);
-         end if;
+               --  The current object is a discriminal generated for an entry
+               --  family index. Even though the index is a constant, in this
+               --  particular context there is no true constant redeclaration.
+               --  Enter_Name will handle the visibility.
 
-      elsif Is_Array_Type (T)
-        and then No_Initialization (N)
-        and then Nkind (Original_Node (E)) = N_Aggregate
-      then
-         if not Is_Entity_Name (Object_Definition (N)) then
-            Act_T := Etype (E);
-            Check_Compile_Time_Size (Act_T);
+               or else
+                (Is_Discriminal (Id)
+                   and then Ekind (Discriminal_Link (Id)) =
+                              E_Entry_Index_Parameter)
 
-            if Aliased_Present (N) then
-               Set_Is_Constr_Subt_For_UN_Aliased (Act_T);
-            end if;
+               --  The current object is the renaming for a generic declared
+               --  within the instance.
+
+               or else
+                (Ekind (Prev_Entity) = E_Package
+                  and then Nkind (Parent (Prev_Entity)) =
+                                         N_Package_Renaming_Declaration
+                  and then not Comes_From_Source (Prev_Entity)
+                  and then Is_Generic_Instance (Renamed_Entity (Prev_Entity))))
+         then
+            Prev_Entity := Empty;
          end if;
+      end if;
 
-         --  When the given object definition and the aggregate are specified
-         --  independently, and their lengths might differ do a length check.
-         --  This cannot happen if the aggregate is of the form (others =>...)
+      if Present (Prev_Entity) then
+         Constant_Redeclaration (Id, N, T);
 
-         if not Is_Constrained (T) then
-            null;
+         Generate_Reference (Prev_Entity, Id, 'c');
+         Set_Completion_Referenced (Id);
 
-         elsif Nkind (E) = N_Raise_Constraint_Error then
+         if Error_Posted (N) then
 
-            --  Aggregate is statically illegal. Place back in declaration
+            --  Type mismatch or illegal redeclaration, Do not analyze
+            --  expression to avoid cascaded errors.
 
-            Set_Expression (N, E);
-            Set_No_Initialization (N, False);
+            T := Find_Type_Of_Object (Object_Definition (N), N);
+            Set_Etype (Id, T);
+            Set_Ekind (Id, E_Variable);
+            goto Leave;
+         end if;
 
-         elsif T = Etype (E) then
-            null;
+      --  In the normal case, enter identifier at the start to catch premature
+      --  usage in the initialization expression.
 
-         elsif Nkind (E) = N_Aggregate
-           and then Present (Component_Associations (E))
-           and then Present (Choices (First (Component_Associations (E))))
-           and then Nkind (First
-            (Choices (First (Component_Associations (E))))) = N_Others_Choice
-         then
-            null;
+      else
+         Generate_Definition (Id);
+         Enter_Name (Id);
 
-         else
-            Apply_Length_Check (E, T);
-         end if;
+         Mark_Coextensions (N, Object_Definition (N));
 
-      --  If the type is limited unconstrained with defaulted discriminants and
-      --  there is no expression, then the object is constrained by the
-      --  defaults, so it is worthwhile building the corresponding subtype.
+         T := Find_Type_Of_Object (Object_Definition (N), N);
 
-      elsif (Is_Limited_Record (T) or else Is_Concurrent_Type (T))
-        and then not Is_Constrained (T)
-        and then Has_Discriminants (T)
-      then
-         if No (E) then
-            Act_T := Build_Default_Subtype (T, N);
-         else
-            --  Ada 2005:  a limited object may be initialized by means of an
-            --  aggregate. If the type has default discriminants it has an
-            --  unconstrained nominal type, Its actual subtype will be obtained
-            --  from the aggregate, and not from the default discriminants.
+         if Nkind (Object_Definition (N)) = N_Access_Definition
+           and then Present
+             (Access_To_Subprogram_Definition (Object_Definition (N)))
+           and then Protected_Present
+             (Access_To_Subprogram_Definition (Object_Definition (N)))
+         then
+            T := Replace_Anonymous_Access_To_Protected_Subprogram (N);
+         end if;
 
-            Act_T := Etype (E);
+         if Error_Posted (Id) then
+            Set_Etype (Id, T);
+            Set_Ekind (Id, E_Variable);
+            goto Leave;
          end if;
+      end if;
 
-         Rewrite (Object_Definition (N), New_Occurrence_Of (Act_T, Loc));
+      --  Ada 2005 (AI-231): Propagate the null-excluding attribute and carry
+      --  out some static checks
 
-      elsif Present (Underlying_Type (T))
-        and then not Is_Constrained (Underlying_Type (T))
-        and then Has_Discriminants (Underlying_Type (T))
-        and then Nkind (E) = N_Function_Call
-        and then Constant_Present (N)
+      if Ada_Version >= Ada_2005
+        and then Can_Never_Be_Null (T)
       then
-         --  The back-end has problems with constants of a discriminated type
-         --  with defaults, if the initial value is a function call. We
-         --  generate an intermediate temporary for the result of the call.
-         --  It is unclear why this should make it acceptable to gcc. ???
+         --  In case of aggregates we must also take care of the correct
+         --  initialization of nested aggregates bug this is done at the
+         --  point of the analysis of the aggregate (see sem_aggr.adb)
 
-         Remove_Side_Effects (E);
-      end if;
+         if Present (Expression (N))
+           and then Nkind (Expression (N)) = N_Aggregate
+         then
+            null;
 
-      --  Check No_Wide_Characters restriction
+         else
+            declare
+               Save_Typ : constant Entity_Id := Etype (Id);
+            begin
+               Set_Etype (Id, T); --  Temp. decoration for static checks
+               Null_Exclusion_Static_Checks (N);
+               Set_Etype (Id, Save_Typ);
+            end;
+         end if;
+      end if;
 
-      Check_Wide_Character_Restriction (T, Object_Definition (N));
+      Set_Is_Pure (Id, Is_Pure (Current_Scope));
 
-      --  Indicate this is not set in source. Certainly true for constants,
-      --  and true for variables so far (will be reset for a variable if and
-      --  when we encounter a modification in the source).
+      --  If deferred constant, make sure context is appropriate. We detect
+      --  a deferred constant as a constant declaration with no expression.
+      --  A deferred constant can appear in a package body if its completion
+      --  is by means of an interface pragma.
 
-      Set_Never_Set_In_Source (Id, True);
+      if Constant_Present (N)
+        and then No (E)
+      then
+         --  A deferred constant may appear in the declarative part of the
+         --  following constructs:
 
-      --  Now establish the proper kind and type of the object
+         --     blocks
+         --     entry bodies
+         --     extended return statements
+         --     package specs
+         --     package bodies
+         --     subprogram bodies
+         --     task bodies
 
-      if Constant_Present (N) then
-         Set_Ekind            (Id, E_Constant);
-         Set_Is_True_Constant (Id, True);
+         --  When declared inside a package spec, a deferred constant must be
+         --  completed by a full constant declaration or pragma Import. In all
+         --  other cases, the only proper completion is pragma Import. Extended
+         --  return statements are flagged as invalid contexts because they do
+         --  not have a declarative part and so cannot accommodate the pragma.
 
-      else
-         Set_Ekind (Id, E_Variable);
+         if Ekind (Current_Scope) = E_Return_Statement then
+            Error_Msg_N
+              ("invalid context for deferred constant declaration (RM 7.4)",
+               N);
+            Error_Msg_N
+              ("\declaration requires an initialization expression",
+                N);
+            Set_Constant_Present (N, False);
 
-         --  A variable is set as shared passive if it appears in a shared
-         --  passive package, and is at the outer level. This is not done
-         --  for entities generated during expansion, because those are
-         --  always manipulated locally.
+         --  In Ada 83, deferred constant must be of private type
 
-         if Is_Shared_Passive (Current_Scope)
-           and then Is_Library_Level_Entity (Id)
-           and then Comes_From_Source (Id)
-         then
-            Set_Is_Shared_Passive (Id);
-            Check_Shared_Var (Id, T, N);
+         elsif not Is_Private_Type (T) then
+            if Ada_Version = Ada_83 and then Comes_From_Source (N) then
+               Error_Msg_N
+                 ("(Ada 83) deferred constant must be private type", N);
+            end if;
          end if;
 
-         --  Set Has_Initial_Value if initializing expression present. Note
-         --  that if there is no initializing expression, we leave the state
-         --  of this flag unchanged (usually it will be False, but notably in
-         --  the case of exception choice variables, it will already be true).
+      --  If not a deferred constant, then object declaration freezes its type
 
-         if Present (E) then
-            Set_Has_Initial_Value (Id, True);
-         end if;
+      else
+         Check_Fully_Declared (T, N);
+         Freeze_Before (N, T);
       end if;
 
-      --  Initialize alignment and size and capture alignment setting
+      --  If the object was created by a constrained array definition, then
+      --  set the link in both the anonymous base type and anonymous subtype
+      --  that are built to represent the array type to point to the object.
 
-      Init_Alignment               (Id);
-      Init_Esize                   (Id);
-      Set_Optimize_Alignment_Flags (Id);
+      if Nkind (Object_Definition (Declaration_Node (Id))) =
+                        N_Constrained_Array_Definition
+      then
+         Set_Related_Array_Object (T, Id);
+         Set_Related_Array_Object (Base_Type (T), Id);
+      end if;
 
-      --  Deal with aliased case
+      --  Special checks for protected objects not at library level
 
-      if Aliased_Present (N) then
-         Set_Is_Aliased (Id);
+      if Is_Protected_Type (T)
+        and then not Is_Library_Level_Entity (Id)
+      then
+         Check_Restriction (No_Local_Protected_Objects, Id);
 
-         --  If the object is aliased and the type is unconstrained with
-         --  defaulted discriminants and there is no expression, then the
-         --  object is constrained by the defaults, so it is worthwhile
-         --  building the corresponding subtype.
+         --  Protected objects with interrupt handlers must be at library level
 
-         --  Ada 2005 (AI-363): If the aliased object is discriminated and
-         --  unconstrained, then only establish an actual subtype if the
-         --  nominal subtype is indefinite. In definite cases the object is
-         --  unconstrained in Ada 2005.
+         --  Ada 2005: this test is not needed (and the corresponding clause
+         --  in the RM is removed) because accessibility checks are sufficient
+         --  to make handlers not at the library level illegal.
 
-         if No (E)
-           and then Is_Record_Type (T)
-           and then not Is_Constrained (T)
-           and then Has_Discriminants (T)
-           and then (Ada_Version < Ada_2005 or else Is_Indefinite_Subtype (T))
+         if Has_Interrupt_Handler (T)
+           and then Ada_Version < Ada_2005
          then
-            Set_Actual_Subtype (Id, Build_Default_Subtype (T, N));
+            Error_Msg_N
+              ("interrupt object can only be declared at library level", Id);
          end if;
       end if;
 
-      --  Now we can set the type of the object
-
-      Set_Etype (Id, Act_T);
+      --  The actual subtype of the object is the nominal subtype, unless
+      --  the nominal one is unconstrained and obtained from the expression.
 
-      --  Deal with controlled types
+      Act_T := T;
 
-      if Has_Controlled_Component (Etype (Id))
-        or else Is_Controlled (Etype (Id))
-      then
-         if not Is_Library_Level_Entity (Id) then
-            Check_Restriction (No_Nested_Finalization, N);
-         else
-            Validate_Controlled_Object (Id);
-         end if;
+      --  Process initialization expression if present and not in error
 
-         --  Generate a warning when an initialization causes an obvious ABE
-         --  violation. If the init expression is a simple aggregate there
-         --  shouldn't be any initialize/adjust call generated. This will be
-         --  true as soon as aggregates are built in place when possible.
+      if Present (E) and then E /= Error then
 
-         --  ??? at the moment we do not generate warnings for temporaries
-         --  created for those aggregates although Program_Error might be
-         --  generated if compiled with -gnato.
+         --  Generate an error in case of CPP class-wide object initialization.
+         --  Required because otherwise the expansion of the class-wide
+         --  assignment would try to use 'size to initialize the object
+         --  (primitive that is not available in CPP tagged types).
 
-         if Is_Controlled (Etype (Id))
-            and then Comes_From_Source (Id)
+         if Is_Class_Wide_Type (Act_T)
+           and then
+             (Is_CPP_Class (Root_Type (Etype (Act_T)))
+               or else
+                 (Present (Full_View (Root_Type (Etype (Act_T))))
+                    and then
+                      Is_CPP_Class (Full_View (Root_Type (Etype (Act_T))))))
          then
-            declare
-               BT : constant Entity_Id := Base_Type (Etype (Id));
-
-               Implicit_Call : Entity_Id;
-               pragma Warnings (Off, Implicit_Call);
-               --  ??? what is this for (never referenced!)
+            Error_Msg_N
+              ("predefined assignment not available for 'C'P'P tagged types",
+               E);
+         end if;
 
-               function Is_Aggr (N : Node_Id) return Boolean;
-               --  Check that N is an aggregate
+         Mark_Coextensions (N, E);
+         Analyze (E);
 
-               -------------
-               -- Is_Aggr --
-               -------------
+         --  In case of errors detected in the analysis of the expression,
+         --  decorate it with the expected type to avoid cascaded errors
 
-               function Is_Aggr (N : Node_Id) return Boolean is
-               begin
-                  case Nkind (Original_Node (N)) is
-                     when N_Aggregate | N_Extension_Aggregate =>
-                        return True;
+         if No (Etype (E)) then
+            Set_Etype (E, T);
+         end if;
 
-                     when N_Qualified_Expression |
-                          N_Type_Conversion      |
-                          N_Unchecked_Type_Conversion =>
-                        return Is_Aggr (Expression (Original_Node (N)));
+         --  If an initialization expression is present, then we set the
+         --  Is_True_Constant flag. It will be reset if this is a variable
+         --  and it is indeed modified.
 
-                     when others =>
-                        return False;
-                  end case;
-               end Is_Aggr;
+         Set_Is_True_Constant (Id, True);
 
-            begin
-               --  If no underlying type, we already are in an error situation.
-               --  Do not try to add a warning since we do not have access to
-               --  prim-op list.
+         --  If we are analyzing a constant declaration, set its completion
+         --  flag after analyzing and resolving the expression.
 
-               if No (Underlying_Type (BT)) then
-                  Implicit_Call := Empty;
+         if Constant_Present (N) then
+            Set_Has_Completion (Id);
+         end if;
 
-               --  A generic type does not have usable primitive operators.
-               --  Initialization calls are built for instances.
+         --  Set type and resolve (type may be overridden later on)
 
-               elsif Is_Generic_Type (BT) then
-                  Implicit_Call := Empty;
+         Set_Etype (Id, T);
+         Resolve (E, T);
 
-               --  If the init expression is not an aggregate, an adjust call
-               --  will be generated
+         --  If E is null and has been replaced by an N_Raise_Constraint_Error
+         --  node (which was marked already-analyzed), we need to set the type
+         --  to something other than Any_Access in order to keep gigi happy.
 
-               elsif Present (E) and then not Is_Aggr (E) then
-                  Implicit_Call := Find_Prim_Op (BT, Name_Adjust);
+         if Etype (E) = Any_Access then
+            Set_Etype (E, T);
+         end if;
 
-               --  If no init expression and we are not in the deferred
-               --  constant case, an Initialize call will be generated
+         --  If the object is an access to variable, the initialization
+         --  expression cannot be an access to constant.
 
-               elsif No (E) and then not Constant_Present (N) then
-                  Implicit_Call := Find_Prim_Op (BT, Name_Initialize);
+         if Is_Access_Type (T)
+           and then not Is_Access_Constant (T)
+           and then Is_Access_Type (Etype (E))
+           and then Is_Access_Constant (Etype (E))
+         then
+            Error_Msg_N
+              ("access to variable cannot be initialized "
+               & "with an access-to-constant expression", E);
+         end if;
 
-               else
-                  Implicit_Call := Empty;
-               end if;
-            end;
+         if not Assignment_OK (N) then
+            Check_Initialization (T, E);
          end if;
-      end if;
 
-      if Has_Task (Etype (Id)) then
-         Check_Restriction (No_Tasking, N);
+         Check_Unset_Reference (E);
 
-         --  Deal with counting max tasks
+         --  If this is a variable, then set current value. If this is a
+         --  declared constant of a scalar type with a static expression,
+         --  indicate that it is always valid.
 
-         --  Nothing to do if inside a generic
+         if not Constant_Present (N) then
+            if Compile_Time_Known_Value (E) then
+               Set_Current_Value (Id, E);
+            end if;
 
-         if Inside_A_Generic then
-            null;
+         elsif Is_Scalar_Type (T)
+           and then Is_OK_Static_Expression (E)
+         then
+            Set_Is_Known_Valid (Id);
+         end if;
 
-         --  If library level entity, then count tasks
+         --  Deal with setting of null flags
 
-         elsif Is_Library_Level_Entity (Id) then
-            Check_Restriction (Max_Tasks, N, Count_Tasks (Etype (Id)));
+         if Is_Access_Type (T) then
+            if Known_Non_Null (E) then
+               Set_Is_Known_Non_Null (Id, True);
+            elsif Known_Null (E)
+              and then not Can_Never_Be_Null (Id)
+            then
+               Set_Is_Known_Null (Id, True);
+            end if;
+         end if;
 
-         --  If not library level entity, then indicate we don't know max
-         --  tasks and also check task hierarchy restriction and blocking
-         --  operation (since starting a task is definitely blocking!)
+         --  Check incorrect use of dynamically tagged expressions.
 
-         else
-            Check_Restriction (Max_Tasks, N);
-            Check_Restriction (No_Task_Hierarchy, N);
-            Check_Potentially_Blocking_Operation (N);
+         if Is_Tagged_Type (T) then
+            Check_Dynamically_Tagged_Expression
+              (Expr        => E,
+               Typ         => T,
+               Related_Nod => N);
          end if;
 
-         --  A rather specialized test. If we see two tasks being declared
-         --  of the same type in the same object declaration, and the task
-         --  has an entry with an address clause, we know that program error
-         --  will be raised at run time since we can't have two tasks with
-         --  entries at the same address.
-
-         if Is_Task_Type (Etype (Id)) and then More_Ids (N) then
-            declare
-               E : Entity_Id;
+         Apply_Scalar_Range_Check (E, T);
+         Apply_Static_Length_Check (E, T);
+      end if;
 
-            begin
-               E := First_Entity (Etype (Id));
-               while Present (E) loop
-                  if Ekind (E) = E_Entry
-                    and then Present (Get_Attribute_Definition_Clause
-                                        (E, Attribute_Address))
-                  then
-                     Error_Msg_N
-                       ("?more than one task with same entry address", N);
-                     Error_Msg_N
-                       ("\?Program_Error will be raised at run time", N);
-                     Insert_Action (N,
-                       Make_Raise_Program_Error (Loc,
-                         Reason => PE_Duplicated_Entry_Address));
-                     exit;
-                  end if;
+      --  If the No_Streams restriction is set, check that the type of the
+      --  object is not, and does not contain, any subtype derived from
+      --  Ada.Streams.Root_Stream_Type. Note that we guard the call to
+      --  Has_Stream just for efficiency reasons. There is no point in
+      --  spending time on a Has_Stream check if the restriction is not set.
 
-                  Next_Entity (E);
-               end loop;
-            end;
+      if Restriction_Check_Required (No_Streams) then
+         if Has_Stream (T) then
+            Check_Restriction (No_Streams, N);
          end if;
       end if;
 
-      --  Some simple constant-propagation: if the expression is a constant
-      --  string initialized with a literal, share the literal. This avoids
-      --  a run-time copy.
+      --  Case of unconstrained type
 
-      if Present (E)
-        and then Is_Entity_Name (E)
-        and then Ekind (Entity (E)) = E_Constant
-        and then Base_Type (Etype (E)) = Standard_String
-      then
-         declare
-            Val : constant Node_Id := Constant_Value (Entity (E));
-         begin
-            if Present (Val)
-              and then Nkind (Val) = N_String_Literal
-            then
-               Rewrite (E, New_Copy (Val));
-            end if;
-         end;
-      end if;
+      if Is_Indefinite_Subtype (T) then
 
-      --  Another optimization: if the nominal subtype is unconstrained and
-      --  the expression is a function call that returns an unconstrained
-      --  type, rewrite the declaration as a renaming of the result of the
-      --  call. The exceptions below are cases where the copy is expected,
-      --  either by the back end (Aliased case) or by the semantics, as for
-      --  initializing controlled types or copying tags for classwide types.
+         --  Nothing to do in deferred constant case
 
-      if Present (E)
-        and then Nkind (E) = N_Explicit_Dereference
-        and then Nkind (Original_Node (E)) = N_Function_Call
-        and then not Is_Library_Level_Entity (Id)
-        and then not Is_Constrained (Underlying_Type (T))
-        and then not Is_Aliased (Id)
-        and then not Is_Class_Wide_Type (T)
-        and then not Is_Controlled (T)
-        and then not Has_Controlled_Component (Base_Type (T))
-        and then Expander_Active
-      then
-         Rewrite (N,
-           Make_Object_Renaming_Declaration (Loc,
-             Defining_Identifier => Id,
-             Access_Definition   => Empty,
-             Subtype_Mark        => New_Occurrence_Of
-                                      (Base_Type (Etype (Id)), Loc),
-             Name                => E));
+         if Constant_Present (N) and then No (E) then
+            null;
 
-         Set_Renamed_Object (Id, E);
+         --  Case of no initialization present
 
-         --  Force generation of debugging information for the constant and for
-         --  the renamed function call.
+         elsif No (E) then
+            if No_Initialization (N) then
+               null;
 
-         Set_Debug_Info_Needed (Id);
-         Set_Debug_Info_Needed (Entity (Prefix (E)));
-      end if;
+            elsif Is_Class_Wide_Type (T) then
+               Error_Msg_N
+                 ("initialization required in class-wide declaration ", N);
 
-      if Present (Prev_Entity)
-        and then Is_Frozen (Prev_Entity)
-        and then not Error_Posted (Id)
-      then
-         Error_Msg_N ("full constant declaration appears too late", N);
-      end if;
+            else
+               Error_Msg_N
+                 ("unconstrained subtype not allowed (need initialization)",
+                  Object_Definition (N));
 
-      Check_Eliminated (Id);
+               if Is_Record_Type (T) and then Has_Discriminants (T) then
+                  Error_Msg_N
+                    ("\provide initial value or explicit discriminant values",
+                     Object_Definition (N));
 
-      --  Deal with setting In_Private_Part flag if in private part
+                  Error_Msg_NE
+                    ("\or give default discriminant values for type&",
+                     Object_Definition (N), T);
 
-      if Ekind (Scope (Id)) = E_Package
-        and then In_Private_Part (Scope (Id))
-      then
-         Set_In_Private_Part (Id);
-      end if;
+               elsif Is_Array_Type (T) then
+                  Error_Msg_N
+                    ("\provide initial value or explicit array bounds",
+                     Object_Definition (N));
+               end if;
+            end if;
 
-      --  Check for violation of No_Local_Timing_Events
+         --  Case of initialization present but in error. Set initial
+         --  expression as absent (but do not make above complaints)
 
-      if Is_RTE (Etype (Id), RE_Timing_Event)
-        and then not Is_Library_Level_Entity (Id)
-      then
-         Check_Restriction (No_Local_Timing_Events, N);
-      end if;
-   end Analyze_Object_Declaration;
+         elsif E = Error then
+            Set_Expression (N, Empty);
+            E := Empty;
 
-   ---------------------------
-   -- Analyze_Others_Choice --
-   ---------------------------
+         --  Case of initialization present
 
-   --  Nothing to do for the others choice node itself, the semantic analysis
-   --  of the others choice will occur as part of the processing of the parent
+         else
+            --  Not allowed in Ada 83
 
-   procedure Analyze_Others_Choice (N : Node_Id) is
-      pragma Warnings (Off, N);
-   begin
-      null;
-   end Analyze_Others_Choice;
+            if not Constant_Present (N) then
+               if Ada_Version = Ada_83
+                 and then Comes_From_Source (Object_Definition (N))
+               then
+                  Error_Msg_N
+                    ("(Ada 83) unconstrained variable not allowed",
+                     Object_Definition (N));
+               end if;
+            end if;
 
-   -------------------------------------------
-   -- Analyze_Private_Extension_Declaration --
-   -------------------------------------------
+            --  Now we constrain the variable from the initializing expression
 
-   procedure Analyze_Private_Extension_Declaration (N : Node_Id) is
-      T           : constant Entity_Id := Defining_Identifier (N);
-      Indic       : constant Node_Id   := Subtype_Indication (N);
-      Parent_Type : Entity_Id;
-      Parent_Base : Entity_Id;
+            --  If the expression is an aggregate, it has been expanded into
+            --  individual assignments. Retrieve the actual type from the
+            --  expanded construct.
 
-   begin
-      --  Ada 2005 (AI-251): Decorate all names in list of ancestor interfaces
+            if Is_Array_Type (T)
+              and then No_Initialization (N)
+              and then Nkind (Original_Node (E)) = N_Aggregate
+            then
+               Act_T := Etype (E);
 
-      if Is_Non_Empty_List (Interface_List (N)) then
-         declare
-            Intf : Node_Id;
-            T    : Entity_Id;
+            --  In case of class-wide interface object declarations we delay
+            --  the generation of the equivalent record type declarations until
+            --  its expansion because there are cases in they are not required.
 
-         begin
-            Intf := First (Interface_List (N));
-            while Present (Intf) loop
-               T := Find_Type_Of_Subtype_Indic (Intf);
+            elsif Is_Interface (T) then
+               null;
 
-               Diagnose_Interface (Intf, T);
-               Next (Intf);
-            end loop;
-         end;
-      end if;
+            else
+               Expand_Subtype_From_Expr (N, T, Object_Definition (N), E);
+               Act_T := Find_Type_Of_Object (Object_Definition (N), N);
+            end if;
 
-      Generate_Definition (T);
-      Enter_Name (T);
+            Set_Is_Constr_Subt_For_U_Nominal (Act_T);
 
-      Parent_Type := Find_Type_Of_Subtype_Indic (Indic);
-      Parent_Base := Base_Type (Parent_Type);
+            if Aliased_Present (N) then
+               Set_Is_Constr_Subt_For_UN_Aliased (Act_T);
+            end if;
 
-      if Parent_Type = Any_Type
-        or else Etype (Parent_Type) = Any_Type
+            Freeze_Before (N, Act_T);
+            Freeze_Before (N, T);
+         end if;
+
+      elsif Is_Array_Type (T)
+        and then No_Initialization (N)
+        and then Nkind (Original_Node (E)) = N_Aggregate
       then
-         Set_Ekind (T, Ekind (Parent_Type));
-         Set_Etype (T, Any_Type);
-         return;
+         if not Is_Entity_Name (Object_Definition (N)) then
+            Act_T := Etype (E);
+            Check_Compile_Time_Size (Act_T);
 
-      elsif not Is_Tagged_Type (Parent_Type) then
-         Error_Msg_N
-           ("parent of type extension must be a tagged type ", Indic);
-         return;
+            if Aliased_Present (N) then
+               Set_Is_Constr_Subt_For_UN_Aliased (Act_T);
+            end if;
+         end if;
 
-      elsif Ekind_In (Parent_Type, E_Void, E_Incomplete_Type) then
-         Error_Msg_N ("premature derivation of incomplete type", Indic);
-         return;
+         --  When the given object definition and the aggregate are specified
+         --  independently, and their lengths might differ do a length check.
+         --  This cannot happen if the aggregate is of the form (others =>...)
 
-      elsif Is_Concurrent_Type (Parent_Type) then
-         Error_Msg_N
-           ("parent type of a private extension cannot be "
-            & "a synchronized tagged type (RM 3.9.1 (3/1))", N);
+         if not Is_Constrained (T) then
+            null;
 
-         Set_Etype              (T, Any_Type);
-         Set_Ekind              (T, E_Limited_Private_Type);
-         Set_Private_Dependents (T, New_Elmt_List);
-         Set_Error_Posted       (T);
-         return;
-      end if;
+         elsif Nkind (E) = N_Raise_Constraint_Error then
 
-      --  Perhaps the parent type should be changed to the class-wide type's
-      --  specific type in this case to prevent cascading errors ???
+            --  Aggregate is statically illegal. Place back in declaration
 
-      if Is_Class_Wide_Type (Parent_Type) then
-         Error_Msg_N
-           ("parent of type extension must not be a class-wide type", Indic);
-         return;
-      end if;
+            Set_Expression (N, E);
+            Set_No_Initialization (N, False);
 
-      if (not Is_Package_Or_Generic_Package (Current_Scope)
-           and then Nkind (Parent (N)) /= N_Generic_Subprogram_Declaration)
-        or else In_Private_Part (Current_Scope)
+         elsif T = Etype (E) then
+            null;
 
-      then
-         Error_Msg_N ("invalid context for private extension", N);
-      end if;
+         elsif Nkind (E) = N_Aggregate
+           and then Present (Component_Associations (E))
+           and then Present (Choices (First (Component_Associations (E))))
+           and then Nkind (First
+            (Choices (First (Component_Associations (E))))) = N_Others_Choice
+         then
+            null;
 
-      --  Set common attributes
+         else
+            Apply_Length_Check (E, T);
+         end if;
 
-      Set_Is_Pure          (T, Is_Pure (Current_Scope));
-      Set_Scope            (T, Current_Scope);
-      Set_Ekind            (T, E_Record_Type_With_Private);
-      Init_Size_Align      (T);
+      --  If the type is limited unconstrained with defaulted discriminants and
+      --  there is no expression, then the object is constrained by the
+      --  defaults, so it is worthwhile building the corresponding subtype.
 
-      Set_Etype            (T,            Parent_Base);
-      Set_Has_Task         (T, Has_Task  (Parent_Base));
+      elsif (Is_Limited_Record (T) or else Is_Concurrent_Type (T))
+        and then not Is_Constrained (T)
+        and then Has_Discriminants (T)
+      then
+         if No (E) then
+            Act_T := Build_Default_Subtype (T, N);
+         else
+            --  Ada 2005:  a limited object may be initialized by means of an
+            --  aggregate. If the type has default discriminants it has an
+            --  unconstrained nominal type, Its actual subtype will be obtained
+            --  from the aggregate, and not from the default discriminants.
 
-      Set_Convention       (T, Convention     (Parent_Type));
-      Set_First_Rep_Item   (T, First_Rep_Item (Parent_Type));
-      Set_Is_First_Subtype (T);
-      Make_Class_Wide_Type (T);
+            Act_T := Etype (E);
+         end if;
 
-      if Unknown_Discriminants_Present (N) then
-         Set_Discriminant_Constraint (T, No_Elist);
+         Rewrite (Object_Definition (N), New_Occurrence_Of (Act_T, Loc));
+
+      elsif Present (Underlying_Type (T))
+        and then not Is_Constrained (Underlying_Type (T))
+        and then Has_Discriminants (Underlying_Type (T))
+        and then Nkind (E) = N_Function_Call
+        and then Constant_Present (N)
+      then
+         --  The back-end has problems with constants of a discriminated type
+         --  with defaults, if the initial value is a function call. We
+         --  generate an intermediate temporary for the result of the call.
+         --  It is unclear why this should make it acceptable to gcc. ???
+
+         Remove_Side_Effects (E);
       end if;
 
-      Build_Derived_Record_Type (N, Parent_Type, T);
+      --  Check No_Wide_Characters restriction
 
-      --  Ada 2005 (AI-443): Synchronized private extension or a rewritten
-      --  synchronized formal derived type.
+      Check_Wide_Character_Restriction (T, Object_Definition (N));
 
-      if Ada_Version >= Ada_2005
-        and then Synchronized_Present (N)
-      then
-         Set_Is_Limited_Record (T);
+      --  Indicate this is not set in source. Certainly true for constants,
+      --  and true for variables so far (will be reset for a variable if and
+      --  when we encounter a modification in the source).
 
-         --  Formal derived type case
+      Set_Never_Set_In_Source (Id, True);
 
-         if Is_Generic_Type (T) then
+      --  Now establish the proper kind and type of the object
 
-            --  The parent must be a tagged limited type or a synchronized
-            --  interface.
+      if Constant_Present (N) then
+         Set_Ekind            (Id, E_Constant);
+         Set_Is_True_Constant (Id, True);
 
-            if (not Is_Tagged_Type (Parent_Type)
-                  or else not Is_Limited_Type (Parent_Type))
-              and then
-               (not Is_Interface (Parent_Type)
-                  or else not Is_Synchronized_Interface (Parent_Type))
-            then
-               Error_Msg_NE ("parent type of & must be tagged limited " &
-                             "or synchronized", N, T);
-            end if;
+      else
+         Set_Ekind (Id, E_Variable);
 
-            --  The progenitors (if any) must be limited or synchronized
-            --  interfaces.
+         --  A variable is set as shared passive if it appears in a shared
+         --  passive package, and is at the outer level. This is not done
+         --  for entities generated during expansion, because those are
+         --  always manipulated locally.
 
-            if Present (Interfaces (T)) then
-               declare
-                  Iface      : Entity_Id;
-                  Iface_Elmt : Elmt_Id;
+         if Is_Shared_Passive (Current_Scope)
+           and then Is_Library_Level_Entity (Id)
+           and then Comes_From_Source (Id)
+         then
+            Set_Is_Shared_Passive (Id);
+            Check_Shared_Var (Id, T, N);
+         end if;
 
-               begin
-                  Iface_Elmt := First_Elmt (Interfaces (T));
-                  while Present (Iface_Elmt) loop
-                     Iface := Node (Iface_Elmt);
+         --  Set Has_Initial_Value if initializing expression present. Note
+         --  that if there is no initializing expression, we leave the state
+         --  of this flag unchanged (usually it will be False, but notably in
+         --  the case of exception choice variables, it will already be true).
 
-                     if not Is_Limited_Interface (Iface)
-                       and then not Is_Synchronized_Interface (Iface)
-                     then
-                        Error_Msg_NE ("progenitor & must be limited " &
-                                      "or synchronized", N, Iface);
-                     end if;
+         if Present (E) then
+            Set_Has_Initial_Value (Id, True);
+         end if;
+      end if;
 
-                     Next_Elmt (Iface_Elmt);
-                  end loop;
-               end;
-            end if;
+      --  Initialize alignment and size and capture alignment setting
 
-         --  Regular derived extension, the parent must be a limited or
-         --  synchronized interface.
+      Init_Alignment               (Id);
+      Init_Esize                   (Id);
+      Set_Optimize_Alignment_Flags (Id);
 
-         else
-            if not Is_Interface (Parent_Type)
-              or else (not Is_Limited_Interface (Parent_Type)
-                         and then
-                       not Is_Synchronized_Interface (Parent_Type))
-            then
-               Error_Msg_NE
-                 ("parent type of & must be limited interface", N, T);
-            end if;
-         end if;
+      --  Deal with aliased case
 
-      --  A consequence of 3.9.4 (6/2) and 7.3 (7.2/2) is that a private
-      --  extension with a synchronized parent must be explicitly declared
-      --  synchronized, because the full view will be a synchronized type.
-      --  This must be checked before the check for limited types below,
-      --  to ensure that types declared limited are not allowed to extend
-      --  synchronized interfaces.
+      if Aliased_Present (N) then
+         Set_Is_Aliased (Id);
 
-      elsif Is_Interface (Parent_Type)
-        and then Is_Synchronized_Interface (Parent_Type)
-        and then not Synchronized_Present (N)
-      then
-         Error_Msg_NE
-           ("private extension of& must be explicitly synchronized",
-             N, Parent_Type);
+         --  If the object is aliased and the type is unconstrained with
+         --  defaulted discriminants and there is no expression, then the
+         --  object is constrained by the defaults, so it is worthwhile
+         --  building the corresponding subtype.
 
-      elsif Limited_Present (N) then
-         Set_Is_Limited_Record (T);
+         --  Ada 2005 (AI-363): If the aliased object is discriminated and
+         --  unconstrained, then only establish an actual subtype if the
+         --  nominal subtype is indefinite. In definite cases the object is
+         --  unconstrained in Ada 2005.
 
-         if not Is_Limited_Type (Parent_Type)
-           and then
-             (not Is_Interface (Parent_Type)
-               or else not Is_Limited_Interface (Parent_Type))
+         if No (E)
+           and then Is_Record_Type (T)
+           and then not Is_Constrained (T)
+           and then Has_Discriminants (T)
+           and then (Ada_Version < Ada_2005 or else Is_Indefinite_Subtype (T))
          then
-            Error_Msg_NE ("parent type& of limited extension must be limited",
-              N, Parent_Type);
+            Set_Actual_Subtype (Id, Build_Default_Subtype (T, N));
          end if;
       end if;
-   end Analyze_Private_Extension_Declaration;
 
-   ---------------------------------
-   -- Analyze_Subtype_Declaration --
-   ---------------------------------
+      --  Now we can set the type of the object
 
-   procedure Analyze_Subtype_Declaration
-     (N    : Node_Id;
-      Skip : Boolean := False)
-   is
-      Id       : constant Entity_Id := Defining_Identifier (N);
-      T        : Entity_Id;
-      R_Checks : Check_Result;
+      Set_Etype (Id, Act_T);
 
-   begin
-      Generate_Definition (Id);
-      Set_Is_Pure (Id, Is_Pure (Current_Scope));
-      Init_Size_Align (Id);
+      --  Deal with controlled types
 
-      --  The following guard condition on Enter_Name is to handle cases where
-      --  the defining identifier has already been entered into the scope but
-      --  the declaration as a whole needs to be analyzed.
+      if Has_Controlled_Component (Etype (Id))
+        or else Is_Controlled (Etype (Id))
+      then
+         if not Is_Library_Level_Entity (Id) then
+            Check_Restriction (No_Nested_Finalization, N);
+         else
+            Validate_Controlled_Object (Id);
+         end if;
 
-      --  This case in particular happens for derived enumeration types. The
-      --  derived enumeration type is processed as an inserted enumeration type
-      --  declaration followed by a rewritten subtype declaration. The defining
-      --  identifier, however, is entered into the name scope very early in the
-      --  processing of the original type declaration and therefore needs to be
-      --  avoided here, when the created subtype declaration is analyzed. (See
-      --  Build_Derived_Types)
+         --  Generate a warning when an initialization causes an obvious ABE
+         --  violation. If the init expression is a simple aggregate there
+         --  shouldn't be any initialize/adjust call generated. This will be
+         --  true as soon as aggregates are built in place when possible.
 
-      --  This also happens when the full view of a private type is derived
-      --  type with constraints. In this case the entity has been introduced
-      --  in the private declaration.
+         --  ??? at the moment we do not generate warnings for temporaries
+         --  created for those aggregates although Program_Error might be
+         --  generated if compiled with -gnato.
 
-      if Skip
-        or else (Present (Etype (Id))
-                   and then (Is_Private_Type (Etype (Id))
-                               or else Is_Task_Type (Etype (Id))
-                               or else Is_Rewrite_Substitution (N)))
-      then
-         null;
+         if Is_Controlled (Etype (Id))
+            and then Comes_From_Source (Id)
+         then
+            declare
+               BT : constant Entity_Id := Base_Type (Etype (Id));
 
-      else
-         Enter_Name (Id);
-      end if;
+               Implicit_Call : Entity_Id;
+               pragma Warnings (Off, Implicit_Call);
+               --  ??? what is this for (never referenced!)
 
-      T := Process_Subtype (Subtype_Indication (N), N, Id, 'P');
+               function Is_Aggr (N : Node_Id) return Boolean;
+               --  Check that N is an aggregate
 
-      --  Inherit common attributes
+               -------------
+               -- Is_Aggr --
+               -------------
 
-      Set_Is_Generic_Type   (Id, Is_Generic_Type   (Base_Type (T)));
-      Set_Is_Volatile       (Id, Is_Volatile       (T));
-      Set_Treat_As_Volatile (Id, Treat_As_Volatile (T));
-      Set_Is_Atomic         (Id, Is_Atomic         (T));
-      Set_Is_Ada_2005_Only  (Id, Is_Ada_2005_Only  (T));
-      Set_Is_Ada_2012_Only  (Id, Is_Ada_2012_Only  (T));
-      Set_Convention        (Id, Convention        (T));
+               function Is_Aggr (N : Node_Id) return Boolean is
+               begin
+                  case Nkind (Original_Node (N)) is
+                     when N_Aggregate | N_Extension_Aggregate =>
+                        return True;
 
-      --  In the case where there is no constraint given in the subtype
-      --  indication, Process_Subtype just returns the Subtype_Mark, so its
-      --  semantic attributes must be established here.
+                     when N_Qualified_Expression |
+                          N_Type_Conversion      |
+                          N_Unchecked_Type_Conversion =>
+                        return Is_Aggr (Expression (Original_Node (N)));
 
-      if Nkind (Subtype_Indication (N)) /= N_Subtype_Indication then
-         Set_Etype (Id, Base_Type (T));
+                     when others =>
+                        return False;
+                  end case;
+               end Is_Aggr;
 
-         case Ekind (T) is
-            when Array_Kind =>
-               Set_Ekind                       (Id, E_Array_Subtype);
-               Copy_Array_Subtype_Attributes   (Id, T);
+            begin
+               --  If no underlying type, we already are in an error situation.
+               --  Do not try to add a warning since we do not have access to
+               --  prim-op list.
 
-            when Decimal_Fixed_Point_Kind =>
-               Set_Ekind                (Id, E_Decimal_Fixed_Point_Subtype);
-               Set_Digits_Value         (Id, Digits_Value       (T));
-               Set_Delta_Value          (Id, Delta_Value        (T));
-               Set_Scale_Value          (Id, Scale_Value        (T));
-               Set_Small_Value          (Id, Small_Value        (T));
-               Set_Scalar_Range         (Id, Scalar_Range       (T));
-               Set_Machine_Radix_10     (Id, Machine_Radix_10   (T));
-               Set_Is_Constrained       (Id, Is_Constrained     (T));
-               Set_Is_Known_Valid       (Id, Is_Known_Valid     (T));
-               Set_RM_Size              (Id, RM_Size            (T));
+               if No (Underlying_Type (BT)) then
+                  Implicit_Call := Empty;
 
-            when Enumeration_Kind =>
-               Set_Ekind                (Id, E_Enumeration_Subtype);
-               Set_First_Literal        (Id, First_Literal (Base_Type (T)));
-               Set_Scalar_Range         (Id, Scalar_Range       (T));
-               Set_Is_Character_Type    (Id, Is_Character_Type  (T));
-               Set_Is_Constrained       (Id, Is_Constrained     (T));
-               Set_Is_Known_Valid       (Id, Is_Known_Valid     (T));
-               Set_RM_Size              (Id, RM_Size            (T));
+               --  A generic type does not have usable primitive operators.
+               --  Initialization calls are built for instances.
 
-            when Ordinary_Fixed_Point_Kind =>
-               Set_Ekind                (Id, E_Ordinary_Fixed_Point_Subtype);
-               Set_Scalar_Range         (Id, Scalar_Range       (T));
-               Set_Small_Value          (Id, Small_Value        (T));
-               Set_Delta_Value          (Id, Delta_Value        (T));
-               Set_Is_Constrained       (Id, Is_Constrained     (T));
-               Set_Is_Known_Valid       (Id, Is_Known_Valid     (T));
-               Set_RM_Size              (Id, RM_Size            (T));
+               elsif Is_Generic_Type (BT) then
+                  Implicit_Call := Empty;
 
-            when Float_Kind =>
-               Set_Ekind                (Id, E_Floating_Point_Subtype);
-               Set_Scalar_Range         (Id, Scalar_Range       (T));
-               Set_Digits_Value         (Id, Digits_Value       (T));
-               Set_Is_Constrained       (Id, Is_Constrained     (T));
+               --  If the init expression is not an aggregate, an adjust call
+               --  will be generated
 
-            when Signed_Integer_Kind =>
-               Set_Ekind                (Id, E_Signed_Integer_Subtype);
-               Set_Scalar_Range         (Id, Scalar_Range       (T));
-               Set_Is_Constrained       (Id, Is_Constrained     (T));
-               Set_Is_Known_Valid       (Id, Is_Known_Valid     (T));
-               Set_RM_Size              (Id, RM_Size            (T));
+               elsif Present (E) and then not Is_Aggr (E) then
+                  Implicit_Call := Find_Prim_Op (BT, Name_Adjust);
 
-            when Modular_Integer_Kind =>
-               Set_Ekind                (Id, E_Modular_Integer_Subtype);
-               Set_Scalar_Range         (Id, Scalar_Range       (T));
-               Set_Is_Constrained       (Id, Is_Constrained     (T));
-               Set_Is_Known_Valid       (Id, Is_Known_Valid     (T));
-               Set_RM_Size              (Id, RM_Size            (T));
+               --  If no init expression and we are not in the deferred
+               --  constant case, an Initialize call will be generated
 
-            when Class_Wide_Kind =>
-               Set_Ekind                (Id, E_Class_Wide_Subtype);
-               Set_First_Entity         (Id, First_Entity       (T));
-               Set_Last_Entity          (Id, Last_Entity        (T));
-               Set_Class_Wide_Type      (Id, Class_Wide_Type    (T));
-               Set_Cloned_Subtype       (Id, T);
-               Set_Is_Tagged_Type       (Id, True);
-               Set_Has_Unknown_Discriminants
-                                        (Id, True);
+               elsif No (E) and then not Constant_Present (N) then
+                  Implicit_Call := Find_Prim_Op (BT, Name_Initialize);
 
-               if Ekind (T) = E_Class_Wide_Subtype then
-                  Set_Equivalent_Type   (Id, Equivalent_Type    (T));
+               else
+                  Implicit_Call := Empty;
                end if;
+            end;
+         end if;
+      end if;
 
-            when E_Record_Type | E_Record_Subtype =>
-               Set_Ekind                (Id, E_Record_Subtype);
+      if Has_Task (Etype (Id)) then
+         Check_Restriction (No_Tasking, N);
 
-               if Ekind (T) = E_Record_Subtype
-                 and then Present (Cloned_Subtype (T))
-               then
-                  Set_Cloned_Subtype    (Id, Cloned_Subtype (T));
-               else
-                  Set_Cloned_Subtype    (Id, T);
-               end if;
+         --  Deal with counting max tasks
 
-               Set_First_Entity         (Id, First_Entity       (T));
-               Set_Last_Entity          (Id, Last_Entity        (T));
-               Set_Has_Discriminants    (Id, Has_Discriminants  (T));
-               Set_Is_Constrained       (Id, Is_Constrained     (T));
-               Set_Is_Limited_Record    (Id, Is_Limited_Record  (T));
-               Set_Has_Unknown_Discriminants
-                                        (Id, Has_Unknown_Discriminants (T));
+         --  Nothing to do if inside a generic
 
-               if Has_Discriminants (T) then
-                  Set_Discriminant_Constraint
-                                        (Id, Discriminant_Constraint (T));
-                  Set_Stored_Constraint_From_Discriminant_Constraint (Id);
+         if Inside_A_Generic then
+            null;
 
-               elsif Has_Unknown_Discriminants (Id) then
-                  Set_Discriminant_Constraint (Id, No_Elist);
-               end if;
+         --  If library level entity, then count tasks
 
-               if Is_Tagged_Type (T) then
-                  Set_Is_Tagged_Type    (Id);
-                  Set_Is_Abstract_Type  (Id, Is_Abstract_Type (T));
-                  Set_Primitive_Operations
-                                        (Id, Primitive_Operations (T));
-                  Set_Class_Wide_Type   (Id, Class_Wide_Type (T));
+         elsif Is_Library_Level_Entity (Id) then
+            Check_Restriction (Max_Tasks, N, Count_Tasks (Etype (Id)));
 
-                  if Is_Interface (T) then
-                     Set_Is_Interface (Id);
-                     Set_Is_Limited_Interface (Id, Is_Limited_Interface (T));
+         --  If not library level entity, then indicate we don't know max
+         --  tasks and also check task hierarchy restriction and blocking
+         --  operation (since starting a task is definitely blocking!)
+
+         else
+            Check_Restriction (Max_Tasks, N);
+            Check_Restriction (No_Task_Hierarchy, N);
+            Check_Potentially_Blocking_Operation (N);
+         end if;
+
+         --  A rather specialized test. If we see two tasks being declared
+         --  of the same type in the same object declaration, and the task
+         --  has an entry with an address clause, we know that program error
+         --  will be raised at run time since we can't have two tasks with
+         --  entries at the same address.
+
+         if Is_Task_Type (Etype (Id)) and then More_Ids (N) then
+            declare
+               E : Entity_Id;
+
+            begin
+               E := First_Entity (Etype (Id));
+               while Present (E) loop
+                  if Ekind (E) = E_Entry
+                    and then Present (Get_Attribute_Definition_Clause
+                                        (E, Attribute_Address))
+                  then
+                     Error_Msg_N
+                       ("?more than one task with same entry address", N);
+                     Error_Msg_N
+                       ("\?Program_Error will be raised at run time", N);
+                     Insert_Action (N,
+                       Make_Raise_Program_Error (Loc,
+                         Reason => PE_Duplicated_Entry_Address));
+                     exit;
                   end if;
-               end if;
 
-            when Private_Kind =>
-               Set_Ekind              (Id, Subtype_Kind (Ekind   (T)));
-               Set_Has_Discriminants  (Id, Has_Discriminants     (T));
-               Set_Is_Constrained     (Id, Is_Constrained        (T));
-               Set_First_Entity       (Id, First_Entity          (T));
-               Set_Last_Entity        (Id, Last_Entity           (T));
-               Set_Private_Dependents (Id, New_Elmt_List);
-               Set_Is_Limited_Record  (Id, Is_Limited_Record     (T));
-               Set_Has_Unknown_Discriminants
-                                      (Id, Has_Unknown_Discriminants (T));
-               Set_Known_To_Have_Preelab_Init
-                                      (Id, Known_To_Have_Preelab_Init (T));
+                  Next_Entity (E);
+               end loop;
+            end;
+         end if;
+      end if;
 
-               if Is_Tagged_Type (T) then
-                  Set_Is_Tagged_Type       (Id);
-                  Set_Is_Abstract_Type     (Id, Is_Abstract_Type (T));
-                  Set_Primitive_Operations (Id, Primitive_Operations (T));
-                  Set_Class_Wide_Type      (Id, Class_Wide_Type (T));
-               end if;
+      --  Some simple constant-propagation: if the expression is a constant
+      --  string initialized with a literal, share the literal. This avoids
+      --  a run-time copy.
 
-               --  In general the attributes of the subtype of a private type
-               --  are the attributes of the partial view of parent. However,
-               --  the full view may be a discriminated type, and the subtype
-               --  must share the discriminant constraint to generate correct
-               --  calls to initialization procedures.
+      if Present (E)
+        and then Is_Entity_Name (E)
+        and then Ekind (Entity (E)) = E_Constant
+        and then Base_Type (Etype (E)) = Standard_String
+      then
+         declare
+            Val : constant Node_Id := Constant_Value (Entity (E));
+         begin
+            if Present (Val)
+              and then Nkind (Val) = N_String_Literal
+            then
+               Rewrite (E, New_Copy (Val));
+            end if;
+         end;
+      end if;
 
-               if Has_Discriminants (T) then
-                  Set_Discriminant_Constraint
-                                     (Id, Discriminant_Constraint (T));
-                  Set_Stored_Constraint_From_Discriminant_Constraint (Id);
+      --  Another optimization: if the nominal subtype is unconstrained and
+      --  the expression is a function call that returns an unconstrained
+      --  type, rewrite the declaration as a renaming of the result of the
+      --  call. The exceptions below are cases where the copy is expected,
+      --  either by the back end (Aliased case) or by the semantics, as for
+      --  initializing controlled types or copying tags for classwide types.
 
-               elsif Present (Full_View (T))
-                 and then Has_Discriminants (Full_View (T))
-               then
-                  Set_Discriminant_Constraint
-                               (Id, Discriminant_Constraint (Full_View (T)));
-                  Set_Stored_Constraint_From_Discriminant_Constraint (Id);
+      if Present (E)
+        and then Nkind (E) = N_Explicit_Dereference
+        and then Nkind (Original_Node (E)) = N_Function_Call
+        and then not Is_Library_Level_Entity (Id)
+        and then not Is_Constrained (Underlying_Type (T))
+        and then not Is_Aliased (Id)
+        and then not Is_Class_Wide_Type (T)
+        and then not Is_Controlled (T)
+        and then not Has_Controlled_Component (Base_Type (T))
+        and then Expander_Active
+      then
+         Rewrite (N,
+           Make_Object_Renaming_Declaration (Loc,
+             Defining_Identifier => Id,
+             Access_Definition   => Empty,
+             Subtype_Mark        => New_Occurrence_Of
+                                      (Base_Type (Etype (Id)), Loc),
+             Name                => E));
 
-                  --  This would seem semantically correct, but apparently
-                  --  confuses the back-end. To be explained and checked with
-                  --  current version ???
+         Set_Renamed_Object (Id, E);
 
-                  --  Set_Has_Discriminants (Id);
-               end if;
+         --  Force generation of debugging information for the constant and for
+         --  the renamed function call.
 
-               Prepare_Private_Subtype_Completion (Id, N);
+         Set_Debug_Info_Needed (Id);
+         Set_Debug_Info_Needed (Entity (Prefix (E)));
+      end if;
 
-            when Access_Kind =>
-               Set_Ekind             (Id, E_Access_Subtype);
-               Set_Is_Constrained    (Id, Is_Constrained        (T));
-               Set_Is_Access_Constant
-                                     (Id, Is_Access_Constant    (T));
-               Set_Directly_Designated_Type
-                                     (Id, Designated_Type       (T));
-               Set_Can_Never_Be_Null (Id, Can_Never_Be_Null     (T));
+      if Present (Prev_Entity)
+        and then Is_Frozen (Prev_Entity)
+        and then not Error_Posted (Id)
+      then
+         Error_Msg_N ("full constant declaration appears too late", N);
+      end if;
 
-               --  A Pure library_item must not contain the declaration of a
-               --  named access type, except within a subprogram, generic
-               --  subprogram, task unit, or protected unit, or if it has
-               --  a specified Storage_Size of zero (RM05-10.2.1(15.4-15.5)).
+      Check_Eliminated (Id);
 
-               if Comes_From_Source (Id)
-                 and then In_Pure_Unit
-                 and then not In_Subprogram_Task_Protected_Unit
-                 and then not No_Pool_Assigned (Id)
-               then
-                  Error_Msg_N
-                    ("named access types not allowed in pure unit", N);
-               end if;
+      --  Deal with setting In_Private_Part flag if in private part
 
-            when Concurrent_Kind =>
-               Set_Ekind                (Id, Subtype_Kind (Ekind   (T)));
-               Set_Corresponding_Record_Type (Id,
-                                         Corresponding_Record_Type (T));
-               Set_First_Entity         (Id, First_Entity          (T));
-               Set_First_Private_Entity (Id, First_Private_Entity  (T));
-               Set_Has_Discriminants    (Id, Has_Discriminants     (T));
-               Set_Is_Constrained       (Id, Is_Constrained        (T));
-               Set_Is_Tagged_Type       (Id, Is_Tagged_Type        (T));
-               Set_Last_Entity          (Id, Last_Entity           (T));
+      if Ekind (Scope (Id)) = E_Package
+        and then In_Private_Part (Scope (Id))
+      then
+         Set_In_Private_Part (Id);
+      end if;
 
-               if Has_Discriminants (T) then
-                  Set_Discriminant_Constraint (Id,
-                                           Discriminant_Constraint (T));
-                  Set_Stored_Constraint_From_Discriminant_Constraint (Id);
-               end if;
+      --  Check for violation of No_Local_Timing_Events
 
-            when E_Incomplete_Type =>
-               if Ada_Version >= Ada_2005 then
-                  Set_Ekind (Id, E_Incomplete_Subtype);
+      if Is_RTE (Etype (Id), RE_Timing_Event)
+        and then not Is_Library_Level_Entity (Id)
+      then
+         Check_Restriction (No_Local_Timing_Events, N);
+      end if;
 
-                  --  Ada 2005 (AI-412): Decorate an incomplete subtype
-                  --  of an incomplete type visible through a limited
-                  --  with clause.
+      <<Leave>> Analyze_Aspect_Specifications (N, Id, AS);
+   end Analyze_Object_Declaration;
 
-                  if From_With_Type (T)
-                    and then Present (Non_Limited_View (T))
-                  then
-                     Set_From_With_Type   (Id);
-                     Set_Non_Limited_View (Id, Non_Limited_View (T));
+   ---------------------------
+   -- Analyze_Others_Choice --
+   ---------------------------
 
-                  --  Ada 2005 (AI-412): Add the regular incomplete subtype
-                  --  to the private dependents of the original incomplete
-                  --  type for future transformation.
+   --  Nothing to do for the others choice node itself, the semantic analysis
+   --  of the others choice will occur as part of the processing of the parent
 
-                  else
-                     Append_Elmt (Id, Private_Dependents (T));
-                  end if;
+   procedure Analyze_Others_Choice (N : Node_Id) is
+      pragma Warnings (Off, N);
+   begin
+      null;
+   end Analyze_Others_Choice;
 
-               --  If the subtype name denotes an incomplete type an error
-               --  was already reported by Process_Subtype.
+   -------------------------------------------
+   -- Analyze_Private_Extension_Declaration --
+   -------------------------------------------
 
-               else
-                  Set_Etype (Id, Any_Type);
-               end if;
+   procedure Analyze_Private_Extension_Declaration (N : Node_Id) is
+      T           : constant Entity_Id := Defining_Identifier (N);
+      Indic       : constant Node_Id   := Subtype_Indication (N);
+      AS          : constant List_Id   := Aspect_Specifications (N);
+      Parent_Type : Entity_Id;
+      Parent_Base : Entity_Id;
 
-            when others =>
-               raise Program_Error;
-         end case;
-      end if;
+   begin
+      --  Ada 2005 (AI-251): Decorate all names in list of ancestor interfaces
 
-      if Etype (Id) = Any_Type then
-         return;
+      if Is_Non_Empty_List (Interface_List (N)) then
+         declare
+            Intf : Node_Id;
+            T    : Entity_Id;
+
+         begin
+            Intf := First (Interface_List (N));
+            while Present (Intf) loop
+               T := Find_Type_Of_Subtype_Indic (Intf);
+
+               Diagnose_Interface (Intf, T);
+               Next (Intf);
+            end loop;
+         end;
       end if;
 
-      --  Some common processing on all types
+      Generate_Definition (T);
+      Enter_Name (T);
 
-      Set_Size_Info      (Id,                 T);
-      Set_First_Rep_Item (Id, First_Rep_Item (T));
+      Parent_Type := Find_Type_Of_Subtype_Indic (Indic);
+      Parent_Base := Base_Type (Parent_Type);
 
-      T := Etype (Id);
+      if Parent_Type = Any_Type
+        or else Etype (Parent_Type) = Any_Type
+      then
+         Set_Ekind (T, Ekind (Parent_Type));
+         Set_Etype (T, Any_Type);
+         goto Leave;
 
-      Set_Is_Immediately_Visible   (Id, True);
-      Set_Depends_On_Private       (Id, Has_Private_Component (T));
-      Set_Is_Descendent_Of_Address (Id, Is_Descendent_Of_Address (T));
+      elsif not Is_Tagged_Type (Parent_Type) then
+         Error_Msg_N
+           ("parent of type extension must be a tagged type ", Indic);
+         goto Leave;
 
-      if Is_Interface (T) then
-         Set_Is_Interface (Id);
+      elsif Ekind_In (Parent_Type, E_Void, E_Incomplete_Type) then
+         Error_Msg_N ("premature derivation of incomplete type", Indic);
+         goto Leave;
+
+      elsif Is_Concurrent_Type (Parent_Type) then
+         Error_Msg_N
+           ("parent type of a private extension cannot be "
+            & "a synchronized tagged type (RM 3.9.1 (3/1))", N);
+
+         Set_Etype              (T, Any_Type);
+         Set_Ekind              (T, E_Limited_Private_Type);
+         Set_Private_Dependents (T, New_Elmt_List);
+         Set_Error_Posted       (T);
+         goto Leave;
+      end if;
+
+      --  Perhaps the parent type should be changed to the class-wide type's
+      --  specific type in this case to prevent cascading errors ???
+
+      if Is_Class_Wide_Type (Parent_Type) then
+         Error_Msg_N
+           ("parent of type extension must not be a class-wide type", Indic);
+         goto Leave;
       end if;
 
-      if Present (Generic_Parent_Type (N))
-        and then
-          (Nkind
-            (Parent (Generic_Parent_Type (N))) /= N_Formal_Type_Declaration
-            or else Nkind
-              (Formal_Type_Definition (Parent (Generic_Parent_Type (N))))
-                /= N_Formal_Private_Type_Definition)
+      if (not Is_Package_Or_Generic_Package (Current_Scope)
+           and then Nkind (Parent (N)) /= N_Generic_Subprogram_Declaration)
+        or else In_Private_Part (Current_Scope)
+
       then
-         if Is_Tagged_Type (Id) then
+         Error_Msg_N ("invalid context for private extension", N);
+      end if;
 
-            --  If this is a generic actual subtype for a synchronized type,
-            --  the primitive operations are those of the corresponding record
-            --  for which there is a separate subtype declaration.
+      --  Set common attributes
 
-            if Is_Concurrent_Type (Id) then
-               null;
-            elsif Is_Class_Wide_Type (Id) then
-               Derive_Subprograms (Generic_Parent_Type (N), Id, Etype (T));
-            else
-               Derive_Subprograms (Generic_Parent_Type (N), Id, T);
-            end if;
+      Set_Is_Pure          (T, Is_Pure (Current_Scope));
+      Set_Scope            (T, Current_Scope);
+      Set_Ekind            (T, E_Record_Type_With_Private);
+      Init_Size_Align      (T);
 
-         elsif Scope (Etype (Id)) /= Standard_Standard then
-            Derive_Subprograms (Generic_Parent_Type (N), Id);
-         end if;
+      Set_Etype            (T,            Parent_Base);
+      Set_Has_Task         (T, Has_Task  (Parent_Base));
+
+      Set_Convention       (T, Convention     (Parent_Type));
+      Set_First_Rep_Item   (T, First_Rep_Item (Parent_Type));
+      Set_Is_First_Subtype (T);
+      Make_Class_Wide_Type (T);
+
+      if Unknown_Discriminants_Present (N) then
+         Set_Discriminant_Constraint (T, No_Elist);
       end if;
 
-      if Is_Private_Type (T)
-        and then Present (Full_View (T))
-      then
-         Conditional_Delay (Id, Full_View (T));
+      Build_Derived_Record_Type (N, Parent_Type, T);
 
-      --  The subtypes of components or subcomponents of protected types
-      --  do not need freeze nodes, which would otherwise appear in the
-      --  wrong scope (before the freeze node for the protected type). The
-      --  proper subtypes are those of the subcomponents of the corresponding
-      --  record.
+      --  Ada 2005 (AI-443): Synchronized private extension or a rewritten
+      --  synchronized formal derived type.
 
-      elsif Ekind (Scope (Id)) /= E_Protected_Type
-        and then Present (Scope (Scope (Id))) -- error defense!
-        and then Ekind (Scope (Scope (Id))) /= E_Protected_Type
+      if Ada_Version >= Ada_2005
+        and then Synchronized_Present (N)
       then
-         Conditional_Delay (Id, T);
-      end if;
+         Set_Is_Limited_Record (T);
 
-      --  Check that constraint_error is raised for a scalar subtype
-      --  indication when the lower or upper bound of a non-null range
-      --  lies outside the range of the type mark.
+         --  Formal derived type case
 
-      if Nkind (Subtype_Indication (N)) = N_Subtype_Indication then
-         if Is_Scalar_Type (Etype (Id))
-            and then Scalar_Range (Id) /=
-                     Scalar_Range (Etype (Subtype_Mark
-                                           (Subtype_Indication (N))))
-         then
-            Apply_Range_Check
-              (Scalar_Range (Id),
-               Etype (Subtype_Mark (Subtype_Indication (N))));
+         if Is_Generic_Type (T) then
 
-         elsif Is_Array_Type (Etype (Id))
-           and then Present (First_Index (Id))
-         then
-            --  This really should be a subprogram that finds the indications
-            --  to check???
+            --  The parent must be a tagged limited type or a synchronized
+            --  interface.
 
-            if ((Nkind (First_Index (Id)) = N_Identifier
-                   and then Ekind (Entity (First_Index (Id))) in Scalar_Kind)
-                 or else Nkind (First_Index (Id)) = N_Subtype_Indication)
+            if (not Is_Tagged_Type (Parent_Type)
+                  or else not Is_Limited_Type (Parent_Type))
               and then
-                Nkind (Scalar_Range (Etype (First_Index (Id)))) = N_Range
+               (not Is_Interface (Parent_Type)
+                  or else not Is_Synchronized_Interface (Parent_Type))
             then
+               Error_Msg_NE ("parent type of & must be tagged limited " &
+                             "or synchronized", N, T);
+            end if;
+
+            --  The progenitors (if any) must be limited or synchronized
+            --  interfaces.
+
+            if Present (Interfaces (T)) then
                declare
-                  Target_Typ : constant Entity_Id :=
-                                 Etype
-                                   (First_Index (Etype
-                                     (Subtype_Mark (Subtype_Indication (N)))));
+                  Iface      : Entity_Id;
+                  Iface_Elmt : Elmt_Id;
+
                begin
-                  R_Checks :=
-                    Get_Range_Checks
-                      (Scalar_Range (Etype (First_Index (Id))),
-                       Target_Typ,
-                       Etype (First_Index (Id)),
-                       Defining_Identifier (N));
+                  Iface_Elmt := First_Elmt (Interfaces (T));
+                  while Present (Iface_Elmt) loop
+                     Iface := Node (Iface_Elmt);
 
-                  Insert_Range_Checks
-                    (R_Checks,
-                     N,
-                     Target_Typ,
-                     Sloc (Defining_Identifier (N)));
+                     if not Is_Limited_Interface (Iface)
+                       and then not Is_Synchronized_Interface (Iface)
+                     then
+                        Error_Msg_NE ("progenitor & must be limited " &
+                                      "or synchronized", N, Iface);
+                     end if;
+
+                     Next_Elmt (Iface_Elmt);
+                  end loop;
                end;
             end if;
-         end if;
-      end if;
-
-      Set_Optimize_Alignment_Flags (Id);
-      Check_Eliminated (Id);
-   end Analyze_Subtype_Declaration;
-
-   --------------------------------
-   -- Analyze_Subtype_Indication --
-   --------------------------------
 
-   procedure Analyze_Subtype_Indication (N : Node_Id) is
-      T : constant Entity_Id := Subtype_Mark (N);
-      R : constant Node_Id   := Range_Expression (Constraint (N));
+         --  Regular derived extension, the parent must be a limited or
+         --  synchronized interface.
 
-   begin
-      Analyze (T);
+         else
+            if not Is_Interface (Parent_Type)
+              or else (not Is_Limited_Interface (Parent_Type)
+                         and then
+                       not Is_Synchronized_Interface (Parent_Type))
+            then
+               Error_Msg_NE
+                 ("parent type of & must be limited interface", N, T);
+            end if;
+         end if;
 
-      if R /= Error then
-         Analyze (R);
-         Set_Etype (N, Etype (R));
-         Resolve (R, Entity (T));
-      else
-         Set_Error_Posted (R);
-         Set_Error_Posted (T);
-      end if;
-   end Analyze_Subtype_Indication;
+      --  A consequence of 3.9.4 (6/2) and 7.3 (7.2/2) is that a private
+      --  extension with a synchronized parent must be explicitly declared
+      --  synchronized, because the full view will be a synchronized type.
+      --  This must be checked before the check for limited types below,
+      --  to ensure that types declared limited are not allowed to extend
+      --  synchronized interfaces.
 
-   ------------------------------
-   -- Analyze_Type_Declaration --
-   ------------------------------
+      elsif Is_Interface (Parent_Type)
+        and then Is_Synchronized_Interface (Parent_Type)
+        and then not Synchronized_Present (N)
+      then
+         Error_Msg_NE
+           ("private extension of& must be explicitly synchronized",
+             N, Parent_Type);
 
-   procedure Analyze_Type_Declaration (N : Node_Id) is
-      Def    : constant Node_Id   := Type_Definition (N);
-      Def_Id : constant Entity_Id := Defining_Identifier (N);
-      T      : Entity_Id;
-      Prev   : Entity_Id;
+      elsif Limited_Present (N) then
+         Set_Is_Limited_Record (T);
 
-      Is_Remote : constant Boolean :=
-                    (Is_Remote_Types (Current_Scope)
-                       or else Is_Remote_Call_Interface (Current_Scope))
-                    and then not (In_Private_Part (Current_Scope)
-                                    or else In_Package_Body (Current_Scope));
+         if not Is_Limited_Type (Parent_Type)
+           and then
+             (not Is_Interface (Parent_Type)
+               or else not Is_Limited_Interface (Parent_Type))
+         then
+            Error_Msg_NE ("parent type& of limited extension must be limited",
+              N, Parent_Type);
+         end if;
+      end if;
 
-      procedure Check_Ops_From_Incomplete_Type;
-      --  If there is a tagged incomplete partial view of the type, transfer
-      --  its operations to the full view, and indicate that the type of the
-      --  controlling parameter (s) is this full view.
+      <<Leave>> Analyze_Aspect_Specifications (N, T, AS);
+   end Analyze_Private_Extension_Declaration;
 
-      ------------------------------------
-      -- Check_Ops_From_Incomplete_Type --
-      ------------------------------------
+   ---------------------------------
+   -- Analyze_Subtype_Declaration --
+   ---------------------------------
 
-      procedure Check_Ops_From_Incomplete_Type is
-         Elmt   : Elmt_Id;
-         Formal : Entity_Id;
-         Op     : Entity_Id;
+   procedure Analyze_Subtype_Declaration
+     (N    : Node_Id;
+      Skip : Boolean := False)
+   is
+      Id       : constant Entity_Id := Defining_Identifier (N);
+      AS       : constant List_Id   := Aspect_Specifications (N);
+      T        : Entity_Id;
+      R_Checks : Check_Result;
 
-      begin
-         if Prev /= T
-           and then Ekind (Prev) = E_Incomplete_Type
-           and then Is_Tagged_Type (Prev)
-           and then Is_Tagged_Type (T)
-         then
-            Elmt := First_Elmt (Primitive_Operations (Prev));
-            while Present (Elmt) loop
-               Op := Node (Elmt);
-               Prepend_Elmt (Op, Primitive_Operations (T));
+   begin
+      Generate_Definition (Id);
+      Set_Is_Pure (Id, Is_Pure (Current_Scope));
+      Init_Size_Align (Id);
 
-               Formal := First_Formal (Op);
-               while Present (Formal) loop
-                  if Etype (Formal) = Prev then
-                     Set_Etype (Formal, T);
-                  end if;
+      --  The following guard condition on Enter_Name is to handle cases where
+      --  the defining identifier has already been entered into the scope but
+      --  the declaration as a whole needs to be analyzed.
 
-                  Next_Formal (Formal);
-               end loop;
+      --  This case in particular happens for derived enumeration types. The
+      --  derived enumeration type is processed as an inserted enumeration type
+      --  declaration followed by a rewritten subtype declaration. The defining
+      --  identifier, however, is entered into the name scope very early in the
+      --  processing of the original type declaration and therefore needs to be
+      --  avoided here, when the created subtype declaration is analyzed. (See
+      --  Build_Derived_Types)
 
-               if Etype (Op) = Prev then
-                  Set_Etype (Op, T);
-               end if;
+      --  This also happens when the full view of a private type is derived
+      --  type with constraints. In this case the entity has been introduced
+      --  in the private declaration.
 
-               Next_Elmt (Elmt);
-            end loop;
-         end if;
-      end Check_Ops_From_Incomplete_Type;
+      if Skip
+        or else (Present (Etype (Id))
+                   and then (Is_Private_Type (Etype (Id))
+                               or else Is_Task_Type (Etype (Id))
+                               or else Is_Rewrite_Substitution (N)))
+      then
+         null;
 
-   --  Start of processing for Analyze_Type_Declaration
+      else
+         Enter_Name (Id);
+      end if;
 
-   begin
-      Prev := Find_Type_Name (N);
+      T := Process_Subtype (Subtype_Indication (N), N, Id, 'P');
 
-      --  The full view, if present, now points to the current type
+      --  Inherit common attributes
 
-      --  Ada 2005 (AI-50217): If the type was previously decorated when
-      --  imported through a LIMITED WITH clause, it appears as incomplete
-      --  but has no full view.
-      --  If the incomplete view is tagged, a class_wide type has been
-      --  created already. Use it for the full view as well, to prevent
-      --  multiple incompatible class-wide types that may be  created for
-      --  self-referential anonymous access components.
+      Set_Is_Generic_Type   (Id, Is_Generic_Type   (Base_Type (T)));
+      Set_Is_Volatile       (Id, Is_Volatile       (T));
+      Set_Treat_As_Volatile (Id, Treat_As_Volatile (T));
+      Set_Is_Atomic         (Id, Is_Atomic         (T));
+      Set_Is_Ada_2005_Only  (Id, Is_Ada_2005_Only  (T));
+      Set_Is_Ada_2012_Only  (Id, Is_Ada_2012_Only  (T));
+      Set_Convention        (Id, Convention        (T));
 
-      if Ekind (Prev) = E_Incomplete_Type
-        and then Present (Full_View (Prev))
-      then
-         T := Full_View (Prev);
+      --  In the case where there is no constraint given in the subtype
+      --  indication, Process_Subtype just returns the Subtype_Mark, so its
+      --  semantic attributes must be established here.
 
-         if Is_Tagged_Type (Prev)
-           and then Present (Class_Wide_Type (Prev))
-         then
-            Set_Ekind (T, Ekind (Prev));         --  will be reset later
-            Set_Class_Wide_Type (T, Class_Wide_Type (Prev));
-            Set_Etype (Class_Wide_Type (T), T);
-         end if;
+      if Nkind (Subtype_Indication (N)) /= N_Subtype_Indication then
+         Set_Etype (Id, Base_Type (T));
 
-      else
-         T := Prev;
-      end if;
+         case Ekind (T) is
+            when Array_Kind =>
+               Set_Ekind                       (Id, E_Array_Subtype);
+               Copy_Array_Subtype_Attributes   (Id, T);
 
-      Set_Is_Pure (T, Is_Pure (Current_Scope));
+            when Decimal_Fixed_Point_Kind =>
+               Set_Ekind                (Id, E_Decimal_Fixed_Point_Subtype);
+               Set_Digits_Value         (Id, Digits_Value       (T));
+               Set_Delta_Value          (Id, Delta_Value        (T));
+               Set_Scale_Value          (Id, Scale_Value        (T));
+               Set_Small_Value          (Id, Small_Value        (T));
+               Set_Scalar_Range         (Id, Scalar_Range       (T));
+               Set_Machine_Radix_10     (Id, Machine_Radix_10   (T));
+               Set_Is_Constrained       (Id, Is_Constrained     (T));
+               Set_Is_Known_Valid       (Id, Is_Known_Valid     (T));
+               Set_RM_Size              (Id, RM_Size            (T));
 
-      --  We set the flag Is_First_Subtype here. It is needed to set the
-      --  corresponding flag for the Implicit class-wide-type created
-      --  during tagged types processing.
+            when Enumeration_Kind =>
+               Set_Ekind                (Id, E_Enumeration_Subtype);
+               Set_First_Literal        (Id, First_Literal (Base_Type (T)));
+               Set_Scalar_Range         (Id, Scalar_Range       (T));
+               Set_Is_Character_Type    (Id, Is_Character_Type  (T));
+               Set_Is_Constrained       (Id, Is_Constrained     (T));
+               Set_Is_Known_Valid       (Id, Is_Known_Valid     (T));
+               Set_RM_Size              (Id, RM_Size            (T));
 
-      Set_Is_First_Subtype (T, True);
+            when Ordinary_Fixed_Point_Kind =>
+               Set_Ekind                (Id, E_Ordinary_Fixed_Point_Subtype);
+               Set_Scalar_Range         (Id, Scalar_Range       (T));
+               Set_Small_Value          (Id, Small_Value        (T));
+               Set_Delta_Value          (Id, Delta_Value        (T));
+               Set_Is_Constrained       (Id, Is_Constrained     (T));
+               Set_Is_Known_Valid       (Id, Is_Known_Valid     (T));
+               Set_RM_Size              (Id, RM_Size            (T));
 
-      --  Only composite types other than array types are allowed to have
-      --  discriminants.
+            when Float_Kind =>
+               Set_Ekind                (Id, E_Floating_Point_Subtype);
+               Set_Scalar_Range         (Id, Scalar_Range       (T));
+               Set_Digits_Value         (Id, Digits_Value       (T));
+               Set_Is_Constrained       (Id, Is_Constrained     (T));
 
-      case Nkind (Def) is
+            when Signed_Integer_Kind =>
+               Set_Ekind                (Id, E_Signed_Integer_Subtype);
+               Set_Scalar_Range         (Id, Scalar_Range       (T));
+               Set_Is_Constrained       (Id, Is_Constrained     (T));
+               Set_Is_Known_Valid       (Id, Is_Known_Valid     (T));
+               Set_RM_Size              (Id, RM_Size            (T));
 
-         --  For derived types, the rule will be checked once we've figured
-         --  out the parent type.
+            when Modular_Integer_Kind =>
+               Set_Ekind                (Id, E_Modular_Integer_Subtype);
+               Set_Scalar_Range         (Id, Scalar_Range       (T));
+               Set_Is_Constrained       (Id, Is_Constrained     (T));
+               Set_Is_Known_Valid       (Id, Is_Known_Valid     (T));
+               Set_RM_Size              (Id, RM_Size            (T));
 
-         when N_Derived_Type_Definition =>
-            null;
+            when Class_Wide_Kind =>
+               Set_Ekind                (Id, E_Class_Wide_Subtype);
+               Set_First_Entity         (Id, First_Entity       (T));
+               Set_Last_Entity          (Id, Last_Entity        (T));
+               Set_Class_Wide_Type      (Id, Class_Wide_Type    (T));
+               Set_Cloned_Subtype       (Id, T);
+               Set_Is_Tagged_Type       (Id, True);
+               Set_Has_Unknown_Discriminants
+                                        (Id, True);
 
-         --  For record types, discriminants are allowed
+               if Ekind (T) = E_Class_Wide_Subtype then
+                  Set_Equivalent_Type   (Id, Equivalent_Type    (T));
+               end if;
 
-         when N_Record_Definition =>
-            null;
+            when E_Record_Type | E_Record_Subtype =>
+               Set_Ekind                (Id, E_Record_Subtype);
 
-         when others =>
-            if Present (Discriminant_Specifications (N)) then
-               Error_Msg_N
-                 ("elementary or array type cannot have discriminants",
-                  Defining_Identifier
-                  (First (Discriminant_Specifications (N))));
-            end if;
-      end case;
+               if Ekind (T) = E_Record_Subtype
+                 and then Present (Cloned_Subtype (T))
+               then
+                  Set_Cloned_Subtype    (Id, Cloned_Subtype (T));
+               else
+                  Set_Cloned_Subtype    (Id, T);
+               end if;
 
-      --  Elaborate the type definition according to kind, and generate
-      --  subsidiary (implicit) subtypes where needed. We skip this if it was
-      --  already done (this happens during the reanalysis that follows a call
-      --  to the high level optimizer).
+               Set_First_Entity         (Id, First_Entity       (T));
+               Set_Last_Entity          (Id, Last_Entity        (T));
+               Set_Has_Discriminants    (Id, Has_Discriminants  (T));
+               Set_Is_Constrained       (Id, Is_Constrained     (T));
+               Set_Is_Limited_Record    (Id, Is_Limited_Record  (T));
+               Set_Has_Unknown_Discriminants
+                                        (Id, Has_Unknown_Discriminants (T));
 
-      if not Analyzed (T) then
-         Set_Analyzed (T);
+               if Has_Discriminants (T) then
+                  Set_Discriminant_Constraint
+                                        (Id, Discriminant_Constraint (T));
+                  Set_Stored_Constraint_From_Discriminant_Constraint (Id);
 
-         case Nkind (Def) is
+               elsif Has_Unknown_Discriminants (Id) then
+                  Set_Discriminant_Constraint (Id, No_Elist);
+               end if;
 
-            when N_Access_To_Subprogram_Definition =>
-               Access_Subprogram_Declaration (T, Def);
+               if Is_Tagged_Type (T) then
+                  Set_Is_Tagged_Type    (Id);
+                  Set_Is_Abstract_Type  (Id, Is_Abstract_Type (T));
+                  Set_Primitive_Operations
+                                        (Id, Primitive_Operations (T));
+                  Set_Class_Wide_Type   (Id, Class_Wide_Type (T));
 
-               --  If this is a remote access to subprogram, we must create the
-               --  equivalent fat pointer type, and related subprograms.
+                  if Is_Interface (T) then
+                     Set_Is_Interface (Id);
+                     Set_Is_Limited_Interface (Id, Is_Limited_Interface (T));
+                  end if;
+               end if;
 
-               if Is_Remote then
-                  Process_Remote_AST_Declaration (N);
+            when Private_Kind =>
+               Set_Ekind              (Id, Subtype_Kind (Ekind   (T)));
+               Set_Has_Discriminants  (Id, Has_Discriminants     (T));
+               Set_Is_Constrained     (Id, Is_Constrained        (T));
+               Set_First_Entity       (Id, First_Entity          (T));
+               Set_Last_Entity        (Id, Last_Entity           (T));
+               Set_Private_Dependents (Id, New_Elmt_List);
+               Set_Is_Limited_Record  (Id, Is_Limited_Record     (T));
+               Set_Has_Unknown_Discriminants
+                                      (Id, Has_Unknown_Discriminants (T));
+               Set_Known_To_Have_Preelab_Init
+                                      (Id, Known_To_Have_Preelab_Init (T));
+
+               if Is_Tagged_Type (T) then
+                  Set_Is_Tagged_Type       (Id);
+                  Set_Is_Abstract_Type     (Id, Is_Abstract_Type (T));
+                  Set_Primitive_Operations (Id, Primitive_Operations (T));
+                  Set_Class_Wide_Type      (Id, Class_Wide_Type (T));
                end if;
 
-               --  Validate categorization rule against access type declaration
-               --  usually a violation in Pure unit, Shared_Passive unit.
+               --  In general the attributes of the subtype of a private type
+               --  are the attributes of the partial view of parent. However,
+               --  the full view may be a discriminated type, and the subtype
+               --  must share the discriminant constraint to generate correct
+               --  calls to initialization procedures.
 
-               Validate_Access_Type_Declaration (T, N);
+               if Has_Discriminants (T) then
+                  Set_Discriminant_Constraint
+                                     (Id, Discriminant_Constraint (T));
+                  Set_Stored_Constraint_From_Discriminant_Constraint (Id);
 
-            when N_Access_To_Object_Definition =>
-               Access_Type_Declaration (T, Def);
+               elsif Present (Full_View (T))
+                 and then Has_Discriminants (Full_View (T))
+               then
+                  Set_Discriminant_Constraint
+                               (Id, Discriminant_Constraint (Full_View (T)));
+                  Set_Stored_Constraint_From_Discriminant_Constraint (Id);
 
-               --  Validate categorization rule against access type declaration
-               --  usually a violation in Pure unit, Shared_Passive unit.
+                  --  This would seem semantically correct, but apparently
+                  --  confuses the back-end. To be explained and checked with
+                  --  current version ???
 
-               Validate_Access_Type_Declaration (T, N);
+                  --  Set_Has_Discriminants (Id);
+               end if;
 
-               --  If we are in a Remote_Call_Interface package and define a
-               --  RACW, then calling stubs and specific stream attributes
-               --  must be added.
+               Prepare_Private_Subtype_Completion (Id, N);
 
-               if Is_Remote
-                 and then Is_Remote_Access_To_Class_Wide_Type (Def_Id)
+            when Access_Kind =>
+               Set_Ekind             (Id, E_Access_Subtype);
+               Set_Is_Constrained    (Id, Is_Constrained        (T));
+               Set_Is_Access_Constant
+                                     (Id, Is_Access_Constant    (T));
+               Set_Directly_Designated_Type
+                                     (Id, Designated_Type       (T));
+               Set_Can_Never_Be_Null (Id, Can_Never_Be_Null     (T));
+
+               --  A Pure library_item must not contain the declaration of a
+               --  named access type, except within a subprogram, generic
+               --  subprogram, task unit, or protected unit, or if it has
+               --  a specified Storage_Size of zero (RM05-10.2.1(15.4-15.5)).
+
+               if Comes_From_Source (Id)
+                 and then In_Pure_Unit
+                 and then not In_Subprogram_Task_Protected_Unit
+                 and then not No_Pool_Assigned (Id)
                then
-                  Add_RACW_Features (Def_Id);
+                  Error_Msg_N
+                    ("named access types not allowed in pure unit", N);
                end if;
 
-               --  Set no strict aliasing flag if config pragma seen
+            when Concurrent_Kind =>
+               Set_Ekind                (Id, Subtype_Kind (Ekind   (T)));
+               Set_Corresponding_Record_Type (Id,
+                                         Corresponding_Record_Type (T));
+               Set_First_Entity         (Id, First_Entity          (T));
+               Set_First_Private_Entity (Id, First_Private_Entity  (T));
+               Set_Has_Discriminants    (Id, Has_Discriminants     (T));
+               Set_Is_Constrained       (Id, Is_Constrained        (T));
+               Set_Is_Tagged_Type       (Id, Is_Tagged_Type        (T));
+               Set_Last_Entity          (Id, Last_Entity           (T));
 
-               if Opt.No_Strict_Aliasing then
-                  Set_No_Strict_Aliasing (Base_Type (Def_Id));
+               if Has_Discriminants (T) then
+                  Set_Discriminant_Constraint (Id,
+                                           Discriminant_Constraint (T));
+                  Set_Stored_Constraint_From_Discriminant_Constraint (Id);
                end if;
 
-            when N_Array_Type_Definition =>
-               Array_Type_Declaration (T, Def);
-
-            when N_Derived_Type_Definition =>
-               Derived_Type_Declaration (T, N, T /= Def_Id);
-
-            when N_Enumeration_Type_Definition =>
-               Enumeration_Type_Declaration (T, Def);
-
-            when N_Floating_Point_Definition =>
-               Floating_Point_Type_Declaration (T, Def);
-
-            when N_Decimal_Fixed_Point_Definition =>
-               Decimal_Fixed_Point_Type_Declaration (T, Def);
+            when E_Incomplete_Type =>
+               if Ada_Version >= Ada_2005 then
+                  Set_Ekind (Id, E_Incomplete_Subtype);
 
-            when N_Ordinary_Fixed_Point_Definition =>
-               Ordinary_Fixed_Point_Type_Declaration (T, Def);
+                  --  Ada 2005 (AI-412): Decorate an incomplete subtype
+                  --  of an incomplete type visible through a limited
+                  --  with clause.
 
-            when N_Signed_Integer_Type_Definition =>
-               Signed_Integer_Type_Declaration (T, Def);
+                  if From_With_Type (T)
+                    and then Present (Non_Limited_View (T))
+                  then
+                     Set_From_With_Type   (Id);
+                     Set_Non_Limited_View (Id, Non_Limited_View (T));
 
-            when N_Modular_Type_Definition =>
-               Modular_Type_Declaration (T, Def);
+                  --  Ada 2005 (AI-412): Add the regular incomplete subtype
+                  --  to the private dependents of the original incomplete
+                  --  type for future transformation.
 
-            when N_Record_Definition =>
-               Record_Type_Declaration (T, N, Prev);
+                  else
+                     Append_Elmt (Id, Private_Dependents (T));
+                  end if;
 
-            --  If declaration has a parse error, nothing to elaborate.
+               --  If the subtype name denotes an incomplete type an error
+               --  was already reported by Process_Subtype.
 
-            when N_Error =>
-               null;
+               else
+                  Set_Etype (Id, Any_Type);
+               end if;
 
             when others =>
                raise Program_Error;
-
          end case;
       end if;
 
-      if Etype (T) = Any_Type then
-         return;
+      if Etype (Id) = Any_Type then
+         goto Leave;
       end if;
 
-      --  Some common processing for all types
+      --  Some common processing on all types
 
-      Set_Depends_On_Private (T, Has_Private_Component (T));
-      Check_Ops_From_Incomplete_Type;
+      Set_Size_Info      (Id,                 T);
+      Set_First_Rep_Item (Id, First_Rep_Item (T));
 
-      --  Both the declared entity, and its anonymous base type if one
-      --  was created, need freeze nodes allocated.
+      T := Etype (Id);
 
-      declare
-         B : constant Entity_Id := Base_Type (T);
+      Set_Is_Immediately_Visible   (Id, True);
+      Set_Depends_On_Private       (Id, Has_Private_Component (T));
+      Set_Is_Descendent_Of_Address (Id, Is_Descendent_Of_Address (T));
 
-      begin
-         --  In the case where the base type differs from the first subtype, we
-         --  pre-allocate a freeze node, and set the proper link to the first
-         --  subtype. Freeze_Entity will use this preallocated freeze node when
-         --  it freezes the entity.
+      if Is_Interface (T) then
+         Set_Is_Interface (Id);
+      end if;
 
-         --  This does not apply if the base type is a generic type, whose
-         --  declaration is independent of the current derived definition.
+      if Present (Generic_Parent_Type (N))
+        and then
+          (Nkind
+            (Parent (Generic_Parent_Type (N))) /= N_Formal_Type_Declaration
+            or else Nkind
+              (Formal_Type_Definition (Parent (Generic_Parent_Type (N))))
+                /= N_Formal_Private_Type_Definition)
+      then
+         if Is_Tagged_Type (Id) then
 
-         if B /= T and then not Is_Generic_Type (B) then
-            Ensure_Freeze_Node (B);
-            Set_First_Subtype_Link (Freeze_Node (B), T);
-         end if;
+            --  If this is a generic actual subtype for a synchronized type,
+            --  the primitive operations are those of the corresponding record
+            --  for which there is a separate subtype declaration.
 
-         --  A type that is imported through a limited_with clause cannot
-         --  generate any code, and thus need not be frozen. However, an access
-         --  type with an imported designated type needs a finalization list,
-         --  which may be referenced in some other package that has non-limited
-         --  visibility on the designated type. Thus we must create the
-         --  finalization list at the point the access type is frozen, to
-         --  prevent unsatisfied references at link time.
+            if Is_Concurrent_Type (Id) then
+               null;
+            elsif Is_Class_Wide_Type (Id) then
+               Derive_Subprograms (Generic_Parent_Type (N), Id, Etype (T));
+            else
+               Derive_Subprograms (Generic_Parent_Type (N), Id, T);
+            end if;
 
-         if not From_With_Type (T) or else Is_Access_Type (T) then
-            Set_Has_Delayed_Freeze (T);
+         elsif Scope (Etype (Id)) /= Standard_Standard then
+            Derive_Subprograms (Generic_Parent_Type (N), Id);
          end if;
-      end;
+      end if;
 
-      --  Case where T is the full declaration of some private type which has
-      --  been swapped in Defining_Identifier (N).
+      if Is_Private_Type (T)
+        and then Present (Full_View (T))
+      then
+         Conditional_Delay (Id, Full_View (T));
 
-      if T /= Def_Id and then Is_Private_Type (Def_Id) then
-         Process_Full_View (N, T, Def_Id);
+      --  The subtypes of components or subcomponents of protected types
+      --  do not need freeze nodes, which would otherwise appear in the
+      --  wrong scope (before the freeze node for the protected type). The
+      --  proper subtypes are those of the subcomponents of the corresponding
+      --  record.
 
-         --  Record the reference. The form of this is a little strange, since
-         --  the full declaration has been swapped in. So the first parameter
-         --  here represents the entity to which a reference is made which is
-         --  the "real" entity, i.e. the one swapped in, and the second
-         --  parameter provides the reference location.
+      elsif Ekind (Scope (Id)) /= E_Protected_Type
+        and then Present (Scope (Scope (Id))) -- error defense!
+        and then Ekind (Scope (Scope (Id))) /= E_Protected_Type
+      then
+         Conditional_Delay (Id, T);
+      end if;
 
-         --  Also, we want to kill Has_Pragma_Unreferenced temporarily here
-         --  since we don't want a complaint about the full type being an
-         --  unwanted reference to the private type
+      --  Check that constraint_error is raised for a scalar subtype
+      --  indication when the lower or upper bound of a non-null range
+      --  lies outside the range of the type mark.
 
-         declare
-            B : constant Boolean := Has_Pragma_Unreferenced (T);
-         begin
-            Set_Has_Pragma_Unreferenced (T, False);
-            Generate_Reference (T, T, 'c');
-            Set_Has_Pragma_Unreferenced (T, B);
-         end;
+      if Nkind (Subtype_Indication (N)) = N_Subtype_Indication then
+         if Is_Scalar_Type (Etype (Id))
+            and then Scalar_Range (Id) /=
+                     Scalar_Range (Etype (Subtype_Mark
+                                           (Subtype_Indication (N))))
+         then
+            Apply_Range_Check
+              (Scalar_Range (Id),
+               Etype (Subtype_Mark (Subtype_Indication (N))));
 
-         Set_Completion_Referenced (Def_Id);
+         elsif Is_Array_Type (Etype (Id))
+           and then Present (First_Index (Id))
+         then
+            --  This really should be a subprogram that finds the indications
+            --  to check???
 
-      --  For completion of incomplete type, process incomplete dependents
-      --  and always mark the full type as referenced (it is the incomplete
-      --  type that we get for any real reference).
+            if ((Nkind (First_Index (Id)) = N_Identifier
+                   and then Ekind (Entity (First_Index (Id))) in Scalar_Kind)
+                 or else Nkind (First_Index (Id)) = N_Subtype_Indication)
+              and then
+                Nkind (Scalar_Range (Etype (First_Index (Id)))) = N_Range
+            then
+               declare
+                  Target_Typ : constant Entity_Id :=
+                                 Etype
+                                   (First_Index (Etype
+                                     (Subtype_Mark (Subtype_Indication (N)))));
+               begin
+                  R_Checks :=
+                    Get_Range_Checks
+                      (Scalar_Range (Etype (First_Index (Id))),
+                       Target_Typ,
+                       Etype (First_Index (Id)),
+                       Defining_Identifier (N));
 
-      elsif Ekind (Prev) = E_Incomplete_Type then
-         Process_Incomplete_Dependents (N, T, Prev);
-         Generate_Reference (Prev, Def_Id, 'c');
-         Set_Completion_Referenced (Def_Id);
+                  Insert_Range_Checks
+                    (R_Checks,
+                     N,
+                     Target_Typ,
+                     Sloc (Defining_Identifier (N)));
+               end;
+            end if;
+         end if;
+      end if;
 
-      --  If not private type or incomplete type completion, this is a real
-      --  definition of a new entity, so record it.
+      Set_Optimize_Alignment_Flags (Id);
+      Check_Eliminated (Id);
 
-      else
-         Generate_Definition (Def_Id);
-      end if;
+      <<Leave>> Analyze_Aspect_Specifications (N, Id, AS);
+   end Analyze_Subtype_Declaration;
 
-      if Chars (Scope (Def_Id)) = Name_System
-        and then Chars (Def_Id) = Name_Address
-        and then Is_Predefined_File_Name (Unit_File_Name (Get_Source_Unit (N)))
-      then
-         Set_Is_Descendent_Of_Address (Def_Id);
-         Set_Is_Descendent_Of_Address (Base_Type (Def_Id));
-         Set_Is_Descendent_Of_Address (Prev);
-      end if;
+   --------------------------------
+   -- Analyze_Subtype_Indication --
+   --------------------------------
 
-      Set_Optimize_Alignment_Flags (Def_Id);
-      Check_Eliminated (Def_Id);
-   end Analyze_Type_Declaration;
+   procedure Analyze_Subtype_Indication (N : Node_Id) is
+      T : constant Entity_Id := Subtype_Mark (N);
+      R : constant Node_Id   := Range_Expression (Constraint (N));
+
+   begin
+      Analyze (T);
+
+      if R /= Error then
+         Analyze (R);
+         Set_Etype (N, Etype (R));
+         Resolve (R, Entity (T));
+      else
+         Set_Error_Posted (R);
+         Set_Error_Posted (T);
+      end if;
+   end Analyze_Subtype_Indication;
 
    --------------------------
    -- Analyze_Variant_Part --
Index: sem_ch3.ads
===================================================================
--- sem_ch3.ads	(revision 165256)
+++ sem_ch3.ads	(working copy)
@@ -28,6 +28,7 @@ with Types;  use Types;
 
 package Sem_Ch3 is
    procedure Analyze_Component_Declaration         (N : Node_Id);
+   procedure Analyze_Full_Type_Declaration         (N : Node_Id);
    procedure Analyze_Incomplete_Type_Decl          (N : Node_Id);
    procedure Analyze_Itype_Reference               (N : Node_Id);
    procedure Analyze_Number_Declaration            (N : Node_Id);
@@ -35,7 +36,6 @@ package Sem_Ch3 is
    procedure Analyze_Others_Choice                 (N : Node_Id);
    procedure Analyze_Private_Extension_Declaration (N : Node_Id);
    procedure Analyze_Subtype_Indication            (N : Node_Id);
-   procedure Analyze_Type_Declaration              (N : Node_Id);
    procedure Analyze_Variant_Part                  (N : Node_Id);
 
    procedure Analyze_Subtype_Declaration
Index: sinfo.adb
===================================================================
--- sinfo.adb	(revision 165289)
+++ sinfo.adb	(working copy)
@@ -32,10 +32,8 @@
 pragma Style_Checks (All_Checks);
 --  No subprogram ordering check, due to logical grouping
 
-with Atree;  use Atree;
-with Nlists; use Nlists;
-
-with GNAT.HTable;
+with Aspects; use Aspects;
+with Atree;   use Atree;
 
 package body Sinfo is
 
@@ -56,30 +54,6 @@ package body Sinfo is
    NT : Nodes.Table_Ptr renames Nodes.Table;
    --  A short hand abbreviation, useful for the debugging checks
 
-   ------------------------------------------
-   -- Hash Table for Aspect Specifications --
-   ------------------------------------------
-
-   type Hash_Range is range 0 .. 510;
-   --  Size of hash table headers
-
-   function AS_Hash (F : Node_Id) return Hash_Range;
-   --  Hash function for hash table
-
-   function AS_Hash (F : Node_Id) return Hash_Range is
-   begin
-      return Hash_Range (F mod 511);
-   end AS_Hash;
-
-   package Aspect_Specifications_Hash_Table is new
-     GNAT.HTable.Simple_HTable
-       (Header_Num => Hash_Range,
-        Element    => List_Id,
-        No_Element => No_List,
-        Key        => Node_Id,
-        Hash       => AS_Hash,
-        Equal      => "=");
-
    ----------------------------
    -- Field Access Functions --
    ----------------------------
@@ -282,6 +256,14 @@ package body Sinfo is
       return Node3 (N);
    end Array_Aggregate;
 
+   function Aspect_Cancel
+      (N : Node_Id) return Boolean is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Pragma);
+      return Flag11 (N);
+   end Aspect_Cancel;
+
    function Assignment_OK
       (N : Node_Id) return Boolean is
    begin
@@ -1251,14 +1233,6 @@ package body Sinfo is
       return List1 (N);
    end Expressions;
 
-   function First_Aspect
-      (N : Node_Id) return Boolean is
-   begin
-      pragma Assert (False
-        or else NT (N).Nkind = N_Aspect_Specification);
-      return Flag4 (N);
-   end First_Aspect;
-
    function First_Bit
       (N : Node_Id) return Node_Id is
    begin
@@ -1333,6 +1307,15 @@ package body Sinfo is
       return Flag5 (N);
    end Forwards_OK;
 
+   function From_Aspect_Specification
+      (N : Node_Id) return Boolean is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Attribute_Definition_Clause
+        or else NT (N).Nkind = N_Pragma);
+      return Flag13 (N);
+   end From_Aspect_Specification;
+
    function From_At_End
       (N : Node_Id) return Boolean is
    begin
@@ -1869,14 +1852,6 @@ package body Sinfo is
       return Node2 (N);
    end Label_Construct;
 
-   function Last_Aspect
-      (N : Node_Id) return Boolean is
-   begin
-      pragma Assert (False
-        or else NT (N).Nkind = N_Aspect_Specification);
-      return Flag5 (N);
-   end Last_Aspect;
-
    function Last_Bit
       (N : Node_Id) return Node_Id is
    begin
@@ -3229,6 +3204,14 @@ package body Sinfo is
       Set_Node3_With_Parent (N, Val);
    end Set_Array_Aggregate;
 
+   procedure Set_Aspect_Cancel
+      (N : Node_Id; Val : Boolean := True) is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Pragma);
+      Set_Flag11 (N, Val);
+   end Set_Aspect_Cancel;
+
    procedure Set_Assignment_OK
       (N : Node_Id; Val : Boolean := True) is
    begin
@@ -4189,14 +4172,6 @@ package body Sinfo is
       Set_List1_With_Parent (N, Val);
    end Set_Expressions;
 
-   procedure Set_First_Aspect
-      (N : Node_Id; Val : Boolean := True) is
-   begin
-      pragma Assert (False
-        or else NT (N).Nkind = N_Aspect_Specification);
-      Set_Flag4 (N, Val);
-   end Set_First_Aspect;
-
    procedure Set_First_Bit
       (N : Node_Id; Val : Node_Id) is
    begin
@@ -4271,6 +4246,15 @@ package body Sinfo is
       Set_Flag5 (N, Val);
    end Set_Forwards_OK;
 
+   procedure Set_From_Aspect_Specification
+      (N : Node_Id; Val : Boolean := True) is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Attribute_Definition_Clause
+        or else NT (N).Nkind = N_Pragma);
+      Set_Flag13 (N, Val);
+   end Set_From_Aspect_Specification;
+
    procedure Set_From_At_End
       (N : Node_Id; Val : Boolean := True) is
    begin
@@ -4816,14 +4800,6 @@ package body Sinfo is
       Set_Node4_With_Parent (N, Val);
    end Set_Last_Bit;
 
-   procedure Set_Last_Aspect
-      (N : Node_Id; Val : Boolean := True) is
-   begin
-      pragma Assert (False
-        or else NT (N).Nkind = N_Aspect_Specification);
-      Set_Flag5 (N, Val);
-   end Set_Last_Aspect;
-
    procedure Set_Last_Name
       (N : Node_Id; Val : Boolean := True) is
    begin
@@ -6163,65 +6139,4 @@ package body Sinfo is
       return Chars (Pragma_Identifier (N));
    end Pragma_Name;
 
-   -----------------------------------
-   -- Permits_Aspect_Specifications --
-   -----------------------------------
-
-   Has_Aspect_Specifications_Flag : constant array (Node_Kind) of Boolean :=
-     (N_Abstract_Subprogram_Declaration        => True,
-      N_Component_Declaration                  => True,
-      N_Entry_Declaration                      => True,
-      N_Exception_Declaration                  => True,
-      N_Formal_Abstract_Subprogram_Declaration => True,
-      N_Formal_Concrete_Subprogram_Declaration => True,
-      N_Formal_Object_Declaration              => True,
-      N_Formal_Package_Declaration             => True,
-      N_Formal_Type_Declaration                => True,
-      N_Full_Type_Declaration                  => True,
-      N_Function_Instantiation                 => True,
-      N_Generic_Package_Declaration            => True,
-      N_Generic_Subprogram_Declaration         => True,
-      N_Object_Declaration                     => True,
-      N_Package_Declaration                    => True,
-      N_Package_Instantiation                  => True,
-      N_Private_Extension_Declaration          => True,
-      N_Private_Type_Declaration               => True,
-      N_Procedure_Instantiation                => True,
-      N_Protected_Type_Declaration             => True,
-      N_Single_Protected_Declaration           => True,
-      N_Single_Task_Declaration                => True,
-      N_Subprogram_Declaration                 => True,
-      N_Subtype_Declaration                    => True,
-      N_Task_Type_Declaration                  => True,
-      others                                   => False);
-
-   function Permits_Aspect_Specifications (N : Node_Id) return Boolean is
-   begin
-      return Has_Aspect_Specifications_Flag (Nkind (N));
-   end Permits_Aspect_Specifications;
-
-   ---------------------------
-   -- Aspect_Specifications --
-   ---------------------------
-
-   function Aspect_Specifications (N : Node_Id) return List_Id is
-   begin
-      return Aspect_Specifications_Hash_Table.Get (N);
-   end Aspect_Specifications;
-
-   -------------------------------
-   -- Set_Aspect_Specifications --
-   -------------------------------
-
-   procedure Set_Aspect_Specifications (N : Node_Id; L : List_Id) is
-   begin
-      pragma Assert (Permits_Aspect_Specifications (N));
-      pragma Assert (not Has_Aspect_Specifications (N));
-      pragma Assert (L /= No_List);
-
-      Set_Has_Aspect_Specifications (N);
-      Set_Parent (L, N);
-      Aspect_Specifications_Hash_Table.Set (N, L);
-   end Set_Aspect_Specifications;
-
 end Sinfo;
Index: sinfo.ads
===================================================================
--- sinfo.ads	(revision 165279)
+++ sinfo.ads	(working copy)
@@ -455,13 +455,13 @@ package Sinfo is
 
    --  The following flag fields appear in all nodes
 
-   --  Analyzed (Flag1)
+   --  Analyzed
    --    This flag is used to indicate that a node (and all its children have
    --    been analyzed. It is used to avoid reanalysis of a node that has
    --    already been analyzed, both for efficiency and functional correctness
    --    reasons.
 
-   --  Comes_From_Source (Flag2)
+   --  Comes_From_Source
    --    This flag is set if the node comes directly from an explicit construct
    --    in the source. It is normally on for any nodes built by the scanner or
    --    parser from the source program, with the exception that in a few cases
@@ -475,7 +475,7 @@ package Sinfo is
    --    from the source program (e.g. the allocator built for build-in-place
    --    case), and the Comes_From_Source flag is deliberately set.
 
-   --  Error_Posted (Flag3)
+   --  Error_Posted
    --    This flag is used to avoid multiple error messages being posted on or
    --    referring to the same node. This flag is set if an error message
    --    refers to a node or is posted on its source location, and has the
@@ -587,6 +587,14 @@ package Sinfo is
    --    is used for translation of the at end handler into a normal exception
    --    handler.
 
+   --  Aspect_Cancel (Flag11-Sem)
+   --    Processing of aspect specifications typically generates pragmas and
+   --    attribute definition clauses that are inserted into the tree after
+   --    the declaration node to get the desired aspect effect. In the case
+   --    of Boolean aspects that use "=> False" to cancel the effect of an
+   --    aspect (i.e. turn if off), the generated pragma has the Aspect_Cancel
+   --    flag set to indicate that the pragma operates in the opposite sense.
+
    --  Assignment_OK (Flag15-Sem)
    --    This flag is set in a subexpression node for an object, indicating
    --    that the associated object can be modified, even if this would not
@@ -1056,6 +1064,12 @@ package Sinfo is
    --    cannot figure it out. If both flags Forwards_OK and Backwards_OK are
    --    set, it means that the front end can assure no overlap of operands.
 
+   --  From_Aspect_Specification (Flag13-Sem)
+   --    Processing of aspect specifications typically results in insertion in
+   --    the tree of corresponding pragma or attribute definition clause nodes.
+   --    These generated nodes have the From_Aspect_Specification flag set to
+   --    indicate that they came from aspect specifications originally.
+
    --  From_At_End (Flag4-Sem)
    --    This flag is set on an N_Raise_Statement node if it corresponds to
    --    the reraise statement generated as the last statement of an AT END
@@ -1996,11 +2010,13 @@ package Sinfo is
       --  Sloc points to PRAGMA
       --  Next_Pragma (Node1-Sem)
       --  Pragma_Argument_Associations (List2) (set to No_List if none)
-      --  Debug_Statement (Node3) (set to Empty if not Debug, Assert)
+      --  Debug_Statement (Node3) (set to Empty if not Debug)
       --  Pragma_Identifier (Node4)
       --  Next_Rep_Item (Node5-Sem)
       --  Pragma_Enabled (Flag5-Sem)
+      --  From_Aspect_Specification (Flag13-Sem)
       --  Import_Interface_Present (Flag16-Sem)
+      --  Aspect_Cancel (Flag11-Sem)
 
       --  Note: we should have a section on what pragmas are passed on to
       --  the back end to be processed. This section should note that pragma
@@ -2010,7 +2026,12 @@ package Sinfo is
       --  Note: a utility function Pragma_Name may be applied to pragma nodes
       --  to conveniently obtain the Chars field of the Pragma_Identifier.
 
-      --------------------------------------
+      --  Note: if From_Aspect_Specification is set, then Sloc points to the
+      --  aspect name, as does the Pragma_Identifier. In this case if the
+      --  pragma has a local name argument (such as pragma Inline), it is
+      --  resolved to point to the specific entity affected by the pragma.
+
+   --------------------------------------
       -- 2.8  Pragma Argument Association --
       --------------------------------------
 
@@ -2818,7 +2839,7 @@ package Sinfo is
 
       --  COMPONENT_DECLARATION ::=
       --    DEFINING_IDENTIFIER_LIST : COMPONENT_DEFINITION
-      --      [:= DEFAULT_EXPRESSION]
+      --      [:= DEFAULT_EXPRESSION];
 
       --  Note: although the syntax does not permit a component definition to
       --  be an anonymous array (and the parser will diagnose such an attempt
@@ -6395,30 +6416,48 @@ package Sinfo is
       --  Next_Rep_Item (Node5-Sem)
       --  From_At_Mod (Flag4-Sem)
       --  Check_Address_Alignment (Flag11-Sem)
+      --  From_Aspect_Specification (Flag13-Sem)
       --  Address_Warning_Posted (Flag18-Sem)
 
-      ----------------------------------
-      -- 13.3.1  Aspect Specification --
-      ----------------------------------
+      --  Note: if From_Aspect_Specification is set, then Sloc points to the
+      --  aspect name, and Entity is resolved already to reference the entity
+      --  to which the aspect applies.
+
+      -----------------------------------
+      -- 13.3.1  Aspect Specifications --
+      -----------------------------------
+
+      --  We modify the RM grammar here, the RM grammar is:
+
+      --     ASPECT_SPECIFICATION ::=
+      --       with ASPECT_MARK [=> ASPECT_DEFINITION] {.
+      --            ASPECT_MARK [=> ASPECT_DEFINITION] }
+
+      --     ASPECT_MARK ::= aspect_IDENTIFIER['Class]
+
+      --     ASPECT_DEFINITION ::= NAME | EXPRESSION
+
+      --  That's inconvenient, since there is no non-terminal name for a single
+      --  entry in the list of aspects. So we use this grammar instead:
+
+      --     ASPECT_SPECIFICATIONS ::=
+      --       with ASPECT_SPECIFICATION {, ASPECT_SPECIFICATION};
 
-      --  ASPECT_SPECIFICATION ::=
-      --    with ASPECT_MARK [=> ASPECT_DEFINITION] {.
-      --         ASPECT_MARK [=> ASPECT_DEFINITION] }
+      --     ASPECT_SPECIFICATION =>
+      --       ASPECT_MARK [=> ASPECT_DEFINITION]
 
-      --  ASPECT_MARK ::= aspect_IDENTIFIER['Class]
+      --     ASPECT_MARK ::= aspect_IDENTIFIER['Class]
 
-      --  ASPECT_DEFINITION ::= NAME | EXPRESSION
+      --     ASPECT_DEFINITION ::= NAME | EXPRESSION
 
-      --  See separate section "Handling of Aspect Specifications" for details
-      --  on the incorporation of these nodes into the tree, and association
-      --  with the related declaration node.
+      --  See separate package Aspects for details on the incorporation of
+      --  these nodes into the tree, and how aspect specifications for a given
+      --  declaration node are associated with that node.
 
       --  N_Aspect_Specification
       --  Sloc points to aspect identifier
       --  Identifier (Node1) aspect identifier
       --  Expression (Node3) Aspect_Definition (set to Empty if none)
-      --  First_Aspect (Flag4) Set for first aspect for a declaration
-      --  Last_Aspect (Flag5) Set for last aspect for a declaration
       --  Class_Present (Flag6) Set if 'Class present
 
       --  Note: Aspect_Specification is an Ada 2012 feature
@@ -7900,6 +7939,9 @@ package Sinfo is
    function Array_Aggregate
      (N : Node_Id) return Node_Id;    -- Node3
 
+   function Aspect_Cancel
+     (N : Node_Id) return Boolean;    -- Flag11
+
    function Assignment_OK
      (N : Node_Id) return Boolean;    -- Flag15
 
@@ -8197,9 +8239,6 @@ package Sinfo is
    function Expressions
      (N : Node_Id) return List_Id;    -- List1
 
-   function First_Aspect
-     (N : Node_Id) return Boolean;    -- Flag4
-
    function First_Bit
      (N : Node_Id) return Node_Id;    -- Node3
 
@@ -8227,6 +8266,9 @@ package Sinfo is
    function Forwards_OK
      (N : Node_Id) return Boolean;    -- Flag5
 
+   function From_Aspect_Specification
+     (N : Node_Id) return Boolean;    -- Flag13
+
    function From_At_End
      (N : Node_Id) return Boolean;    -- Flag4
 
@@ -8416,9 +8458,6 @@ package Sinfo is
    function Left_Opnd
      (N : Node_Id) return Node_Id;    -- Node2
 
-   function Last_Aspect
-     (N : Node_Id) return Boolean;    -- Flag5
-
    function Last_Bit
      (N : Node_Id) return Node_Id;    -- Node4
 
@@ -8845,6 +8884,9 @@ package Sinfo is
    procedure Set_Has_Aspect_Specifications
      (N : Node_Id; Val : Boolean := True);    -- Flag3
 
+   procedure Set_Aspect_Cancel
+     (N : Node_Id; Val : Boolean := True);    -- Flag11
+
    procedure Set_Assignment_OK
      (N : Node_Id; Val : Boolean := True);    -- Flag15
 
@@ -9139,9 +9181,6 @@ package Sinfo is
    procedure Set_Expressions
      (N : Node_Id; Val : List_Id);            -- List1
 
-   procedure Set_First_Aspect
-     (N : Node_Id; Val : Boolean := True);    -- Flag4
-
    procedure Set_First_Bit
      (N : Node_Id; Val : Node_Id);            -- Node3
 
@@ -9172,6 +9211,9 @@ package Sinfo is
    procedure Set_From_At_Mod
      (N : Node_Id; Val : Boolean := True);    -- Flag4
 
+   procedure Set_From_Aspect_Specification
+     (N : Node_Id; Val : Boolean := True);    -- Flag13
+
    procedure Set_From_At_End
      (N : Node_Id; Val : Boolean := True);    -- Flag4
 
@@ -9349,9 +9391,6 @@ package Sinfo is
    procedure Set_Kill_Range_Check
      (N : Node_Id; Val : Boolean := True);    -- Flag11
 
-   procedure Set_Last_Aspect
-     (N : Node_Id; Val : Boolean := True);    -- Flag5
-
    procedure Set_Last_Bit
      (N : Node_Id; Val : Node_Id);            -- Node4
 
@@ -11417,45 +11456,6 @@ package Sinfo is
         4 => False,   --  unused
         5 => False)); --  unused
 
-   ---------------------------------------
-   -- Handling of Aspect Specifications --
-   ---------------------------------------
-
-   --  Several kinds of declaration node permit aspect specifications in Ada
-   --  2012 mode. If there was room in all these declaration nodes, we could
-   --  just have a field Aspect_Specifications pointing to a list of nodes
-   --  for the aspects (N_Aspect_Specification nodes). But there isn't room,
-   --  so we adopt a different approach.
-
-   --  The following subprograms provide access to a specialized interface
-   --  implemented internally with a hash table in the body, that provides
-   --  access to aspect specifications.
-
-   function Permits_Aspect_Specifications (N : Node_Id) return Boolean;
-   --  Returns True if the node N is a declaration node that permits aspect
-   --  specifications. All such nodes have the Has_Aspect_Specifications
-   --  flag defined. Returns False for all other nodes.
-
-   function Aspect_Specifications (N : Node_Id) return List_Id;
-   --  Given a node N, returns the list of N_Aspect_Specification nodes that
-   --  are attached to this declaration node. If the node is in the class of
-   --  declaration nodes that permit aspect specifications, as defined by the
-   --  predicate above, and if their Has_Aspect_Specifications flag is set to
-   --  True, then this will always be a non-empty list. If this flag is set to
-   --  False, or the node is not in the declaration class permitting aspect
-   --  specifications, then No_List is returned.
-
-   procedure Set_Aspect_Specifications (N : Node_Id; L : List_Id);
-   --  The node N must be in the class of declaration nodes that permit aspect
-   --  specifications and the Has_Aspect_Specifications flag must be False on
-   --  entry. L must be a non-empty list of N_Aspect_Specification nodes. This
-   --  procedure sets the Has_Aspect_Specifications flag to True, and makes an
-   --  entry that can be retrieved by a subsequent Aspect_Specifications call.
-   --  The parent of list L is set to reference the declaration node N. It is
-   --  an error to call this procedure with a node that does not permit aspect
-   --  specifications, or a node that has its Has_Aspect_Specifications flag
-   --  set True on entry, or with L being an empty list or No_List.
-
    --------------------
    -- Inline Pragmas --
    --------------------
@@ -11481,6 +11481,7 @@ package Sinfo is
    pragma Inline (Alternatives);
    pragma Inline (Ancestor_Part);
    pragma Inline (Array_Aggregate);
+   pragma Inline (Aspect_Cancel);
    pragma Inline (Assignment_OK);
    pragma Inline (Associated_Node);
    pragma Inline (At_End_Proc);
@@ -11580,7 +11581,6 @@ package Sinfo is
    pragma Inline (Explicit_Generic_Actual_Parameter);
    pragma Inline (Expression);
    pragma Inline (Expressions);
-   pragma Inline (First_Aspect);
    pragma Inline (First_Bit);
    pragma Inline (First_Inlined_Subprogram);
    pragma Inline (First_Name);
@@ -11590,6 +11590,7 @@ package Sinfo is
    pragma Inline (Float_Truncate);
    pragma Inline (Formal_Type_Definition);
    pragma Inline (Forwards_OK);
+   pragma Inline (From_Aspect_Specification);
    pragma Inline (From_At_End);
    pragma Inline (From_At_Mod);
    pragma Inline (From_Default);
@@ -11651,7 +11652,6 @@ package Sinfo is
    pragma Inline (Iteration_Scheme);
    pragma Inline (Itype);
    pragma Inline (Kill_Range_Check);
-   pragma Inline (Last_Aspect);
    pragma Inline (Last_Bit);
    pragma Inline (Last_Name);
    pragma Inline (Library_Unit);
@@ -11792,6 +11792,7 @@ package Sinfo is
    pragma Inline (Set_Alternatives);
    pragma Inline (Set_Ancestor_Part);
    pragma Inline (Set_Array_Aggregate);
+   pragma Inline (Set_Aspect_Cancel);
    pragma Inline (Set_Assignment_OK);
    pragma Inline (Set_Associated_Node);
    pragma Inline (Set_At_End_Proc);
@@ -11890,7 +11891,6 @@ package Sinfo is
    pragma Inline (Set_Explicit_Generic_Actual_Parameter);
    pragma Inline (Set_Expression);
    pragma Inline (Set_Expressions);
-   pragma Inline (Set_First_Aspect);
    pragma Inline (Set_First_Bit);
    pragma Inline (Set_First_Inlined_Subprogram);
    pragma Inline (Set_First_Name);
@@ -11900,6 +11900,7 @@ package Sinfo is
    pragma Inline (Set_Float_Truncate);
    pragma Inline (Set_Formal_Type_Definition);
    pragma Inline (Set_Forwards_OK);
+   pragma Inline (Set_From_Aspect_Specification);
    pragma Inline (Set_From_At_End);
    pragma Inline (Set_From_At_Mod);
    pragma Inline (Set_From_Default);
@@ -11961,7 +11962,6 @@ package Sinfo is
    pragma Inline (Set_Iteration_Scheme);
    pragma Inline (Set_Itype);
    pragma Inline (Set_Kill_Range_Check);
-   pragma Inline (Set_Last_Aspect);
    pragma Inline (Set_Last_Bit);
    pragma Inline (Set_Last_Name);
    pragma Inline (Set_Library_Unit);
Index: sem_ch7.adb
===================================================================
--- sem_ch7.adb	(revision 165256)
+++ sem_ch7.adb	(working copy)
@@ -28,6 +28,7 @@
 --  handling of private and full declarations, and the construction of dispatch
 --  tables for tagged types.
 
+with Aspects;  use Aspects;
 with Atree;    use Atree;
 with Debug;    use Debug;
 with Einfo;    use Einfo;
@@ -51,6 +52,7 @@ with Sem_Ch6;  use Sem_Ch6;
 with Sem_Ch8;  use Sem_Ch8;
 with Sem_Ch10; use Sem_Ch10;
 with Sem_Ch12; use Sem_Ch12;
+with Sem_Ch13; use Sem_Ch13;
 with Sem_Disp; use Sem_Disp;
 with Sem_Eval; use Sem_Eval;
 with Sem_Prag; use Sem_Prag;
@@ -749,6 +751,7 @@ package body Sem_Ch7 is
 
    procedure Analyze_Package_Declaration (N : Node_Id) is
       Id : constant Node_Id := Defining_Entity (N);
+      AS : constant List_Id := Aspect_Specifications (N);
 
       PF : Boolean;
       --  True when in the context of a declared pure library unit
@@ -768,7 +771,7 @@ package body Sem_Ch7 is
       --     package Pkg is ...
 
       if From_With_Type (Id) then
-         return;
+         goto Leave;
       end if;
 
       if Debug_Flag_C then
@@ -842,6 +845,8 @@ package body Sem_Ch7 is
          Write_Location (Sloc (N));
          Write_Eol;
       end if;
+
+      <<Leave>> Analyze_Aspect_Specifications (N, Id, AS);
    end Analyze_Package_Declaration;
 
    -----------------------------------
@@ -1412,6 +1417,7 @@ package body Sem_Ch7 is
    procedure Analyze_Private_Type_Declaration (N : Node_Id) is
       PF : constant Boolean   := Is_Pure (Enclosing_Lib_Unit_Entity);
       Id : constant Entity_Id := Defining_Identifier (N);
+      AS : constant List_Id   := Aspect_Specifications (N);
 
    begin
       Generate_Definition (Id);
@@ -1426,6 +1432,7 @@ package body Sem_Ch7 is
 
       New_Private_Type (N, Id, N);
       Set_Depends_On_Private (Id);
+      Analyze_Aspect_Specifications (N, Id, AS);
    end Analyze_Private_Type_Declaration;
 
    ----------------------------------
Index: par-ch13.adb
===================================================================
--- par-ch13.adb	(revision 165256)
+++ par-ch13.adb	(working copy)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2010, 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- --
@@ -35,6 +35,91 @@ package body Ch13 is
    function P_Component_Clause return Node_Id;
    function P_Mod_Clause return Node_Id;
 
+   -----------------------------------
+   -- Aspect_Specifications_Present --
+   -----------------------------------
+
+   function Aspect_Specifications_Present return Boolean is
+      Scan_State : Saved_Scan_State;
+      Result     : Boolean;
+
+   begin
+      Save_Scan_State (Scan_State);
+
+      --  If we have a semicolon, test for semicolon followed by Aspect
+      --  Specifications, in which case we decide the semicolon is accidental.
+
+      if Token = Tok_Semicolon then
+         Scan; -- past semicolon
+
+         if Aspect_Specifications_Present then
+            Error_Msg_SP ("|extra "";"" ignored");
+            return True;
+
+         else
+            Restore_Scan_State (Scan_State);
+            return False;
+         end if;
+      end if;
+
+      --  Definitely must have WITH to consider aspect specs to be present
+
+      if Token /= Tok_With then
+         return False;
+      end if;
+
+      --  Have a WITH, see if it looks like an aspect specification
+
+      Save_Scan_State (Scan_State);
+      Scan; -- past WITH
+
+      --  If no identifier, then consider that we definitely do not have an
+      --  aspect specification.
+
+      if Token /= Tok_Identifier then
+         Result := False;
+
+      --  In Ada 2012 mode, we are less strict, and we consider that we have
+      --  an aspect specification if the identifier is an aspect name (even if
+      --  not followed by =>) or the identifier is not an aspect name but is
+      --  followed by =>. P_Aspect_Specifications will generate messages if the
+      --  aspect specification is ill-formed.
+
+      elsif Ada_Version >= Ada_2012 then
+         if Get_Aspect_Id (Token_Name) /= No_Aspect then
+            Result := True;
+         else
+            Scan; -- past identifier
+            Result := Token = Tok_Arrow;
+         end if;
+
+      --  If earlier than Ada 2012, check for valid aspect identifier followed
+      --  by an arrow, and consider that this is still an aspect specification
+      --  so we give an appropriate message.
+
+      else
+         if Get_Aspect_Id (Token_Name) = No_Aspect then
+            Result := False;
+
+         else
+            Scan; -- past aspect name
+
+            if Token /= Tok_Arrow then
+               Result := False;
+
+            else
+               Restore_Scan_State (Scan_State);
+               Error_Msg_SC ("|aspect specification is an Ada 2012 feature");
+               Error_Msg_SC ("\|unit must be compiled with -gnat2012 switch");
+               return True;
+            end if;
+         end if;
+      end if;
+
+      Restore_Scan_State (Scan_State);
+      return Result;
+   end Aspect_Specifications_Present;
+
    --------------------------------------------
    -- 13.1  Representation Clause (also I.7) --
    --------------------------------------------
@@ -274,6 +359,163 @@ package body Ch13 is
 
    --  Parsed by P_Representation_Clause (13.1)
 
+   ------------------------------
+   -- 13.1  Aspect Specifation --
+   ------------------------------
+
+   --  ASPECT_SPECIFICATION ::=
+   --    with ASPECT_MARK [=> ASPECT_DEFINITION] {.
+   --         ASPECT_MARK [=> ASPECT_DEFINITION] }
+
+   --  ASPECT_MARK ::= aspect_IDENTIFIER['Class]
+
+   --  ASPECT_DEFINITION ::= NAME | EXPRESSION
+
+   --  Error recovery: cannot raise Error_Resync
+
+   procedure P_Aspect_Specifications (Decl : Node_Id) is
+      Aspects : List_Id;
+      Aspect  : Node_Id;
+      A_Id    : Aspect_Id;
+      OK      : Boolean;
+
+   begin
+      --  Check if aspect specification present
+
+      if not Aspect_Specifications_Present then
+         T_Semicolon;
+         return;
+      end if;
+
+      --  Aspect Specification is present
+
+      Scan; -- past WITH
+
+      --  Here we have an aspect specification to scan, note that we don;t
+      --  set the flag till later, because it may turn out that we have no
+      --  valid aspects in the list.
+
+      Aspects := Empty_List;
+      loop
+         OK := True;
+
+         if Token /= Tok_Identifier then
+            Error_Msg_SC ("aspect identifier expected");
+            Resync_Past_Semicolon;
+            return;
+         end if;
+
+         --  We have an identifier (which should be an aspect identifier)
+
+         Aspect := Token_Node;
+         A_Id := Get_Aspect_Id (Token_Name);
+         Aspect :=
+           Make_Aspect_Specification (Sloc (Aspect),
+             Identifier => Token_Node);
+
+         --  No valid aspect identifier present
+
+         if A_Id = No_Aspect then
+            Error_Msg_SC ("aspect identifier expected");
+
+            if Token = Tok_Apostrophe then
+               Scan; -- past '
+               Scan; -- past presumably CLASS
+            end if;
+
+            if Token = Tok_Arrow then
+               Scan; -- Past arrow
+               Set_Expression (Aspect, P_Expression);
+               OK := False;
+
+            elsif Token = Tok_Comma then
+               OK := False;
+
+            else
+               Resync_Past_Semicolon;
+               return;
+            end if;
+
+         --  OK aspect scanned
+
+         else
+            Scan; -- past identifier
+
+            --  Check for 'Class present
+
+            if Token = Tok_Apostrophe then
+               if not Class_Aspect_OK (A_Id) then
+                  Error_Msg_Node_1 := Identifier (Aspect);
+                  Error_Msg_SC ("aspect& does not permit attribute here");
+                  Scan; -- past apostophe
+                  Scan; -- past presumed CLASS
+                  OK := False;
+
+               else
+                  Scan; -- past apostrophe
+
+                  if Token /= Tok_Identifier
+                    or else Token_Name /= Name_Class
+                  then
+                     Error_Msg_SC ("Class attribute expected here");
+                     OK := False;
+
+                     if Token = Tok_Identifier then
+                        Scan; -- past identifier not CLASS
+                     end if;
+                  end if;
+               end if;
+            end if;
+
+            --  Test case of missing aspect definition
+
+            if Token = Tok_Comma or else Token = Tok_Semicolon then
+               if Aspect_Argument (A_Id) /= Optional then
+                  Error_Msg_Node_1 := Aspect;
+                  Error_Msg_AP ("aspect& requires an aspect definition");
+                  OK := False;
+               end if;
+
+            --  Here we have an aspect definition
+
+            else
+               if Token = Tok_Arrow then
+                  Scan; -- past arrow
+               else
+                  T_Arrow;
+                  OK := False;
+               end if;
+
+               if Aspect_Argument (A_Id) = Name then
+                  Set_Expression (Aspect, P_Name);
+               else
+                  Set_Expression (Aspect, P_Expression);
+               end if;
+            end if;
+
+            --  If OK clause scanned, add it to the list
+
+            if OK then
+               Append (Aspect, Aspects);
+            end if;
+
+            if Token = Tok_Comma then
+               Scan; -- past comma
+            else
+               T_Semicolon;
+               exit;
+            end if;
+         end if;
+      end loop;
+
+      --  If aspects scanned, store them
+
+      if Is_Non_Empty_List (Aspects) then
+         Set_Parent (Aspects, Decl);
+         Set_Aspect_Specifications (Decl, Aspects);
+      end if;
+   end P_Aspect_Specifications;
+
    ---------------------------------------------
    -- 13.4  Enumeration Representation Clause --
    ---------------------------------------------
Index: sem_ch9.adb
===================================================================
--- sem_ch9.adb	(revision 165283)
+++ sem_ch9.adb	(working copy)
@@ -23,6 +23,7 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
+with Aspects;  use Aspects;
 with Atree;    use Atree;
 with Checks;   use Checks;
 with Einfo;    use Einfo;
@@ -44,6 +45,7 @@ with Sem_Ch3;  use Sem_Ch3;
 with Sem_Ch5;  use Sem_Ch5;
 with Sem_Ch6;  use Sem_Ch6;
 with Sem_Ch8;  use Sem_Ch8;
+with Sem_Ch13; use Sem_Ch13;
 with Sem_Eval; use Sem_Eval;
 with Sem_Res;  use Sem_Res;
 with Sem_Type; use Sem_Type;
@@ -873,6 +875,7 @@ package body Sem_Ch9 is
       D_Sdef  : constant Node_Id   := Discrete_Subtype_Definition (N);
       Def_Id  : constant Entity_Id := Defining_Identifier (N);
       Formals : constant List_Id   := Parameter_Specifications (N);
+      AS      : constant List_Id   := Aspect_Specifications (N);
 
    begin
       Generate_Definition (Def_Id);
@@ -904,6 +907,7 @@ package body Sem_Ch9 is
       end if;
 
       Generate_Reference_To_Formals (Def_Id);
+      Analyze_Aspect_Specifications (N, Def_Id, AS);
    end Analyze_Entry_Declaration;
 
    ---------------------------------------
@@ -1122,19 +1126,20 @@ package body Sem_Ch9 is
       Process_End_Label (N, 'e', Current_Scope);
    end Analyze_Protected_Definition;
 
-   ----------------------------
-   -- Analyze_Protected_Type --
-   ----------------------------
+   ----------------------------------------
+   -- Analyze_Protected_Type_Declaration --
+   ----------------------------------------
 
-   procedure Analyze_Protected_Type (N : Node_Id) is
+   procedure Analyze_Protected_Type_Declaration (N : Node_Id) is
       Def_Id : constant Entity_Id := Defining_Identifier (N);
+      AS     : constant List_Id   := Aspect_Specifications (N);
       E      : Entity_Id;
       T      : Entity_Id;
 
    begin
       if No_Run_Time_Mode then
          Error_Msg_CRT ("protected type", N);
-         return;
+         goto Leave;
       end if;
 
       Tasking_Used := True;
@@ -1254,7 +1259,9 @@ package body Sem_Ch9 is
             Process_Full_View (N, T, Def_Id);
          end if;
       end if;
-   end Analyze_Protected_Type;
+
+      <<Leave>> Analyze_Aspect_Specifications (N, Def_Id, AS);
+   end Analyze_Protected_Type_Declaration;
 
    ---------------------
    -- Analyze_Requeue --
@@ -1651,13 +1658,14 @@ package body Sem_Ch9 is
       end if;
    end Analyze_Selective_Accept;
 
-   ------------------------------
-   -- Analyze_Single_Protected --
-   ------------------------------
+   ------------------------------------------
+   -- Analyze_Single_Protected_Declaration --
+   ------------------------------------------
 
-   procedure Analyze_Single_Protected (N : Node_Id) is
+   procedure Analyze_Single_Protected_Declaration (N : Node_Id) is
       Loc    : constant Source_Ptr := Sloc (N);
       Id     : constant Node_Id    := Defining_Identifier (N);
+      AS     : constant List_Id    := Aspect_Specifications (N);
       T      : Entity_Id;
       T_Decl : Node_Id;
       O_Decl : Node_Id;
@@ -1704,16 +1712,18 @@ package body Sem_Ch9 is
       --  procedure directly. Otherwise the node would be expanded twice, with
       --  disastrous result.
 
-      Analyze_Protected_Type (N);
-   end Analyze_Single_Protected;
-
-   -------------------------
-   -- Analyze_Single_Task --
-   -------------------------
+      Analyze_Protected_Type_Declaration (N);
+      Analyze_Aspect_Specifications (N, Id, AS);
+   end Analyze_Single_Protected_Declaration;
+
+   -------------------------------------
+   -- Analyze_Single_Task_Declaration --
+   -------------------------------------
 
-   procedure Analyze_Single_Task (N : Node_Id) is
+   procedure Analyze_Single_Task_Declaration (N : Node_Id) is
       Loc    : constant Source_Ptr := Sloc (N);
       Id     : constant Node_Id    := Defining_Identifier (N);
+      AS     : constant List_Id    := Aspect_Specifications (N);
       T      : Entity_Id;
       T_Decl : Node_Id;
       O_Decl : Node_Id;
@@ -1768,8 +1778,9 @@ package body Sem_Ch9 is
       --  procedure directly. Otherwise the node would be expanded twice, with
       --  disastrous result.
 
-      Analyze_Task_Type (N);
-   end Analyze_Single_Task;
+      Analyze_Task_Type_Declaration (N);
+      Analyze_Aspect_Specifications (N, Id, AS);
+   end Analyze_Single_Task_Declaration;
 
    -----------------------
    -- Analyze_Task_Body --
@@ -1935,12 +1946,13 @@ package body Sem_Ch9 is
       Process_End_Label (N, 'e', Current_Scope);
    end Analyze_Task_Definition;
 
-   -----------------------
-   -- Analyze_Task_Type --
-   -----------------------
+   -----------------------------------
+   -- Analyze_Task_Type_Declaration --
+   -----------------------------------
 
-   procedure Analyze_Task_Type (N : Node_Id) is
+   procedure Analyze_Task_Type_Declaration (N : Node_Id) is
       Def_Id : constant Entity_Id := Defining_Identifier (N);
+      AS     : constant List_Id   := Aspect_Specifications (N);
       T      : Entity_Id;
 
    begin
@@ -2038,7 +2050,9 @@ package body Sem_Ch9 is
             Process_Full_View (N, T, Def_Id);
          end if;
       end if;
-   end Analyze_Task_Type;
+
+      Analyze_Aspect_Specifications (N, Def_Id, AS);
+   end Analyze_Task_Type_Declaration;
 
    -----------------------------------
    -- Analyze_Terminate_Alternative --
Index: sem_ch9.ads
===================================================================
--- sem_ch9.ads	(revision 165256)
+++ sem_ch9.ads	(working copy)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2010, 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- --
@@ -41,14 +41,14 @@ package Sem_Ch9  is
    procedure Analyze_Entry_Index_Specification          (N : Node_Id);
    procedure Analyze_Protected_Body                     (N : Node_Id);
    procedure Analyze_Protected_Definition               (N : Node_Id);
-   procedure Analyze_Protected_Type                     (N : Node_Id);
+   procedure Analyze_Protected_Type_Declaration         (N : Node_Id);
    procedure Analyze_Requeue                            (N : Node_Id);
    procedure Analyze_Selective_Accept                   (N : Node_Id);
-   procedure Analyze_Single_Protected                   (N : Node_Id);
-   procedure Analyze_Single_Task                        (N : Node_Id);
+   procedure Analyze_Single_Protected_Declaration       (N : Node_Id);
+   procedure Analyze_Single_Task_Declaration            (N : Node_Id);
    procedure Analyze_Task_Body                          (N : Node_Id);
    procedure Analyze_Task_Definition                    (N : Node_Id);
-   procedure Analyze_Task_Type                          (N : Node_Id);
+   procedure Analyze_Task_Type_Declaration              (N : Node_Id);
    procedure Analyze_Terminate_Alternative              (N : Node_Id);
    procedure Analyze_Timed_Entry_Call                   (N : Node_Id);
    procedure Analyze_Triggering_Alternative             (N : Node_Id);
Index: sem_prag.adb
===================================================================
--- sem_prag.adb	(revision 165296)
+++ sem_prag.adb	(working copy)
@@ -287,6 +287,13 @@ package body Sem_Prag is
       Pname   : constant Name_Id    := Pragma_Name (N);
       Prag_Id : Pragma_Id;
 
+      Sense : constant Boolean := not Aspect_Cancel (N);
+      --  Sense is True if we have the normal case of a pragma that is active
+      --  and turns the corresponding aspect on. It is false only for the case
+      --  of a pragma coming from an aspect which is explicitly turned off by
+      --  using aspect => False. If Sense is False, the effect of the pragma
+      --  is to turn the corresponding aspect off.
+
       Pragma_Exit : exception;
       --  This exception is used to exit pragma processing completely. It is
       --  used when an error is detected, and no further processing is
@@ -410,7 +417,7 @@ package body Sem_Prag is
       procedure Check_Duplicate_Pragma (E : Entity_Id);
       --  Check if a pragma 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, using Error_Pragma so the call does not return.
+      --  about the duplicate, and then raise Pragma_Exit so does not return.
 
       procedure Check_Duplicated_Export_Name (Nam : Node_Id);
       --  Nam is an N_String_Literal node containing the external name set by
@@ -562,6 +569,14 @@ package body Sem_Prag is
       --  procedure identified by Name, returns it if it exists, otherwise
       --  errors out and uses Arg as the pragma argument for the message.
 
+      procedure Fix_Error (Msg : in out String);
+      --  This is called prior to issuing an error message. Msg is a string
+      --  which typically contains the substring pragma. If the current pragma
+      --  comes from an aspect, each such "pragma" substring is replaced with
+      --  the characters "aspect", and in addition, if Error_Msg_Name_1 is
+      --  Name_Precondition (resp Name_Postcondition) it is replaced with
+      --  Name_Pre (resp Name_Post).
+
       procedure Gather_Associations
         (Names : Name_List;
          Args  : out Args_List);
@@ -817,10 +832,16 @@ package body Sem_Prag is
 
             else
                Error_Msg_Name_1 := Pname;
-               Flag_Non_Static_Expr
-                 ("argument for pragma% must be a identifier or " &
-                  "static string expression!", Argx);
-               raise Pragma_Exit;
+
+               declare
+                  Msg : String :=
+                          "argument for pragma% must be a identifier or "
+                          & "static string expression!";
+               begin
+                  Fix_Error (Msg);
+                  Flag_Non_Static_Expr (Msg, Argx);
+                  raise Pragma_Exit;
+               end;
             end if;
          end if;
       end Check_Arg_Is_External_Name;
@@ -864,7 +885,7 @@ package body Sem_Prag is
       begin
          Check_Arg_Is_Local_Name (Arg);
 
-         if not Is_Library_Level_Entity (Entity (Expression (Arg)))
+         if not Is_Library_Level_Entity (Entity (Get_Pragma_Arg (Arg)))
            and then Comes_From_Source (N)
          then
             Error_Pragma_Arg
@@ -1033,8 +1054,15 @@ package body Sem_Prag is
 
          else
             Error_Msg_Name_1 := Pname;
-            Flag_Non_Static_Expr
-              ("argument for pragma% must be a static expression!", Argx);
+
+            declare
+               Msg : String :=
+                       "argument for pragma% must be a static expression!";
+            begin
+               Fix_Error (Msg);
+               Flag_Non_Static_Expr (Msg, Argx);
+            end;
+
             raise Pragma_Exit;
          end if;
       end Check_Arg_Is_Static_Expression;
@@ -1208,6 +1236,17 @@ package body Sem_Prag is
          Arg : Node_Id;
 
       begin
+         --  Nothing to do if this pragma comes from an aspect specification,
+         --  since we could not be duplicating a pragma, and we dealt with the
+         --  case of duplicated aspects in Analyze_Aspect_Specifications.
+
+         if From_Aspect_Specification (N) then
+            return;
+         end if;
+
+         --  Otherwise current pragma may duplicate previous pragma or a
+         --  previously given aspect specification for the same pragma.
+
          if Present (P) then
 
             --  Make sure pragma is for this entity, and not for some parent
@@ -1220,7 +1259,13 @@ package body Sem_Prag is
             then
                Error_Msg_Name_1 := Pname;
                Error_Msg_Sloc := Sloc (P);
-               Error_Msg_NE ("pragma% for & duplicates one#", N, E);
+
+               if From_Aspect_Specification (P) then
+                  Error_Msg_NE ("aspect% for & previously specified#", N, E);
+               else
+                  Error_Msg_NE ("pragma% for & duplicates pragma#", N, E);
+               end if;
+
                raise Pragma_Exit;
             end if;
          end if;
@@ -1301,7 +1346,7 @@ package body Sem_Prag is
       ---------------------------------------
 
       procedure Check_Interrupt_Or_Attach_Handler is
-         Arg1_X : constant Node_Id := Expression (Arg1);
+         Arg1_X : constant Node_Id := Get_Pragma_Arg (Arg1);
          Handler_Proc, Proc_Scope : Entity_Id;
 
       begin
@@ -1402,7 +1447,9 @@ package body Sem_Prag is
 
       procedure Check_No_Identifier (Arg : Node_Id) is
       begin
-         if Chars (Arg) /= No_Name then
+         if Nkind (Arg) = N_Pragma_Argument_Association
+           and then Chars (Arg) /= No_Name
+         then
             Error_Pragma_Arg_Ident
               ("pragma% does not permit identifier& here", Arg);
          end if;
@@ -1706,7 +1753,7 @@ package body Sem_Prag is
                   Unit_Node := Unit (Parent (Parent_Node));
                   Unit_Kind := Nkind (Unit_Node);
 
-                  Analyze (Expression (Arg1));
+                  Analyze (Get_Pragma_Arg (Arg1));
 
                   if Unit_Kind = N_Generic_Subprogram_Declaration
                     or else Unit_Kind = N_Subprogram_Declaration
@@ -1721,7 +1768,7 @@ package body Sem_Prag is
                   end if;
 
                   if Chars (Unit_Name) /=
-                     Chars (Entity (Expression (Arg1)))
+                     Chars (Entity (Get_Pragma_Arg (Arg1)))
                   then
                      Error_Pragma_Arg
                        ("pragma% argument is not current unit name", Arg1);
@@ -1779,9 +1826,9 @@ package body Sem_Prag is
                      Pragma_Misplaced;
 
                   elsif Arg_Count > 0 then
-                     Analyze (Expression (Arg1));
+                     Analyze (Get_Pragma_Arg (Arg1));
 
-                     if Entity (Expression (Arg1)) /= Current_Scope then
+                     if Entity (Get_Pragma_Arg (Arg1)) /= Current_Scope then
                         Error_Pragma_Arg
                           ("name in pragma% must be enclosing unit", Arg1);
                      end if;
@@ -1834,9 +1881,11 @@ package body Sem_Prag is
       ------------------
 
       procedure Error_Pragma (Msg : String) is
+         MsgF : String := Msg;
       begin
          Error_Msg_Name_1 := Pname;
-         Error_Msg_N (Msg, N);
+         Fix_Error (MsgF);
+         Error_Msg_N (MsgF, N);
          raise Pragma_Exit;
       end Error_Pragma;
 
@@ -1845,16 +1894,20 @@ package body Sem_Prag is
       ----------------------
 
       procedure Error_Pragma_Arg (Msg : String; Arg : Node_Id) is
+         MsgF : String := Msg;
       begin
          Error_Msg_Name_1 := Pname;
-         Error_Msg_N (Msg, Get_Pragma_Arg (Arg));
+         Fix_Error (MsgF);
+         Error_Msg_N (MsgF, Get_Pragma_Arg (Arg));
          raise Pragma_Exit;
       end Error_Pragma_Arg;
 
       procedure Error_Pragma_Arg (Msg1, Msg2 : String; Arg : Node_Id) is
+         MsgF : String := Msg1;
       begin
          Error_Msg_Name_1 := Pname;
-         Error_Msg_N (Msg1, Get_Pragma_Arg (Arg));
+         Fix_Error (MsgF);
+         Error_Msg_N (MsgF, Get_Pragma_Arg (Arg));
          Error_Pragma_Arg (Msg2, Arg);
       end Error_Pragma_Arg;
 
@@ -1863,9 +1916,11 @@ package body Sem_Prag is
       ----------------------------
 
       procedure Error_Pragma_Arg_Ident (Msg : String; Arg : Node_Id) is
+         MsgF : String := Msg;
       begin
          Error_Msg_Name_1 := Pname;
-         Error_Msg_N (Msg, Arg);
+         Fix_Error (MsgF);
+         Error_Msg_N (MsgF, Arg);
          raise Pragma_Exit;
       end Error_Pragma_Arg_Ident;
 
@@ -1874,10 +1929,12 @@ package body Sem_Prag is
       ----------------------
 
       procedure Error_Pragma_Ref (Msg : String; Ref : Entity_Id) is
+         MsgF : String := Msg;
       begin
          Error_Msg_Name_1 := Pname;
+         Fix_Error (MsgF);
          Error_Msg_Sloc   := Sloc (Ref);
-         Error_Msg_NE (Msg, N, Ref);
+         Error_Msg_NE (MsgF, N, Ref);
          raise Pragma_Exit;
       end Error_Pragma_Ref;
 
@@ -2004,6 +2061,27 @@ package body Sem_Prag is
          return Proc;
       end Find_Unique_Parameterless_Procedure;
 
+      ---------------
+      -- Fix_Error --
+      ---------------
+
+      procedure Fix_Error (Msg : in out String) is
+      begin
+         if From_Aspect_Specification (N) then
+            for J in Msg'First .. Msg'Last - 5 loop
+               if Msg (J .. J + 5) = "pragma" then
+                  Msg (J .. J + 5) := "aspect";
+               end if;
+            end loop;
+         end if;
+
+         if Error_Msg_Name_1 = Name_Precondition then
+            Error_Msg_Name_1 := Name_Pre;
+         elsif Error_Msg_Name_1 = Name_Postcondition then
+            Error_Msg_Name_1 := Name_Post;
+         end if;
+      end Fix_Error;
+
       -------------------------
       -- Gather_Associations --
       -------------------------
@@ -2032,7 +2110,7 @@ package body Sem_Prag is
          Arg := First (Pragma_Argument_Associations (N));
          for Index in Args'Range loop
             exit when No (Arg) or else Chars (Arg) /= No_Name;
-            Args (Index) := Expression (Arg);
+            Args (Index) := Get_Pragma_Arg (Arg);
             Next (Arg);
          end loop;
 
@@ -2059,7 +2137,7 @@ package body Sem_Prag is
                         Error_Pragma_Arg
                           ("duplicate argument association for pragma%", Arg);
                      else
-                        Args (Index) := Expression (Arg);
+                        Args (Index) := Get_Pragma_Arg (Arg);
                         exit;
                      end if;
                   end if;
@@ -2240,9 +2318,9 @@ package body Sem_Prag is
 
          procedure Set_Atomic (E : Entity_Id) is
          begin
-            Set_Is_Atomic (E);
+            Set_Is_Atomic (E, Sense);
 
-            if not Has_Alignment_Clause (E) then
+            if Sense and then not Has_Alignment_Clause (E) then
                Set_Alignment (E, Uint_0);
             end if;
          end Set_Atomic;
@@ -2254,7 +2332,7 @@ package body Sem_Prag is
          Check_No_Identifiers;
          Check_Arg_Count (1);
          Check_Arg_Is_Local_Name (Arg1);
-         E_Id := Expression (Arg1);
+         E_Id := Get_Pragma_Arg (Arg1);
 
          if Etype (E_Id) = Any_Type then
             return;
@@ -2289,11 +2367,11 @@ package body Sem_Prag is
             --  Attribute belongs on the base type. If the view of the type is
             --  currently private, it also belongs on the underlying type.
 
-            Set_Is_Volatile (Base_Type (E));
-            Set_Is_Volatile (Underlying_Type (E));
+            Set_Is_Volatile (Base_Type (E), Sense);
+            Set_Is_Volatile (Underlying_Type (E), Sense);
 
-            Set_Treat_As_Volatile (E);
-            Set_Treat_As_Volatile (Underlying_Type (E));
+            Set_Treat_As_Volatile (E, Sense);
+            Set_Treat_As_Volatile (Underlying_Type (E), Sense);
 
          elsif K = N_Object_Declaration
            or else (K = N_Component_Declaration
@@ -2304,7 +2382,7 @@ package body Sem_Prag is
             end if;
 
             if Prag_Id /= Pragma_Volatile then
-               Set_Is_Atomic (E);
+               Set_Is_Atomic (E, Sense);
 
                --  If the object declaration has an explicit initialization, a
                --  temporary may have to be created to hold the expression, to
@@ -2312,6 +2390,7 @@ package body Sem_Prag is
 
                if Nkind (Parent (E)) = N_Object_Declaration
                  and then Present (Expression (Parent (E)))
+                 and then Sense
                then
                   Set_Has_Delayed_Freeze (E);
                end if;
@@ -2332,7 +2411,7 @@ package body Sem_Prag is
                    Get_Source_File_Index (Sloc (E)) =
                    Get_Source_File_Index (Sloc (Underlying_Type (Etype (E))))
                then
-                  Set_Is_Atomic (Underlying_Type (Etype (E)));
+                  Set_Is_Atomic (Underlying_Type (Etype (E)), Sense);
                end if;
             end if;
 
@@ -2715,7 +2794,7 @@ package body Sem_Prag is
          Check_At_Least_N_Arguments (2);
          Check_Optional_Identifier (Arg1, Name_Convention);
          Check_Arg_Is_Identifier (Arg1);
-         Cname := Chars (Expression (Arg1));
+         Cname := Chars (Get_Pragma_Arg (Arg1));
 
          --  C_Pass_By_Copy is treated as a synonym for convention C (this is
          --  tested again below to set the critical flag).
@@ -2725,7 +2804,7 @@ package body Sem_Prag is
          --  Otherwise we must have something in the standard convention list
 
          elsif Is_Convention_Name (Cname) then
-            C := Get_Convention_Id (Chars (Expression (Arg1)));
+            C := Get_Convention_Id (Chars (Get_Pragma_Arg (Arg1)));
 
          --  In DEC VMS, it seems that there is an undocumented feature that
          --  any unrecognized convention is treated as the default, which for
@@ -2737,7 +2816,7 @@ package body Sem_Prag is
             if Warn_On_Export_Import and not OpenVMS_On_Target then
                Error_Msg_N
                  ("?unrecognized convention name, C assumed",
-                  Expression (Arg1));
+                  Get_Pragma_Arg (Arg1));
             end if;
 
             C := Convention_C;
@@ -2746,7 +2825,7 @@ package body Sem_Prag is
          Check_Optional_Identifier (Arg2, Name_Entity);
          Check_Arg_Is_Local_Name (Arg2);
 
-         Id := Expression (Arg2);
+         Id := Get_Pragma_Arg (Arg2);
          Analyze (Id);
 
          if not Is_Entity_Name (Id) then
@@ -2923,6 +3002,10 @@ package body Sem_Prag is
                      Generate_Reference (E1, Id, 'b');
                   end if;
                end if;
+
+               --  For aspect case, do NOT apply to homonyms
+
+               exit when From_Aspect_Specification (N);
             end loop;
          end if;
       end Process_Convention;
@@ -3613,7 +3696,7 @@ package body Sem_Prag is
 
          Arg := Arg1;
          while Present (Arg) loop
-            Exp := Expression (Arg);
+            Exp := Get_Pragma_Arg (Arg);
             Analyze (Exp);
 
             if not Is_Entity_Name (Exp)
@@ -3643,7 +3726,7 @@ package body Sem_Prag is
       begin
          Process_Convention (C, Def_Id);
          Kill_Size_Check_Code (Def_Id);
-         Note_Possible_Modification (Expression (Arg2), Sure => False);
+         Note_Possible_Modification (Get_Pragma_Arg (Arg2), Sure => False);
 
          if Ekind_In (Def_Id, E_Variable, E_Constant) then
 
@@ -3770,7 +3853,8 @@ package body Sem_Prag is
                      --  is present, then this is handled by the back end.
 
                      if No (Arg3) then
-                        Check_Intrinsic_Subprogram (Def_Id, Expression (Arg2));
+                        Check_Intrinsic_Subprogram
+                          (Def_Id, Get_Pragma_Arg (Arg2));
                      end if;
                   end if;
 
@@ -4074,6 +4158,11 @@ package body Sem_Prag is
             --  entity (if declared in the same unit) is inlined.
 
             if Is_Subprogram (Subp) then
+
+               if not Sense then
+                  return;
+               end if;
+
                Inner_Subp := Ultimate_Alias (Inner_Subp);
 
                if In_Same_Source_Unit (Subp, Inner_Subp) then
@@ -4134,16 +4223,16 @@ package body Sem_Prag is
          procedure Set_Inline_Flags (Subp : Entity_Id) is
          begin
             if Active then
-               Set_Is_Inlined (Subp, True);
+               Set_Is_Inlined (Subp, Sense);
             end if;
 
             if not Has_Pragma_Inline (Subp) then
-               Set_Has_Pragma_Inline (Subp);
+               Set_Has_Pragma_Inline (Subp, Sense);
                Effective := True;
             end if;
 
             if Prag_Id = Pragma_Inline_Always then
-               Set_Has_Pragma_Inline_Always (Subp);
+               Set_Has_Pragma_Inline_Always (Subp, Sense);
             end if;
          end Set_Inline_Flags;
 
@@ -4159,7 +4248,7 @@ package body Sem_Prag is
 
          Assoc := Arg1;
          while Present (Assoc) loop
-            Subp_Id := Expression (Assoc);
+            Subp_Id := Get_Pragma_Arg (Assoc);
             Analyze (Subp_Id);
             Applies := False;
 
@@ -4176,12 +4265,14 @@ package body Sem_Prag is
                else
                   Make_Inline (Subp);
 
-                  while Present (Homonym (Subp))
-                    and then Scope (Homonym (Subp)) = Current_Scope
-                  loop
-                     Make_Inline (Homonym (Subp));
-                     Subp := Homonym (Subp);
-                  end loop;
+                  if not From_Aspect_Specification (N) then
+                     while Present (Homonym (Subp))
+                       and then Scope (Homonym (Subp)) = Current_Scope
+                     loop
+                        Make_Inline (Homonym (Subp));
+                        Subp := Homonym (Subp);
+                     end loop;
+                  end if;
                end if;
             end if;
 
@@ -4406,7 +4497,7 @@ package body Sem_Prag is
       -----------------------------------------
 
       procedure Process_Interrupt_Or_Attach_Handler is
-         Arg1_X       : constant Node_Id   := Expression (Arg1);
+         Arg1_X       : constant Node_Id   := Get_Pragma_Arg (Arg1);
          Handler_Proc : constant Entity_Id := Entity (Arg1_X);
          Proc_Scope   : constant Entity_Id := Scope (Handler_Proc);
 
@@ -4478,7 +4569,7 @@ package body Sem_Prag is
          Arg := Arg1;
          while Present (Arg) loop
             Id := Chars (Arg);
-            Expr := Expression (Arg);
+            Expr := Get_Pragma_Arg (Arg);
 
             --  Case of no restriction identifier present
 
@@ -4708,7 +4799,7 @@ package body Sem_Prag is
          Check_No_Identifier (Arg1);
          Check_Arg_Is_Identifier (Arg1);
 
-         C := Get_Check_Id (Chars (Expression (Arg1)));
+         C := Get_Check_Id (Chars (Get_Pragma_Arg (Arg1)));
 
          if C = No_Check_Id then
             Error_Pragma_Arg
@@ -4766,7 +4857,7 @@ package body Sem_Prag is
             end if;
 
             Check_Optional_Identifier (Arg2, Name_On);
-            E_Id := Expression (Arg2);
+            E_Id := Get_Pragma_Arg (Arg2);
             Analyze (E_Id);
 
             if not Is_Entity_Name (E_Id) then
@@ -4808,8 +4899,9 @@ package body Sem_Prag is
                   Suppress_Unsuppress_Echeck (Alias (E), C);
                end if;
 
-               --  Move to next homonym
+               --  Move to next homonym if not aspect spec case
 
+               exit when From_Aspect_Specification (N);
                E := Homonym (E);
                exit when No (E);
 
@@ -5480,7 +5572,7 @@ package body Sem_Prag is
 
             if Arg_Count = 1 then
                Check_Arg_Is_Local_Name (Arg1);
-               E_Id := Expression (Arg1);
+               E_Id := Get_Pragma_Arg (Arg1);
 
                if Etype (E_Id) = Any_Type then
                   return;
@@ -5499,9 +5591,14 @@ package body Sem_Prag is
 
                Check_Valid_Configuration_Pragma;
 
-               --  Now set Ada 2005 mode
+               --  Now set appropriate Ada mode
+
+               if Sense then
+                  Ada_Version := Ada_2005;
+               else
+                  Ada_Version := Ada_Version_Default;
+               end if;
 
-               Ada_Version := Ada_2005;
                Ada_Version_Explicit := Ada_2005;
             end if;
          end;
@@ -5527,7 +5624,7 @@ package body Sem_Prag is
 
             if Arg_Count = 1 then
                Check_Arg_Is_Local_Name (Arg1);
-               E_Id := Expression (Arg1);
+               E_Id := Get_Pragma_Arg (Arg1);
 
                if Etype (E_Id) = Any_Type then
                   return;
@@ -5547,9 +5644,14 @@ package body Sem_Prag is
 
                Check_Valid_Configuration_Pragma;
 
-               --  Now set Ada 2012 mode
+               --  Now set appropriate Ada mode
+
+               if Sense then
+                  Ada_Version := Ada_2012;
+               else
+                  Ada_Version := Ada_Version_Default;
+               end if;
 
-               Ada_Version := Ada_2012;
                Ada_Version_Explicit := Ada_2012;
             end if;
          end;
@@ -5620,7 +5722,7 @@ package body Sem_Prag is
                else
                   Arg := Next (Arg2);
                   while Present (Arg) loop
-                     Exp := Expression (Arg);
+                     Exp := Get_Pragma_Arg (Arg);
                      Analyze (Exp);
 
                      if Is_Entity_Name (Exp) then
@@ -5758,7 +5860,7 @@ package body Sem_Prag is
             Check_No_Identifiers;
             Check_Arg_Is_One_Of (Arg1, Name_On, Name_Off);
 
-            if Chars (Expression (Arg1)) = Name_On then
+            if Chars (Get_Pragma_Arg (Arg1)) = Name_On then
                Assume_No_Invalid_Values := True;
             else
                Assume_No_Invalid_Values := False;
@@ -5779,7 +5881,7 @@ package body Sem_Prag is
             Check_Arg_Count (1);
             Check_No_Identifiers;
             Check_Arg_Is_Local_Name (Arg1);
-            Ent := Entity (Expression (Arg1));
+            Ent := Entity (Get_Pragma_Arg (Arg1));
 
             --  Note: the implementation of the AST_Entry pragma could handle
             --  the entry family case fine, but for now we are consistent with
@@ -5882,8 +5984,8 @@ package body Sem_Prag is
             end if;
 
             C_Ent := Cunit_Entity (Current_Sem_Unit);
-            Analyze (Expression (Arg1));
-            Nm := Entity (Expression (Arg1));
+            Analyze (Get_Pragma_Arg (Arg1));
+            Nm := Entity (Get_Pragma_Arg (Arg1));
 
             if not Is_Remote_Call_Interface (C_Ent)
               and then not Is_Remote_Types (C_Ent)
@@ -5995,7 +6097,7 @@ package body Sem_Prag is
             Check_No_Identifiers;
             Check_Arg_Count (1);
             Check_Arg_Is_Local_Name (Arg1);
-            E_Id := Expression (Arg1);
+            E_Id := Get_Pragma_Arg (Arg1);
 
             if Etype (E_Id) = Any_Type then
                return;
@@ -6028,10 +6130,10 @@ package body Sem_Prag is
                   E := Base_Type (E);
                end if;
 
-               Set_Has_Volatile_Components (E);
+               Set_Has_Volatile_Components (E, Sense);
 
                if Prag_Id = Pragma_Atomic_Components then
-                  Set_Has_Atomic_Components (E);
+                  Set_Has_Atomic_Components (E, Sense);
                end if;
 
             else
@@ -6055,24 +6157,23 @@ package body Sem_Prag is
             else
                Check_Interrupt_Or_Attach_Handler;
 
-               --  The expression that designates the attribute may
-               --  depend on a discriminant, and is therefore a per-
-               --  object expression, to be expanded in the init proc.
-               --  If expansion is enabled, perform semantic checks
-               --  on a copy only.
+               --  The expression that designates the attribute may depend on a
+               --  discriminant, and is therefore a per- object expression, to
+               --  be expanded in the init proc. If expansion is enabled, then
+               --  perform semantic checks on a copy only.
 
                if Expander_Active then
                   declare
                      Temp : constant Node_Id :=
-                              New_Copy_Tree (Expression (Arg2));
+                              New_Copy_Tree (Get_Pragma_Arg (Arg2));
                   begin
                      Set_Parent (Temp, N);
                      Preanalyze_And_Resolve (Temp, RTE (RE_Interrupt_ID));
                   end;
 
                else
-                  Analyze (Expression (Arg2));
-                  Resolve (Expression (Arg2), RTE (RE_Interrupt_ID));
+                  Analyze (Get_Pragma_Arg (Arg2));
+                  Resolve (Get_Pragma_Arg (Arg2), RTE (RE_Interrupt_ID));
                end if;
 
                Process_Interrupt_Or_Attach_Handler;
@@ -6094,7 +6195,7 @@ package body Sem_Prag is
             Check_Arg_Count (1);
             Check_Optional_Identifier (Arg1, "max_size");
 
-            Arg := Expression (Arg1);
+            Arg := Get_Pragma_Arg (Arg1);
             Check_Arg_Is_Static_Expression (Arg, Any_Integer);
 
             Val := Expr_Value (Arg);
@@ -6174,7 +6275,7 @@ package body Sem_Prag is
             --  compile time, and we do not want to delete this warning when we
             --  delete the if statement.
 
-            Expr := Expression (Arg2);
+            Expr := Get_Pragma_Arg (Arg2);
 
             if Expander_Active and then not Check_On then
                Eloc := Sloc (Expr);
@@ -6211,7 +6312,7 @@ package body Sem_Prag is
             Check_Arg_Is_Identifier (Arg1);
 
             declare
-               Nam : constant Name_Id := Chars (Expression (Arg1));
+               Nam : constant Name_Id := Chars (Get_Pragma_Arg (Arg1));
 
             begin
                for J in Check_Names.First .. Check_Names.Last loop
@@ -6349,7 +6450,7 @@ package body Sem_Prag is
             Check_Arg_Count (1);
             Check_Optional_Identifier (Arg1, Name_Entity);
             Check_Arg_Is_Local_Name (Arg1);
-            E_Id := Expression (Arg1);
+            E_Id := Get_Pragma_Arg (Arg1);
 
             if Etype (E_Id) = Any_Type then
                return;
@@ -6497,7 +6598,7 @@ package body Sem_Prag is
             Check_No_Identifiers;
             Check_Arg_Count (1);
             Check_Arg_Is_Local_Name (Arg1);
-            Arg := Expression (Arg1);
+            Arg := Get_Pragma_Arg (Arg1);
 
             if not Is_Entity_Name (Arg)
               or else not Is_Access_Type (Entity (Arg))
@@ -6546,8 +6647,8 @@ package body Sem_Prag is
             Check_Optional_Identifier (Arg2, Name_Convention);
             Check_Arg_Is_Identifier (Arg1);
             Check_Arg_Is_Identifier (Arg2);
-            Idnam := Chars (Expression (Arg1));
-            Cname := Chars (Expression (Arg2));
+            Idnam := Chars (Get_Pragma_Arg (Arg1));
+            Cname := Chars (Get_Pragma_Arg (Arg2));
 
             if Is_Convention_Name (Cname) then
                Record_Convention_Identifier
@@ -6580,7 +6681,7 @@ package body Sem_Prag is
             Check_Optional_Identifier (Arg1, Name_Entity);
             Check_Arg_Is_Local_Name (Arg1);
 
-            Arg := Expression (Arg1);
+            Arg := Get_Pragma_Arg (Arg1);
             Analyze (Arg);
 
             if Etype (Arg) = Any_Type then
@@ -6697,7 +6798,7 @@ package body Sem_Prag is
             Check_Optional_Identifier (Arg1, Name_Entity);
             Check_Arg_Is_Local_Name (Arg1);
 
-            Id := Expression (Arg1);
+            Id := Get_Pragma_Arg (Arg1);
             Find_Program_Unit_Name (Id);
 
             --  If we did not find the name, we are done
@@ -6819,7 +6920,7 @@ package body Sem_Prag is
                Cond :=
                  Make_And_Then (Loc,
                    Left_Opnd   => Relocate_Node (Cond),
-                   Right_Opnd  => Expression (Arg1));
+                   Right_Opnd  => Get_Pragma_Arg (Arg1));
             end if;
 
             --  Rewrite into a conditional with an appropriate condition. We
@@ -6848,7 +6949,8 @@ package body Sem_Prag is
             GNAT_Pragma;
             Check_Arg_Count (1);
             Check_Arg_Is_One_Of (Arg1, Name_Check, Name_Ignore);
-            Debug_Pragmas_Enabled := Chars (Expression (Arg1)) = Name_Check;
+            Debug_Pragmas_Enabled :=
+              Chars (Get_Pragma_Arg (Arg1)) = Name_Check;
 
          ---------------------
          -- Detect_Blocking --
@@ -6911,7 +7013,7 @@ package body Sem_Prag is
                   --  defined in the current declarative part, and recursively
                   --  to any nested scope.
 
-                  Set_Discard_Names (Current_Scope);
+                  Set_Discard_Names (Current_Scope, Sense);
                   return;
 
                else
@@ -6919,7 +7021,7 @@ package body Sem_Prag is
                   Check_Optional_Identifier (Arg1, Name_On);
                   Check_Arg_Is_Local_Name (Arg1);
 
-                  E_Id := Expression (Arg1);
+                  E_Id := Get_Pragma_Arg (Arg1);
 
                   if Etype (E_Id) = Any_Type then
                      return;
@@ -6932,7 +7034,7 @@ package body Sem_Prag is
                         (Is_Enumeration_Type (E) or else Is_Tagged_Type (E)))
                     or else Ekind (E) = E_Exception
                   then
-                     Set_Discard_Names (E);
+                     Set_Discard_Names (E, Sense);
                   else
                      Error_Pragma_Arg
                        ("inappropriate entity for pragma%", Arg1);
@@ -6997,10 +7099,10 @@ package body Sem_Prag is
                Citem := First (List_Containing (N));
                Inner : while Citem /= N loop
                   if Nkind (Citem) = N_With_Clause
-                    and then Same_Name (Name (Citem), Expression (Arg))
+                    and then Same_Name (Name (Citem), Get_Pragma_Arg (Arg))
                   then
                      Set_Elaborate_Present (Citem, True);
-                     Set_Unit_Name (Expression (Arg), Name (Citem));
+                     Set_Unit_Name (Get_Pragma_Arg (Arg), Name (Citem));
 
                      --  With the pragma present, elaboration calls on
                      --  subprograms from the named unit need no further
@@ -7079,10 +7181,10 @@ package body Sem_Prag is
                Citem := First (List_Containing (N));
                Innr : while Citem /= N loop
                   if Nkind (Citem) = N_With_Clause
-                    and then Same_Name (Name (Citem), Expression (Arg))
+                    and then Same_Name (Name (Citem), Get_Pragma_Arg (Arg))
                   then
                      Set_Elaborate_All_Present (Citem, True);
-                     Set_Unit_Name (Expression (Arg), Name (Citem));
+                     Set_Unit_Name (Get_Pragma_Arg (Arg), Name (Citem));
 
                      --  Suppress warnings and elaboration checks on the named
                      --  unit if the pragma is in the current compilation, as
@@ -7281,7 +7383,8 @@ package body Sem_Prag is
             Process_Convention (C, Def_Id);
 
             if Ekind (Def_Id) /= E_Constant then
-               Note_Possible_Modification (Expression (Arg2), Sure => False);
+               Note_Possible_Modification
+                 (Get_Pragma_Arg (Arg2), Sure => False);
             end if;
 
             Process_Interface_Name (Def_Id, Arg3, Arg4);
@@ -7619,13 +7722,13 @@ package body Sem_Prag is
             Check_Optional_Identifier (Arg1, Name_Name);
             Check_Arg_Is_Identifier (Arg1);
 
-            Get_Name_String (Chars (Expression (Arg1)));
+            Get_Name_String (Chars (Get_Pragma_Arg (Arg1)));
 
             if Name_Len > 4
               and then Name_Buffer (1 .. 4) = "aux_"
             then
                if Present (System_Extend_Pragma_Arg) then
-                  if Chars (Expression (Arg1)) =
+                  if Chars (Get_Pragma_Arg (Arg1)) =
                      Chars (Expression (System_Extend_Pragma_Arg))
                   then
                      null;
@@ -7658,7 +7761,7 @@ package body Sem_Prag is
             Check_No_Identifiers;
             Check_Arg_Is_One_Of (Arg1, Name_On, Name_Off);
 
-            if Chars (Expression (Arg1)) = Name_On then
+            if Chars (Get_Pragma_Arg (Arg1)) = Name_On then
                Extensions_Allowed := True;
                Ada_Version := Ada_Version_Type'Last;
 
@@ -7693,7 +7796,8 @@ package body Sem_Prag is
             Check_At_Least_N_Arguments (2);
             Check_At_Most_N_Arguments  (4);
             Process_Convention (C, Def_Id);
-            Note_Possible_Modification (Expression (Arg2), Sure => False);
+            Note_Possible_Modification
+              (Get_Pragma_Arg (Arg2), Sure => False);
             Process_Interface_Name (Def_Id, Arg3, Arg4);
             Set_Exported (Def_Id, Arg2);
          end External;
@@ -7761,19 +7865,22 @@ package body Sem_Prag is
             Check_No_Identifiers;
             Check_Arg_Count (1);
             Check_Arg_Is_Local_Name (Arg1);
-            Named_Entity := Entity (Expression (Arg1));
+            Named_Entity := Entity (Get_Pragma_Arg (Arg1));
 
             --  If it's an access-to-subprogram type (in particular, not a
             --  subtype), set the flag on that type.
 
             if Is_Access_Subprogram_Type (Named_Entity) then
-               Set_Can_Use_Internal_Rep (Named_Entity, False);
+               if Sense then
+                  Set_Can_Use_Internal_Rep (Named_Entity, False);
+               end if;
 
             --  Otherwise it's an error (name denotes the wrong sort of entity)
 
             else
                Error_Pragma_Arg
-                 ("access-to-subprogram type expected", Expression (Arg1));
+                 ("access-to-subprogram type expected",
+                  Get_Pragma_Arg (Arg1));
             end if;
          end Favor_Top_Level;
 
@@ -7797,7 +7904,7 @@ package body Sem_Prag is
 
          when Pragma_Finalize_Storage_Only => Finalize_Storage : declare
             Assoc   : constant Node_Id := Arg1;
-            Type_Id : constant Node_Id := Expression (Assoc);
+            Type_Id : constant Node_Id := Get_Pragma_Arg (Assoc);
             Typ     : Entity_Id;
 
          begin
@@ -7859,7 +7966,7 @@ package body Sem_Prag is
             Check_Arg_Is_One_Of (Arg1, Name_VAX_Float, Name_IEEE_Float);
 
             if not OpenVMS_On_Target then
-               if Chars (Expression (Arg1)) = Name_VAX_Float then
+               if Chars (Get_Pragma_Arg (Arg1)) = Name_VAX_Float then
                   Error_Pragma
                     ("?pragma% ignored (applies only to Open'V'M'S)");
                end if;
@@ -7870,7 +7977,7 @@ package body Sem_Prag is
             --  One argument case
 
             if Arg_Count = 1 then
-               if Chars (Expression (Arg1)) = Name_VAX_Float then
+               if Chars (Get_Pragma_Arg (Arg1)) = Name_VAX_Float then
                   if Opt.Float_Format = 'I' then
                      Error_Pragma ("'I'E'E'E format previously specified");
                   end if;
@@ -7905,7 +8012,7 @@ package body Sem_Prag is
 
                --  Two arguments, VAX_Float case
 
-               if Chars (Expression (Arg1)) = Name_VAX_Float then
+               if Chars (Get_Pragma_Arg (Arg1)) = Name_VAX_Float then
                   case Digs is
                      when  6 => Set_F_Float (Ent);
                      when  9 => Set_D_Float (Ent);
@@ -7959,7 +8066,7 @@ package body Sem_Prag is
                Check_Is_In_Decl_Part_Or_Package_Spec;
             end if;
 
-            Str := Expr_Value_S (Expression (Arg1));
+            Str := Expr_Value_S (Get_Pragma_Arg (Arg1));
 
             declare
                CS : Node_Id;
@@ -8061,7 +8168,7 @@ package body Sem_Prag is
 
             --  Extract the name of the local procedure
 
-            Proc_Id := Entity (Expression (Arg1));
+            Proc_Id := Entity (Get_Pragma_Arg (Arg1));
 
             --  Ada 2012 (AI05-0030): The procedure_LOCAL_NAME must denote a
             --  primitive procedure of a synchronized tagged type.
@@ -8459,7 +8566,7 @@ package body Sem_Prag is
             Check_No_Identifiers;
             Check_Arg_Count (1);
             Check_Arg_Is_Local_Name (Arg1);
-            E_Id := Expression (Arg1);
+            E_Id := Get_Pragma_Arg (Arg1);
 
             if Etype (E_Id) = Any_Type then
                return;
@@ -8521,7 +8628,7 @@ package body Sem_Prag is
             Check_No_Identifiers;
             Check_Arg_Count (1);
             Check_Arg_Is_Local_Name (Arg1);
-            E_Id := Expression (Arg1);
+            E_Id := Get_Pragma_Arg (Arg1);
 
             if Etype (E_Id) = Any_Type then
                return;
@@ -8634,7 +8741,7 @@ package body Sem_Prag is
             if Arg_Count > 0 then
                Arg := Arg1;
                loop
-                  Exp := Expression (Arg);
+                  Exp := Get_Pragma_Arg (Arg);
                   Analyze (Exp);
 
                   if not Is_Entity_Name (Exp)
@@ -8699,7 +8806,7 @@ package body Sem_Prag is
               ((Name_Entity, Name_External_Name, Name_Link_Name));
             Check_At_Least_N_Arguments (2);
             Check_At_Most_N_Arguments  (3);
-            Id := Expression (Arg1);
+            Id := Get_Pragma_Arg (Arg1);
             Analyze (Id);
 
             if not Is_Entity_Name (Id) then
@@ -8769,6 +8876,7 @@ package body Sem_Prag is
                      Found := True;
                   end if;
 
+                  exit when From_Aspect_Specification (N);
                   Hom_Id := Homonym (Hom_Id);
 
                   exit when No (Hom_Id)
@@ -8815,7 +8923,7 @@ package body Sem_Prag is
             Check_Ada_83_Warning;
 
             if Arg_Count /= 0 then
-               Arg := Expression (Arg1);
+               Arg := Get_Pragma_Arg (Arg1);
                Check_Arg_Count (1);
                Check_No_Identifiers;
 
@@ -8990,7 +9098,7 @@ package body Sem_Prag is
             Check_Optional_Identifier (Arg1, Name_Entity);
             Check_Arg_Is_Local_Name (Arg1);
 
-            Id := Expression (Arg1);
+            Id := Get_Pragma_Arg (Arg1);
             Find_Program_Unit_Name (Id);
 
             --  If we did not find the name, we are done
@@ -9233,6 +9341,7 @@ package body Sem_Prag is
                Set_Convention     (Def_Id, Convention);
                Set_Is_Imported    (Def_Id);
 
+               exit when From_Aspect_Specification (N);
                Hom_Id := Homonym (Hom_Id);
 
                exit when No (Hom_Id) or else Scope (Hom_Id) /= Current_Scope;
@@ -9255,7 +9364,7 @@ package body Sem_Prag is
             Check_Optional_Identifier (Arg1, Name_Entity);
             Check_Arg_Is_Local_Name (Arg1);
 
-            Arg := Expression (Arg1);
+            Arg := Get_Pragma_Arg (Arg1);
             Analyze (Arg);
 
             if Etype (Arg) = Any_Type then
@@ -9307,7 +9416,7 @@ package body Sem_Prag is
             Check_Optional_Identifier (Arg1, Name_On);
             Check_Arg_Is_Local_Name (Arg1);
 
-            Arg := Expression (Arg1);
+            Arg := Get_Pragma_Arg (Arg1);
             Analyze (Arg);
 
             if Etype (Arg) = Any_Type then
@@ -9392,7 +9501,7 @@ package body Sem_Prag is
                   Arg_Store : declare
                      C : constant Char_Code := Get_Char_Code (' ');
                      S : constant String_Id :=
-                           Strval (Expr_Value_S (Expression (Arg)));
+                           Strval (Expr_Value_S (Get_Pragma_Arg (Arg)));
                      L : constant Nat := String_Length (S);
                      F : Nat := 1;
 
@@ -9465,10 +9574,10 @@ package body Sem_Prag is
             --  by the call to Rep_Item_Too_Late (when no error is detected
             --  and False is returned).
 
-            if Rep_Item_Too_Late (Entity (Expression (Arg1)), N) then
+            if Rep_Item_Too_Late (Entity (Get_Pragma_Arg (Arg1)), N) then
                return;
             else
-               Set_Has_Gigi_Rep_Item (Entity (Expression (Arg1)));
+               Set_Has_Gigi_Rep_Item (Entity (Get_Pragma_Arg (Arg1)));
             end if;
 
          ------------------------
@@ -9496,7 +9605,7 @@ package body Sem_Prag is
             Check_Arg_Count (1);
             Check_No_Identifiers;
             Check_Arg_Is_Local_Name (Arg1);
-            Arg1_X := Expression (Arg1);
+            Arg1_X := Get_Pragma_Arg (Arg1);
             Analyze (Arg1_X);
             Proc := Find_Unique_Parameterless_Procedure (Arg1_X, Arg1);
 
@@ -9532,13 +9641,14 @@ package body Sem_Prag is
             Check_Arg_Count (1);
             Check_Is_In_Decl_Part_Or_Package_Spec;
             Check_Arg_Is_Static_Expression (Arg1, Standard_String);
-            Start_String (Strval (Expr_Value_S (Expression (Arg1))));
+            Start_String (Strval (Expr_Value_S (Get_Pragma_Arg (Arg1))));
 
             Arg := Arg2;
             while Present (Arg) loop
                Check_Arg_Is_Static_Expression (Arg, Standard_String);
                Store_String_Char (ASCII.NUL);
-               Store_String_Chars (Strval (Expr_Value_S (Expression (Arg))));
+               Store_String_Chars
+                 (Strval (Expr_Value_S (Get_Pragma_Arg (Arg))));
                Arg := Next (Arg);
             end loop;
 
@@ -9568,7 +9678,7 @@ package body Sem_Prag is
 
             --  This pragma applies only to objects
 
-            if not Is_Object (Entity (Expression (Arg1))) then
+            if not Is_Object (Entity (Get_Pragma_Arg (Arg1))) then
                Error_Pragma_Arg ("pragma% applies only to objects", Arg1);
             end if;
 
@@ -9577,10 +9687,10 @@ package body Sem_Prag is
             --  by the call to Rep_Item_Too_Late (when no error is detected
             --  and False is returned).
 
-            if Rep_Item_Too_Late (Entity (Expression (Arg1)), N) then
+            if Rep_Item_Too_Late (Entity (Get_Pragma_Arg (Arg1)), N) then
                return;
             else
-               Set_Has_Gigi_Rep_Item (Entity (Expression (Arg1)));
+               Set_Has_Gigi_Rep_Item (Entity (Get_Pragma_Arg (Arg1)));
             end if;
 
          ----------
@@ -9611,7 +9721,7 @@ package body Sem_Prag is
             Check_No_Identifiers;
             Check_Arg_Is_Locking_Policy (Arg1);
             Check_Valid_Configuration_Pragma;
-            Get_Name_String (Chars (Expression (Arg1)));
+            Get_Name_String (Chars (Get_Pragma_Arg (Arg1)));
             LP := Fold_Upper (Name_Buffer (1));
 
             if Locking_Policy /= ' '
@@ -9651,7 +9761,7 @@ package body Sem_Prag is
 
             --  D_Float case
 
-            if Chars (Expression (Arg1)) = Name_D_Float then
+            if Chars (Get_Pragma_Arg (Arg1)) = Name_D_Float then
                if Opt.Float_Format_Long = 'G' then
                   Error_Pragma ("G_Float previously specified");
                end if;
@@ -9697,7 +9807,7 @@ package body Sem_Prag is
             Check_Optional_Identifier (Arg2, Name_Attribute_Name);
             Check_Arg_Is_Local_Name (Arg1);
             Check_Arg_Is_Static_Expression (Arg2, Standard_String);
-            Def_Id := Entity (Expression (Arg1));
+            Def_Id := Entity (Get_Pragma_Arg (Arg1));
 
             if Is_Access_Type (Def_Id) then
                Def_Id := Designated_Type (Def_Id);
@@ -9717,7 +9827,7 @@ package body Sem_Prag is
             if Rep_Item_Too_Late (Def_Id, N) then
                return;
             else
-               Set_Has_Gigi_Rep_Item (Entity (Expression (Arg1)));
+               Set_Has_Gigi_Rep_Item (Entity (Get_Pragma_Arg (Arg1)));
             end if;
          end Machine_Attribute;
 
@@ -9866,7 +9976,7 @@ package body Sem_Prag is
             Arg := Arg1;
             while Present (Arg) loop
                Check_Arg_Is_Local_Name (Arg);
-               Id := Expression (Arg);
+               Id := Get_Pragma_Arg (Arg);
                Analyze (Id);
 
                if not Is_Entity_Name (Id) then
@@ -9896,6 +10006,7 @@ package body Sem_Prag is
                      Found := True;
                   end if;
 
+                  exit when From_Aspect_Specification (N);
                   E := Homonym (E);
                end loop;
 
@@ -9957,7 +10068,7 @@ package body Sem_Prag is
             else
                Check_Optional_Identifier (Arg2, Name_Entity);
                Check_Arg_Is_Local_Name (Arg1);
-               E_Id := Entity (Expression (Arg1));
+               E_Id := Entity (Get_Pragma_Arg (Arg1));
 
                if E_Id = Any_Type then
                   return;
@@ -10068,7 +10179,7 @@ package body Sem_Prag is
                   --  Deal with static string argument
 
                   Check_Arg_Is_Static_Expression (Arg1, Standard_String);
-                  S := Strval (Expression (Arg1));
+                  S := Strval (Get_Pragma_Arg (Arg1));
 
                   for J in 1 .. String_Length (S) loop
                      if not In_Character_Range (Get_String_Char (S, J)) then
@@ -10079,7 +10190,7 @@ package body Sem_Prag is
                   end loop;
 
                   Obsolescent_Warnings.Append
-                    ((Ent => Ent, Msg => Strval (Expression (Arg1))));
+                    ((Ent => Ent, Msg => Strval (Get_Pragma_Arg (Arg1))));
 
                   --  Check for Ada_05 parameter
 
@@ -10272,7 +10383,7 @@ package body Sem_Prag is
             Check_Arg_Count (1);
             Check_Arg_Is_Local_Name (Arg1);
 
-            Type_Id := Expression (Assoc);
+            Type_Id := Get_Pragma_Arg (Assoc);
             Find_Type (Type_Id);
             Typ := Entity (Type_Id);
 
@@ -10308,7 +10419,7 @@ package body Sem_Prag is
             Check_Arg_Count (1);
             Check_Arg_Is_Local_Name (Arg1);
 
-            Type_Id := Expression (Assoc);
+            Type_Id := Get_Pragma_Arg (Assoc);
             Find_Type (Type_Id);
             Typ := Entity (Type_Id);
 
@@ -10325,13 +10436,11 @@ package body Sem_Prag is
             end if;
 
             Check_First_Subtype (Arg1);
-
-            if Has_Pragma_Pack (Typ) then
-               Error_Pragma ("duplicate pragma%, only one allowed");
+            Check_Duplicate_Pragma (Typ);
 
             --  Array type
 
-            elsif Is_Array_Type (Typ) then
+            if Is_Array_Type (Typ) then
                Ctyp := Component_Type (Typ);
 
                --  Ignore pack that does nothing
@@ -10357,22 +10466,59 @@ package body Sem_Prag is
                   if CodePeer_Mode then
                      null;
 
-                  --  For normal non-VM target, do the packing
+                  --  Don't attempt any packing for VM targets. We possibly
+                  --  could deal with some cases of array bit-packing, but we
+                  --  don't bother, since this is not a typical kind of
+                  --  representation in the VM context anyway (and would not
+                  --  for example work nicely with the debugger).
+
+                  elsif VM_Target /= No_VM then
+                     if not GNAT_Mode then
+                        Error_Pragma
+                          ("?pragma% ignored in this configuration");
+                     end if;
+
+                  --  Normal case where we do the pack action
 
-                  elsif VM_Target = No_VM then
+                  else
                      if not Ignore then
-                        Set_Is_Packed            (Base_Type (Typ));
-                        Set_Has_Non_Standard_Rep (Base_Type (Typ));
+                        Set_Is_Packed            (Base_Type (Typ), Sense);
+                        Set_Has_Non_Standard_Rep (Base_Type (Typ), Sense);
                      end if;
 
-                     Set_Has_Pragma_Pack (Base_Type (Typ));
+                     Set_Has_Pragma_Pack (Base_Type (Typ), Sense);
 
-                  --  If we ignore the pack for VM_Targets, then warn about
-                  --  this, except suppress the warning in GNAT mode.
+                     --  Complete reset action for Aspect_Cancel case
 
-                  elsif not GNAT_Mode then
-                     Error_Pragma
-                       ("?pragma% ignored in this configuration");
+                     if Sense = False then
+
+                        --  Cancel size unless explicitly set
+
+                        if not Has_Size_Clause (Typ)
+                           and then not Has_Object_Size_Clause (Typ)
+                        then
+                           Set_Esize     (Typ, Uint_0);
+                           Set_RM_Size   (Typ, Uint_0);
+                           Set_Alignment (Typ, Uint_0);
+                           Set_Packed_Array_Type (Typ, Empty);
+                        end if;
+
+                        --  Reset component size unless explicitly set
+
+                        if not Has_Component_Size_Clause (Typ) then
+                           if Known_Static_Esize (Ctyp)
+                             and then Known_Static_RM_Size (Ctyp)
+                             and then Esize (Ctyp) = RM_Size (Ctyp)
+                             and then Addressable (Esize (Ctyp))
+                           then
+                              Set_Component_Size
+                                (Base_Type (Typ), Esize (Ctyp));
+                           else
+                              Set_Component_Size
+                                (Base_Type (Typ), Uint_0);
+                           end if;
+                        end if;
+                     end if;
                   end if;
                end if;
 
@@ -10380,13 +10526,36 @@ package body Sem_Prag is
 
             else pragma Assert (Is_Record_Type (Typ));
                if not Rep_Item_Too_Late (Typ, N) then
-                  if VM_Target = No_VM then
-                     Set_Is_Packed            (Base_Type (Typ));
-                     Set_Has_Pragma_Pack      (Base_Type (Typ));
-                     Set_Has_Non_Standard_Rep (Base_Type (Typ));
 
-                  elsif not GNAT_Mode then
-                     Error_Pragma ("?pragma% ignored in this configuration");
+                  --  Ignore pack request with warning in VM mode (skip warning
+                  --  if we are compiling GNAT run time library).
+
+                  if VM_Target /= No_VM then
+                     if not GNAT_Mode then
+                        Error_Pragma
+                          ("?pragma% ignored in this configuration");
+                     end if;
+
+                  --  Normal case of pack request active
+
+                  else
+                     Set_Is_Packed            (Base_Type (Typ), Sense);
+                     Set_Has_Pragma_Pack      (Base_Type (Typ), Sense);
+                     Set_Has_Non_Standard_Rep (Base_Type (Typ), Sense);
+
+                     --  Complete reset action for Aspect_Cancel case
+
+                     if Sense = False then
+
+                        --  Cancel size if not explicitly given
+
+                        if not Has_Size_Clause (Typ)
+                          and then not Has_Object_Size_Clause (Typ)
+                        then
+                           Set_Esize     (Typ, Uint_0);
+                           Set_Alignment (Typ, Uint_0);
+                        end if;
+                     end if;
                   end if;
                end if;
             end if;
@@ -10441,7 +10610,7 @@ package body Sem_Prag is
             Check_Arg_Is_Identifier (Arg1);
             Check_Arg_Is_Local_Name (Arg1);
             Check_First_Subtype (Arg1);
-            Ent := Entity (Expression (Arg1));
+            Ent := Entity (Get_Pragma_Arg (Arg1));
 
             if not Is_Private_Type (Ent)
               and then not Is_Protected_Type (Ent)
@@ -10498,15 +10667,15 @@ package body Sem_Prag is
             if Arg_Count = 1 then
                Check_Arg_Is_Library_Level_Local_Name (Arg1);
 
-               if not Is_Entity_Name (Expression (Arg1))
-                 or else
-                  (Ekind (Entity (Expression (Arg1))) /= E_Variable
-                    and then Ekind (Entity (Expression (Arg1))) /= E_Constant)
+               if not Is_Entity_Name (Get_Pragma_Arg (Arg1))
+                 or else not
+                  Ekind_In (Entity (Get_Pragma_Arg (Arg1)), E_Variable,
+                                                            E_Constant)
                then
                   Error_Pragma_Arg ("pragma% only applies to objects", Arg1);
                end if;
 
-               Ent := Entity (Expression (Arg1));
+               Ent := Entity (Get_Pragma_Arg (Arg1));
                Decl := Parent (Ent);
 
                if Rep_Item_Too_Late (Ent, N) then
@@ -10524,11 +10693,15 @@ package body Sem_Prag is
                      Arg1);
                end if;
 
-               Prag :=
-                 Make_Linker_Section_Pragma
-                   (Ent, Sloc (N), ".persistent.bss");
-               Insert_After (N, Prag);
-               Analyze (Prag);
+               Check_Duplicate_Pragma (Ent);
+
+               if Sense then
+                  Prag :=
+                    Make_Linker_Section_Pragma
+                      (Ent, Sloc (N), ".persistent.bss");
+                  Insert_After (N, Prag);
+                  Analyze (Prag);
+               end if;
 
             --  Case of use as configuration pragma with no arguments
 
@@ -10549,7 +10722,7 @@ package body Sem_Prag is
             Check_Arg_Count (1);
             Check_No_Identifiers;
             Check_Arg_Is_One_Of (Arg1, Name_On, Name_Off);
-            Polling_Required := (Chars (Expression (Arg1)) = Name_On);
+            Polling_Required := (Chars (Get_Pragma_Arg (Arg1)) = Name_On);
 
          -------------------
          -- Postcondition --
@@ -10648,6 +10821,7 @@ package body Sem_Prag is
             end if;
 
             Ent := Find_Lib_Unit_Name;
+            Check_Duplicate_Pragma (Ent);
 
             --  This filters out pragmas inside generic parent then
             --  show up inside instantiation
@@ -10657,8 +10831,8 @@ package body Sem_Prag is
                               and then Present (Generic_Parent (Pa)))
             then
                if not Debug_Flag_U then
-                  Set_Is_Preelaborated (Ent);
-                  Set_Suppress_Elaboration_Warnings (Ent);
+                  Set_Is_Preelaborated (Ent, Sense);
+                  Set_Suppress_Elaboration_Warnings (Ent, Sense);
                end if;
             end if;
          end Preelaborate;
@@ -10720,7 +10894,7 @@ package body Sem_Prag is
             if Nkind (P) = N_Subprogram_Body then
                Check_In_Main_Program;
 
-               Arg := Expression (Arg1);
+               Arg := Get_Pragma_Arg (Arg1);
                Analyze_And_Resolve (Arg, Standard_Integer);
 
                --  Must be static
@@ -10770,7 +10944,7 @@ package body Sem_Prag is
             --  Task or Protected, must be of type Integer
 
             elsif Nkind_In (P, N_Protected_Definition, N_Task_Definition) then
-               Arg := Expression (Arg1);
+               Arg := Get_Pragma_Arg (Arg1);
 
                --  The expression must be analyzed in the special manner
                --  described in "Handling of Default and Per-Object
@@ -10826,14 +11000,14 @@ package body Sem_Prag is
             Check_No_Identifiers;
             Check_Arg_Is_Task_Dispatching_Policy (Arg1);
             Check_Valid_Configuration_Pragma;
-            Get_Name_String (Chars (Expression (Arg1)));
+            Get_Name_String (Chars (Get_Pragma_Arg (Arg1)));
             DP := Fold_Upper (Name_Buffer (1));
 
-            Lower_Bound := Expression (Arg2);
+            Lower_Bound := Get_Pragma_Arg (Arg2);
             Check_Arg_Is_Static_Expression (Lower_Bound, Standard_Integer);
             Lower_Val := Expr_Value (Lower_Bound);
 
-            Upper_Bound := Expression (Arg3);
+            Upper_Bound := Get_Pragma_Arg (Arg3);
             Check_Arg_Is_Static_Expression (Upper_Bound, Standard_Integer);
             Upper_Val := Expr_Value (Upper_Bound);
 
@@ -11219,7 +11393,7 @@ package body Sem_Prag is
             Check_Arg_Count (1);
             Check_Optional_Identifier (Arg1, Name_Entity);
             Check_Arg_Is_Local_Name (Arg1);
-            E_Id := Expression (Arg1);
+            E_Id := Get_Pragma_Arg (Arg1);
 
             if Error_Posted (E_Id) then
                return;
@@ -11241,18 +11415,19 @@ package body Sem_Prag is
                        ("pragma% requires a function name", Arg1);
                   end if;
 
-                  Set_Is_Pure (Def_Id);
+                  Set_Is_Pure (Def_Id, Sense);
 
                   if not Has_Pragma_Pure_Function (Def_Id) then
-                     Set_Has_Pragma_Pure_Function (Def_Id);
-                     Effective := True;
+                     Set_Has_Pragma_Pure_Function (Def_Id, Sense);
+                     Effective := Sense;
                   end if;
 
+                  exit when From_Aspect_Specification (N);
                   E := Homonym (E);
                   exit when No (E) or else Scope (E) /= Current_Scope;
                end loop;
 
-               if not Effective
+               if Sense and then not Effective
                  and then Warn_On_Redundant_Constructs
                then
                   Error_Msg_NE
@@ -11277,7 +11452,7 @@ package body Sem_Prag is
             Check_No_Identifiers;
             Check_Arg_Is_Queuing_Policy (Arg1);
             Check_Valid_Configuration_Pragma;
-            Get_Name_String (Chars (Expression (Arg1)));
+            Get_Name_String (Chars (Get_Pragma_Arg (Arg1)));
             QP := Fold_Upper (Name_Buffer (1));
 
             if Queuing_Policy /= ' '
@@ -11313,7 +11488,7 @@ package body Sem_Prag is
             Check_No_Identifiers;
             Check_Arg_Count (1);
 
-            Arg := Expression (Arg1);
+            Arg := Get_Pragma_Arg (Arg1);
 
             --  The expression must be analyzed in the special manner described
             --  in "Handling of Default and Per-Object Expressions" in sem.ads.
@@ -11702,7 +11877,7 @@ package body Sem_Prag is
             --  The expression must be analyzed in the special manner described
             --  in "Handling of Default Expressions" in sem.ads.
 
-            Arg := Expression (Arg1);
+            Arg := Get_Pragma_Arg (Arg1);
             Preanalyze_Spec_Expression (Arg, Any_Integer);
 
             if not Is_Static_Expression (Arg) then
@@ -11738,7 +11913,7 @@ package body Sem_Prag is
             Check_Arg_Count (1);
             Check_Arg_Is_Integer_Literal (Arg1);
 
-            if Intval (Expression (Arg1)) /=
+            if Intval (Get_Pragma_Arg (Arg1)) /=
               UI_From_Int (Ttypes.System_Storage_Unit)
             then
                Error_Msg_Uint_1 := UI_From_Int (Ttypes.System_Storage_Unit);
@@ -11772,7 +11947,7 @@ package body Sem_Prag is
 
             begin
                Check_Arg_Is_Local_Name (Arg);
-               Ent := Entity (Expression (Arg));
+               Ent := Entity (Get_Pragma_Arg (Arg));
 
                if Has_Homonym (Ent) then
                   Error_Pragma_Arg
@@ -11804,9 +11979,9 @@ package body Sem_Prag is
 
             declare
                Typ   : constant Entity_Id :=
-                         Underlying_Type (Entity (Expression (Arg1)));
-               Read  : constant Entity_Id := Entity (Expression (Arg2));
-               Write : constant Entity_Id := Entity (Expression (Arg3));
+                         Underlying_Type (Entity (Get_Pragma_Arg (Arg1)));
+               Read  : constant Entity_Id := Entity (Get_Pragma_Arg (Arg2));
+               Write : constant Entity_Id := Entity (Get_Pragma_Arg (Arg3));
 
             begin
                Check_First_Subtype (Arg1);
@@ -11869,7 +12044,7 @@ package body Sem_Prag is
          --  we don't need to issue error messages here.
 
          when Pragma_Style_Checks => Style_Checks : declare
-            A  : constant Node_Id   := Expression (Arg1);
+            A  : constant Node_Id   := Get_Pragma_Arg (Arg1);
             S  : String_Id;
             C  : Char_Code;
 
@@ -11887,7 +12062,7 @@ package body Sem_Prag is
                   E    : Entity_Id;
 
                begin
-                  E_Id := Expression (Arg2);
+                  E_Id := Get_Pragma_Arg (Arg2);
                   Analyze (E_Id);
 
                   if not Is_Entity_Name (E_Id) then
@@ -11903,7 +12078,7 @@ package body Sem_Prag is
                   else
                      loop
                         Set_Suppress_Style_Checks (E,
-                          (Chars (Expression (Arg1)) = Name_Off));
+                          (Chars (Get_Pragma_Arg (Arg1)) = Name_Off));
                         exit when No (Homonym (E));
                         E := Homonym (E);
                      end loop;
@@ -12019,7 +12194,7 @@ package body Sem_Prag is
             Check_Arg_Count (1);
             Check_Optional_Identifier (Arg1, Name_Entity);
             Check_Arg_Is_Local_Name (Arg1);
-            Set_Debug_Info_Off (Entity (Get_Pragma_Arg (Arg1)));
+            Set_Debug_Info_Off (Entity (Get_Pragma_Arg (Arg1)), Sense);
 
          ----------------------------------
          -- Suppress_Exception_Locations --
@@ -12049,7 +12224,7 @@ package body Sem_Prag is
             Check_Optional_Identifier (Arg1, Name_Entity);
             Check_Arg_Is_Local_Name (Arg1);
 
-            E_Id := Expression (Arg1);
+            E_Id := Get_Pragma_Arg (Arg1);
 
             if Etype (E_Id) = Any_Type then
                return;
@@ -12106,7 +12281,7 @@ package body Sem_Prag is
             Check_No_Identifiers;
             Check_Arg_Is_Task_Dispatching_Policy (Arg1);
             Check_Valid_Configuration_Pragma;
-            Get_Name_String (Chars (Expression (Arg1)));
+            Get_Name_String (Chars (Get_Pragma_Arg (Arg1)));
             DP := Fold_Upper (Name_Buffer (1));
 
             if Task_Dispatching_Policy /= ' '
@@ -12147,9 +12322,10 @@ package body Sem_Prag is
             Check_No_Identifiers;
             Check_Arg_Count (1);
 
-            Analyze_And_Resolve (Expression (Arg1), RTE (RE_Task_Info_Type));
+            Analyze_And_Resolve
+              (Get_Pragma_Arg (Arg1), RTE (RE_Task_Info_Type));
 
-            if Etype (Expression (Arg1)) = Any_Type then
+            if Etype (Get_Pragma_Arg (Arg1)) = Any_Type then
                return;
             end if;
 
@@ -12174,7 +12350,7 @@ package body Sem_Prag is
             Check_No_Identifiers;
             Check_Arg_Count (1);
 
-            Arg := Expression (Arg1);
+            Arg := Get_Pragma_Arg (Arg1);
 
             --  The expression is used in the call to Create_Task, and must be
             --  expanded there, not in the context of the current spec. It must
@@ -12262,7 +12438,7 @@ package body Sem_Prag is
             Check_Optional_Identifier (Arg1, Name_Entity);
             Check_Arg_Is_Library_Level_Local_Name (Arg1);
 
-            Id := Expression (Arg1);
+            Id := Get_Pragma_Arg (Arg1);
             Analyze (Id);
 
             if not Is_Entity_Name (Id)
@@ -12318,7 +12494,7 @@ package body Sem_Prag is
 
             if Get_Source_Unit (Loc) = Main_Unit then
                Opt.Time_Slice_Set := True;
-               Val := Expr_Value_R (Expression (Arg1));
+               Val := Expr_Value_R (Get_Pragma_Arg (Arg1));
 
                if Val <= Ureal_0 then
                   Opt.Time_Slice_Value := 0;
@@ -12369,7 +12545,7 @@ package body Sem_Prag is
 
          when Pragma_Unchecked_Union => Unchecked_Union : declare
             Assoc   : constant Node_Id := Arg1;
-            Type_Id : constant Node_Id := Expression (Assoc);
+            Type_Id : constant Node_Id := Get_Pragma_Arg (Assoc);
             Typ     : Entity_Id;
             Discr   : Entity_Id;
             Tdef    : Node_Id;
@@ -12433,6 +12609,7 @@ package body Sem_Prag is
                        ("Unchecked_Union discriminant must have default value",
                         Discr);
                   end if;
+
                   Next_Discriminant (Discr);
                end loop;
 
@@ -12461,11 +12638,14 @@ package body Sem_Prag is
                end loop;
             end if;
 
-            Set_Is_Unchecked_Union  (Typ, True);
-            Set_Convention          (Typ, Convention_C);
+            Set_Is_Unchecked_Union  (Typ, Sense);
 
-            Set_Has_Unchecked_Union (Base_Type (Typ), True);
-            Set_Is_Unchecked_Union  (Base_Type (Typ), True);
+            if Sense then
+               Set_Convention (Typ, Convention_C);
+            end if;
+
+            Set_Has_Unchecked_Union (Base_Type (Typ), Sense);
+            Set_Is_Unchecked_Union  (Base_Type (Typ), Sense);
          end Unchecked_Union;
 
          ------------------------
@@ -12516,7 +12696,7 @@ package body Sem_Prag is
             Check_Arg_Count (1);
             Check_Optional_Identifier (Arg2, Name_Entity);
             Check_Arg_Is_Local_Name (Arg1);
-            E_Id := Entity (Expression (Arg1));
+            E_Id := Entity (Get_Pragma_Arg (Arg1));
 
             if E_Id = Any_Type then
                return;
@@ -12524,7 +12704,7 @@ package body Sem_Prag is
                Error_Pragma_Arg ("pragma% requires type", Arg1);
             end if;
 
-            Set_Universal_Aliasing (Implementation_Base_Type (E_Id));
+            Set_Universal_Aliasing (Implementation_Base_Type (E_Id), Sense);
          end Universal_Alias;
 
          --------------------
@@ -12592,7 +12772,7 @@ package body Sem_Prag is
                        ("pragma% can only be applied to a variable",
                         Arg_Expr);
                   else
-                     Set_Has_Pragma_Unmodified (Arg_Ent);
+                     Set_Has_Pragma_Unmodified (Arg_Ent, Sense);
                   end if;
                end if;
 
@@ -12634,13 +12814,15 @@ package body Sem_Prag is
                   Citem := First (List_Containing (N));
                   while Citem /= N loop
                      if Nkind (Citem) = N_With_Clause
-                       and then Same_Name (Name (Citem), Expression (Arg_Node))
+                       and then
+                         Same_Name (Name (Citem), Get_Pragma_Arg (Arg_Node))
                      then
                         Set_Has_Pragma_Unreferenced
                           (Cunit_Entity
                              (Get_Source_Unit
                                 (Library_Unit (Citem))));
-                        Set_Unit_Name (Expression (Arg_Node), Name (Citem));
+                        Set_Unit_Name
+                          (Get_Pragma_Arg (Arg_Node), Name (Citem));
                         exit;
                      end if;
 
@@ -12685,7 +12867,7 @@ package body Sem_Prag is
                         Generate_Reference (Arg_Ent, N);
                      end if;
 
-                     Set_Has_Pragma_Unreferenced (Arg_Ent);
+                     Set_Has_Pragma_Unreferenced (Arg_Ent, Sense);
                   end if;
 
                   Next (Arg_Node);
@@ -12720,7 +12902,7 @@ package body Sem_Prag is
                     ("argument for pragma% must be type or subtype", Arg_Node);
                end if;
 
-               Set_Has_Pragma_Unreferenced_Objects (Entity (Arg_Expr));
+               Set_Has_Pragma_Unreferenced_Objects (Entity (Arg_Expr), Sense);
                Next (Arg_Node);
             end loop;
          end Unreferenced_Objects;
@@ -12768,7 +12950,7 @@ package body Sem_Prag is
          --  pragma Validity_Checks (On | Off | ALL_CHECKS | STRING_LITERAL);
 
          when Pragma_Validity_Checks => Validity_Checks : declare
-            A  : constant Node_Id   := Expression (Arg1);
+            A  : constant Node_Id   := Get_Pragma_Arg (Arg1);
             S  : String_Id;
             C  : Char_Code;
 
@@ -12944,7 +13126,7 @@ package body Sem_Prag is
                      Err  : Boolean;
 
                   begin
-                     E_Id := Expression (Arg2);
+                     E_Id := Get_Pragma_Arg (Arg2);
                      Analyze (E_Id);
 
                      --  In the expansion of an inlined body, a reference to
@@ -12968,9 +13150,10 @@ package body Sem_Prag is
                         else
                            loop
                               Set_Warnings_Off
-                                (E, (Chars (Expression (Arg1)) = Name_Off));
+                                (E, (Chars (Get_Pragma_Arg (Arg1)) =
+                                                              Name_Off));
 
-                              if Chars (Expression (Arg1)) = Name_Off
+                              if Chars (Get_Pragma_Arg (Arg1)) = Name_Off
                                 and then Warn_On_Warnings_Off
                               then
                                  Warnings_Off_Pragmas.Append ((N, E));
@@ -13004,7 +13187,7 @@ package body Sem_Prag is
 
                      else
                         String_To_Name_Buffer
-                          (Strval (Expr_Value_S (Expression (Arg2))));
+                          (Strval (Expr_Value_S (Get_Pragma_Arg (Arg2))));
 
                         --  Note on configuration pragma case: If this is a
                         --  configuration pragma, then for an OFF pragma, we
@@ -13051,7 +13234,7 @@ package body Sem_Prag is
             Check_Arg_Count (1);
             Check_Optional_Identifier (Arg1, Name_Entity);
             Check_Arg_Is_Library_Level_Local_Name (Arg1);
-            Ent := Entity (Expression (Arg1));
+            Ent := Entity (Get_Pragma_Arg (Arg1));
 
             if Rep_Item_Too_Early (Ent, N) then
                return;
Index: sem_ch12.adb
===================================================================
--- sem_ch12.adb	(revision 165283)
+++ sem_ch12.adb	(working copy)
@@ -23,6 +23,7 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
+with Aspects;  use Aspects;
 with Atree;    use Atree;
 with Einfo;    use Einfo;
 with Elists;   use Elists;
@@ -1801,6 +1802,7 @@ package body Sem_Ch12 is
    procedure Analyze_Formal_Object_Declaration (N : Node_Id) is
       E  : constant Node_Id := Default_Expression (N);
       Id : constant Node_Id := Defining_Identifier (N);
+      AS : constant List_Id := Aspect_Specifications (N);
       K  : Entity_Kind;
       T  : Node_Id;
 
@@ -1929,6 +1931,8 @@ package body Sem_Ch12 is
               ("initialization not allowed for `IN OUT` formals", N);
          end if;
       end if;
+
+      Analyze_Aspect_Specifications (N, Id, AS);
    end Analyze_Formal_Object_Declaration;
 
    ----------------------------------------------
@@ -1972,13 +1976,14 @@ package body Sem_Ch12 is
       Check_Restriction (No_Fixed_Point, Def);
    end Analyze_Formal_Ordinary_Fixed_Point_Type;
 
-   ----------------------------
-   -- Analyze_Formal_Package --
-   ----------------------------
+   ----------------------------------------
+   -- Analyze_Formal_Package_Declaration --
+   ----------------------------------------
 
-   procedure Analyze_Formal_Package (N : Node_Id) is
+   procedure Analyze_Formal_Package_Declaration (N : Node_Id) is
       Loc              : constant Source_Ptr := Sloc (N);
       Pack_Id          : constant Entity_Id  := Defining_Identifier (N);
+      AS               : constant List_Id    := Aspect_Specifications (N);
       Formal           : Entity_Id;
       Gen_Id           : constant Node_Id    := Name (N);
       Gen_Decl         : Node_Id;
@@ -2115,14 +2120,14 @@ package body Sem_Ch12 is
       if Ekind (Gen_Unit) /= E_Generic_Package then
          Error_Msg_N ("expect generic package name", Gen_Id);
          Restore_Env;
-         return;
+         goto Leave;
 
       elsif  Gen_Unit = Current_Scope then
          Error_Msg_N
            ("generic package cannot be used as a formal package of itself",
              Gen_Id);
          Restore_Env;
-         return;
+         goto Leave;
 
       elsif In_Open_Scopes (Gen_Unit) then
          if Is_Compilation_Unit (Gen_Unit)
@@ -2142,7 +2147,7 @@ package body Sem_Ch12 is
                 & "within itself",
                 Gen_Id);
             Restore_Env;
-            return;
+            goto Leave;
          end if;
       end if;
 
@@ -2190,7 +2195,7 @@ package body Sem_Ch12 is
                Remove_Parent;
             end if;
 
-            return;
+            goto Leave;
       end;
 
       Rewrite (N, New_N);
@@ -2273,7 +2278,9 @@ package body Sem_Ch12 is
       Set_Etype (Pack_Id, Standard_Void_Type);
       Set_Scope (Pack_Id, Scope (Formal));
       Set_Has_Completion (Pack_Id, True);
-   end Analyze_Formal_Package;
+
+      <<Leave>> Analyze_Aspect_Specifications (N, Pack_Id, AS);
+   end Analyze_Formal_Package_Declaration;
 
    ---------------------------------
    -- Analyze_Formal_Private_Type --
@@ -2323,14 +2330,15 @@ package body Sem_Ch12 is
       Set_Parent          (Base, Parent (Def));
    end Analyze_Formal_Signed_Integer_Type;
 
-   -------------------------------
-   -- Analyze_Formal_Subprogram --
-   -------------------------------
+   -------------------------------------------
+   -- Analyze_Formal_Subprogram_Declaration --
+   -------------------------------------------
 
-   procedure Analyze_Formal_Subprogram (N : Node_Id) is
+   procedure Analyze_Formal_Subprogram_Declaration (N : Node_Id) is
       Spec : constant Node_Id   := Specification (N);
       Def  : constant Node_Id   := Default_Name (N);
       Nam  : constant Entity_Id := Defining_Unit_Name (Spec);
+      AS   : constant List_Id   := Aspect_Specifications (N);
       Subp : Entity_Id;
 
    begin
@@ -2340,7 +2348,7 @@ package body Sem_Ch12 is
 
       if Nkind (Nam) = N_Defining_Program_Unit_Name then
          Error_Msg_N ("name of formal subprogram must be a direct name", Nam);
-         return;
+         goto Leave;
       end if;
 
       Analyze_Subprogram_Declaration (N);
@@ -2384,7 +2392,7 @@ package body Sem_Ch12 is
 
             Analyze (Prefix (Def));
             Valid_Default_Attribute (Nam, Def);
-            return;
+            goto Leave;
          end if;
 
          --  Default name may be overloaded, in which case the interpretation
@@ -2394,7 +2402,7 @@ package body Sem_Ch12 is
          --  can be a protected operation.
 
          if Etype (Def) = Any_Type then
-            return;
+            goto Leave;
 
          elsif Nkind (Def) = N_Selected_Component then
             if not Is_Overloadable (Entity (Selector_Name (Def))) then
@@ -2416,7 +2424,7 @@ package body Sem_Ch12 is
 
             else
                Error_Msg_N ("expect valid subprogram name as default", Def);
-               return;
+               goto Leave;
             end if;
 
          elsif Nkind (Def) = N_Character_Literal then
@@ -2429,7 +2437,7 @@ package body Sem_Ch12 is
            or else not Is_Overloadable (Entity (Def))
          then
             Error_Msg_N ("expect valid subprogram name as default", Def);
-            return;
+            goto Leave;
 
          elsif not Is_Overloaded (Def) then
             Subp := Entity (Def);
@@ -2491,7 +2499,9 @@ package body Sem_Ch12 is
             end if;
          end if;
       end if;
-   end Analyze_Formal_Subprogram;
+
+      <<Leave>> Analyze_Aspect_Specifications (N, Nam, AS);
+   end Analyze_Formal_Subprogram_Declaration;
 
    -------------------------------------
    -- Analyze_Formal_Type_Declaration --
@@ -2499,6 +2509,7 @@ package body Sem_Ch12 is
 
    procedure Analyze_Formal_Type_Declaration (N : Node_Id) is
       Def : constant Node_Id := Formal_Type_Definition (N);
+      AS  : constant List_Id := Aspect_Specifications (N);
       T   : Entity_Id;
 
    begin
@@ -2564,6 +2575,7 @@ package body Sem_Ch12 is
       end case;
 
       Set_Is_Generic_Type (T);
+      Analyze_Aspect_Specifications (N, T, AS);
    end Analyze_Formal_Type_Declaration;
 
    ------------------------------------
@@ -2630,6 +2642,7 @@ package body Sem_Ch12 is
 
    procedure Analyze_Generic_Package_Declaration (N : Node_Id) is
       Loc         : constant Source_Ptr := Sloc (N);
+      AS          : constant List_Id    := Aspect_Specifications (N);
       Id          : Entity_Id;
       New_N       : Node_Id;
       Save_Parent : Node_Id;
@@ -2740,6 +2753,8 @@ package body Sem_Ch12 is
             Check_References (Id);
          end if;
       end if;
+
+      Analyze_Aspect_Specifications (N, Id, AS);
    end Analyze_Generic_Package_Declaration;
 
    --------------------------------------------
@@ -2747,6 +2762,7 @@ package body Sem_Ch12 is
    --------------------------------------------
 
    procedure Analyze_Generic_Subprogram_Declaration (N : Node_Id) is
+      AS          : constant List_Id := Aspect_Specifications (N);
       Spec        : Node_Id;
       Id          : Entity_Id;
       Formals     : List_Id;
@@ -2865,6 +2881,7 @@ package body Sem_Ch12 is
       End_Scope;
       Exit_Generic_Scope (Id);
       Generate_Reference_To_Formals (Id);
+      Analyze_Aspect_Specifications (N, Id, AS);
    end Analyze_Generic_Subprogram_Declaration;
 
    -----------------------------------
@@ -2874,6 +2891,7 @@ package body Sem_Ch12 is
    procedure Analyze_Package_Instantiation (N : Node_Id) is
       Loc    : constant Source_Ptr := Sloc (N);
       Gen_Id : constant Node_Id    := Name (N);
+      AS     : constant List_Id    := Aspect_Specifications (N);
 
       Act_Decl      : Node_Id;
       Act_Decl_Name : Node_Id;
@@ -3014,7 +3032,7 @@ package body Sem_Ch12 is
 
       if Etype (Gen_Unit) = Any_Type then
          Restore_Env;
-         return;
+         goto Leave;
 
       elsif Ekind (Gen_Unit) /= E_Generic_Package then
 
@@ -3029,7 +3047,7 @@ package body Sem_Ch12 is
          end if;
 
          Restore_Env;
-         return;
+         goto Leave;
       end if;
 
       if In_Extended_Main_Source_Unit (N) then
@@ -3072,7 +3090,7 @@ package body Sem_Ch12 is
       if In_Open_Scopes (Gen_Unit) then
          Error_Msg_NE ("instantiation of & within itself", N, Gen_Unit);
          Restore_Env;
-         return;
+         goto Leave;
 
       elsif Contains_Instance_Of (Gen_Unit, Current_Scope, Gen_Id) then
          Error_Msg_Node_2 := Current_Scope;
@@ -3080,7 +3098,7 @@ package body Sem_Ch12 is
            ("circular Instantiation: & instantiated in &!", N, Gen_Unit);
          Circularity_Detected := True;
          Restore_Env;
-         return;
+         goto Leave;
 
       else
          Gen_Decl := Unit_Declaration_Node (Gen_Unit);
@@ -3537,6 +3555,8 @@ package body Sem_Ch12 is
          Set_Defining_Identifier (N, Act_Decl_Id);
       end if;
 
+      <<Leave>> Analyze_Aspect_Specifications (N, Act_Decl_Id, AS);
+
    exception
       when Instantiation_Error =>
          if Parent_Installed then
@@ -3890,6 +3910,7 @@ package body Sem_Ch12 is
    is
       Loc    : constant Source_Ptr := Sloc (N);
       Gen_Id : constant Node_Id    := Name (N);
+      AS     : constant List_Id    := Aspect_Specifications (N);
 
       Anon_Id : constant Entity_Id :=
                   Make_Defining_Identifier (Sloc (Defining_Entity (N)),
@@ -4153,7 +4174,7 @@ package body Sem_Ch12 is
             Error_Msg_NE
               ("circular Instantiation: & instantiated in &!", N, Gen_Unit);
             Circularity_Detected := True;
-            return;
+            goto Leave;
          end if;
 
          Gen_Decl := Unit_Declaration_Node (Gen_Unit);
@@ -4311,6 +4332,8 @@ package body Sem_Ch12 is
          Generic_Renamings_HTable.Reset;
       end if;
 
+      <<Leave>> Analyze_Aspect_Specifications (N, Act_Decl_Id, AS);
+
    exception
       when Instantiation_Error =>
          if Parent_Installed then
Index: sem_ch12.ads
===================================================================
--- sem_ch12.ads	(revision 165256)
+++ sem_ch12.ads	(working copy)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2010, 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- --
@@ -34,8 +34,8 @@ package Sem_Ch12 is
    procedure Analyze_Function_Instantiation             (N : Node_Id);
    procedure Analyze_Formal_Object_Declaration          (N : Node_Id);
    procedure Analyze_Formal_Type_Declaration            (N : Node_Id);
-   procedure Analyze_Formal_Subprogram                  (N : Node_Id);
-   procedure Analyze_Formal_Package                     (N : Node_Id);
+   procedure Analyze_Formal_Subprogram_Declaration      (N : Node_Id);
+   procedure Analyze_Formal_Package_Declaration         (N : Node_Id);
 
    procedure Start_Generic;
    --  Must be invoked before starting to process a generic spec or body
Index: sem.adb
===================================================================
--- sem.adb	(revision 165279)
+++ sem.adb	(working copy)
@@ -237,10 +237,10 @@ package body Sem is
             Analyze_Formal_Object_Declaration (N);
 
          when N_Formal_Package_Declaration =>
-            Analyze_Formal_Package (N);
+            Analyze_Formal_Package_Declaration (N);
 
          when N_Formal_Subprogram_Declaration =>
-            Analyze_Formal_Subprogram (N);
+            Analyze_Formal_Subprogram_Declaration (N);
 
          when N_Formal_Type_Declaration =>
             Analyze_Formal_Type_Declaration (N);
@@ -252,7 +252,7 @@ package body Sem is
             Analyze_Freeze_Entity (N);
 
          when N_Full_Type_Declaration =>
-            Analyze_Type_Declaration (N);
+            Analyze_Full_Type_Declaration (N);
 
          when N_Function_Call =>
             Analyze_Function_Call (N);
@@ -465,7 +465,7 @@ package body Sem is
             Analyze_Protected_Definition (N);
 
          when N_Protected_Type_Declaration =>
-            Analyze_Protected_Type (N);
+            Analyze_Protected_Type_Declaration (N);
 
          when N_Qualified_Expression =>
             Analyze_Qualified_Expression (N);
@@ -505,10 +505,10 @@ package body Sem is
             Analyze_Selective_Accept (N);
 
          when N_Single_Protected_Declaration =>
-            Analyze_Single_Protected (N);
+            Analyze_Single_Protected_Declaration (N);
 
          when N_Single_Task_Declaration =>
-            Analyze_Single_Task (N);
+            Analyze_Single_Task_Declaration (N);
 
          when N_Slice =>
             Analyze_Slice (N);
@@ -550,7 +550,7 @@ package body Sem is
             Analyze_Task_Definition (N);
 
          when N_Task_Type_Declaration =>
-            Analyze_Task_Type (N);
+            Analyze_Task_Type_Declaration (N);
 
          when N_Terminate_Alternative =>
             Analyze_Terminate_Alternative (N);
Index: par.adb
===================================================================
--- par.adb	(revision 165286)
+++ par.adb	(working copy)
@@ -23,6 +23,7 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
+with Aspects;  use Aspects;
 with Atree;    use Atree;
 with Casing;   use Casing;
 with Debug;    use Debug;
@@ -836,6 +837,25 @@ function Par (Configuration_Pragmas : Bo
    package Ch13 is
       function P_Representation_Clause                return Node_Id;
 
+      function Aspect_Specifications_Present return Boolean;
+      --  This function tests whether the next keyword is WITH followed by
+      --  something that looks reasonably like an aspect specification. If so,
+      --  True is returned. Otherwise False is returned. In either case control
+      --  returns with the token pointer unchanged (i.e. pointing to the WITH
+      --  token in the case where True is returned). This function takes care
+      --  of generating appropriate messages if aspect specifications appear
+      --  in versions of Ada prior to Ada 2012.
+
+      procedure P_Aspect_Specifications (Decl : Node_Id);
+      --  This subprogram is called with the current token pointing to either a
+      --  WITH keyword starting an aspect specification, or a semicolon. In the
+      --  former case, the aspect specifications are scanned out including the
+      --  terminating semicolon, the Has_Aspect_Specifications flag is set in
+      --  the given declaration node, and the list of aspect specifications is
+      --  constructed and associated with this declaration node using a call to
+      --  Set_Aspect_Specifications. If no WITH keyword is present, then this
+      --  call has no effect other than scanning out the semicolon.
+
       function P_Code_Statement (Subtype_Mark : Node_Id) return Node_Id;
       --  Function to parse a code statement. The caller has scanned out
       --  the name to be used as the subtype mark (but has not checked that
Index: par-ch6.adb
===================================================================
--- par-ch6.adb	(revision 165283)
+++ par-ch6.adb	(working copy)
@@ -305,7 +305,7 @@ package body Ch6 is
 
             Set_Defining_Unit_Name (Inst_Node, Name_Node);
             Set_Generic_Associations (Inst_Node, P_Generic_Actual_Part_Opt);
-            TF_Semicolon;
+            P_Aspect_Specifications (Inst_Node);
             Pop_Scope_Stack; -- Don't need scope stack entry in this case
 
             if Is_Overriding then
@@ -525,7 +525,7 @@ package body Ch6 is
                Set_Specification (Absdec_Node, Specification_Node);
                Pop_Scope_Stack; -- discard unneeded entry
                Scan; -- past ABSTRACT
-               TF_Semicolon;
+               P_Aspect_Specifications (Absdec_Node);
                return Absdec_Node;
 
             --  Ada 2005 (AI-248): Parse a null procedure declaration
Index: aspects.adb
===================================================================
--- aspects.adb	(revision 165281)
+++ aspects.adb	(working copy)
@@ -29,10 +29,43 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
+with Atree;  use Atree;
+with Nlists; use Nlists;
+with Sinfo;  use Sinfo;
 with Snames; use Snames;
 
+with GNAT.HTable; use GNAT.HTable;
+
 package body Aspects is
 
+   ------------------------------------------
+   -- Hash Table for Aspect Specifications --
+   ------------------------------------------
+
+   type AS_Hash_Range is range 0 .. 510;
+   --  Size of hash table headers
+
+   function AS_Hash (F : Node_Id) return AS_Hash_Range;
+   --  Hash function for hash table
+
+   function AS_Hash (F : Node_Id) return AS_Hash_Range is
+   begin
+      return AS_Hash_Range (F mod 511);
+   end AS_Hash;
+
+   package Aspect_Specifications_Hash_Table is new
+     GNAT.HTable.Simple_HTable
+       (Header_Num => AS_Hash_Range,
+        Element    => List_Id,
+        No_Element => No_List,
+        Key        => Node_Id,
+        Hash       => AS_Hash,
+        Equal      => "=");
+
+   -----------------------------------------
+   -- Table Linking Names and Aspect_Id's --
+   -----------------------------------------
+
    type Aspect_Entry is record
       Nam : Name_Id;
       Asp : Aspect_Id;
@@ -42,12 +75,10 @@ package body Aspects is
      (Name_Ada_2005,                     Aspect_Ada_2005),
      (Name_Ada_2012,                     Aspect_Ada_2012),
      (Name_Address,                      Aspect_Address),
-     (Name_Aliased,                      Aspect_Aliased),
      (Name_Alignment,                    Aspect_Alignment),
      (Name_Atomic,                       Aspect_Atomic),
      (Name_Atomic_Components,            Aspect_Atomic_Components),
      (Name_Bit_Order,                    Aspect_Bit_Order),
-     (Name_C_Pass_By_Copy,               Aspect_C_Pass_By_Copy),
      (Name_Component_Size,               Aspect_Component_Size),
      (Name_Discard_Names,                Aspect_Discard_Names),
      (Name_External_Tag,                 Aspect_External_Tag),
@@ -60,12 +91,9 @@ package body Aspects is
      (Name_Pack,                         Aspect_Pack),
      (Name_Persistent_BSS,               Aspect_Persistent_BSS),
      (Name_Post,                         Aspect_Post),
-     (Name_Postcondition,                Aspect_Postcondition),
      (Name_Pre,                          Aspect_Pre),
-     (Name_Precondition,                 Aspect_Precondition),
      (Name_Predicate,                    Aspect_Predicate),
      (Name_Preelaborable_Initialization, Aspect_Preelaborable_Initialization),
-     (Name_Psect_Object,                 Aspect_Psect_Object),
      (Name_Pure_Function,                Aspect_Pure_Function),
      (Name_Shared,                       Aspect_Shared),
      (Name_Size,                         Aspect_Size),
@@ -83,8 +111,31 @@ package body Aspects is
      (Name_Value_Size,                   Aspect_Value_Size),
      (Name_Volatile,                     Aspect_Volatile),
      (Name_Volatile_Components,          Aspect_Volatile_Components),
-     (Name_Warnings,                     Aspect_Warnings),
-     (Name_Weak_External,                Aspect_Weak_External));
+     (Name_Warnings,                     Aspect_Warnings));
+
+   -------------------------------------
+   -- Hash Table for Aspect Id Values --
+   -------------------------------------
+
+   type AI_Hash_Range is range 0 .. 112;
+   --  Size of hash table headers
+
+   function AI_Hash (F : Name_Id) return AI_Hash_Range;
+   --  Hash function for hash table
+
+   function AI_Hash (F : Name_Id) return AI_Hash_Range is
+   begin
+      return AI_Hash_Range (F mod 113);
+   end AI_Hash;
+
+   package Aspect_Id_Hash_Table is new
+     GNAT.HTable.Simple_HTable
+       (Header_Num => AI_Hash_Range,
+        Element    => Aspect_Id,
+        No_Element => No_Aspect,
+        Key        => Name_Id,
+        Hash       => AI_Hash,
+        Equal      => "=");
 
    -------------------
    -- Get_Aspect_Id --
@@ -92,13 +143,74 @@ package body Aspects is
 
    function Get_Aspect_Id (Name : Name_Id) return Aspect_Id is
    begin
-      for J in Aspect_Names'Range loop
-         if Aspect_Names (J).Nam = Name then
-            return Aspect_Names (J).Asp;
-         end if;
-      end loop;
-
-      return No_Aspect;
+      return Aspect_Id_Hash_Table.Get (Name);
    end Get_Aspect_Id;
 
+   ---------------------------
+   -- Aspect_Specifications --
+   ---------------------------
+
+   function Aspect_Specifications (N : Node_Id) return List_Id is
+   begin
+      return Aspect_Specifications_Hash_Table.Get (N);
+   end Aspect_Specifications;
+
+   -----------------------------------
+   -- Permits_Aspect_Specifications --
+   -----------------------------------
+
+   Has_Aspect_Specifications_Flag : constant array (Node_Kind) of Boolean :=
+     (N_Abstract_Subprogram_Declaration        => True,
+      N_Component_Declaration                  => True,
+      N_Entry_Declaration                      => True,
+      N_Exception_Declaration                  => True,
+      N_Formal_Abstract_Subprogram_Declaration => True,
+      N_Formal_Concrete_Subprogram_Declaration => True,
+      N_Formal_Object_Declaration              => True,
+      N_Formal_Package_Declaration             => True,
+      N_Formal_Type_Declaration                => True,
+      N_Full_Type_Declaration                  => True,
+      N_Function_Instantiation                 => True,
+      N_Generic_Package_Declaration            => True,
+      N_Generic_Subprogram_Declaration         => True,
+      N_Object_Declaration                     => True,
+      N_Package_Declaration                    => True,
+      N_Package_Instantiation                  => True,
+      N_Private_Extension_Declaration          => True,
+      N_Private_Type_Declaration               => True,
+      N_Procedure_Instantiation                => True,
+      N_Protected_Type_Declaration             => True,
+      N_Single_Protected_Declaration           => True,
+      N_Single_Task_Declaration                => True,
+      N_Subprogram_Declaration                 => True,
+      N_Subtype_Declaration                    => True,
+      N_Task_Type_Declaration                  => True,
+      others                                   => False);
+
+   function Permits_Aspect_Specifications (N : Node_Id) return Boolean is
+   begin
+      return Has_Aspect_Specifications_Flag (Nkind (N));
+   end Permits_Aspect_Specifications;
+
+   -------------------------------
+   -- Set_Aspect_Specifications --
+   -------------------------------
+
+   procedure Set_Aspect_Specifications (N : Node_Id; L : List_Id) is
+   begin
+      pragma Assert (Permits_Aspect_Specifications (N));
+      pragma Assert (not Has_Aspect_Specifications (N));
+      pragma Assert (L /= No_List);
+
+      Set_Has_Aspect_Specifications (N);
+      Set_Parent (L, N);
+      Aspect_Specifications_Hash_Table.Set (N, L);
+   end Set_Aspect_Specifications;
+
+--  Package initialization sets up Aspect Id hash table
+
+begin
+   for J in Aspect_Names'Range loop
+      Aspect_Id_Hash_Table.Set (Aspect_Names (J).Nam, Aspect_Names (J).Asp);
+   end loop;
 end Aspects;
Index: aspects.ads
===================================================================
--- aspects.ads	(revision 165281)
+++ aspects.ads	(working copy)
@@ -29,25 +29,27 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
---  This package defines the aspects that are recognized in aspect
---  specifications. We separate this off in its own packages to that
---  it can be accessed by the parser without dragging in Sem_Asp
+--  This package defines the aspects that are recognized by GNAT in aspect
+--  specifications. It also contains the subprograms for storing/retrieving
+--  aspect speciciations from the tree. The semantic processing for aspect
+--  specifications is found in Sem_Ch13.Analyze_Aspect_Specifications.
 
 with Namet; use Namet;
+with Types; use Types;
 
 package Aspects is
 
+   --  Type defining recognized aspects
+
    type Aspect_Id is
      (No_Aspect,                            -- Dummy entry for no aspect
       Aspect_Ada_2005,                      -- GNAT
       Aspect_Ada_2012,                      -- GNAT
       Aspect_Address,
-      Aspect_Aliased,
       Aspect_Alignment,
       Aspect_Atomic,
       Aspect_Atomic_Components,
       Aspect_Bit_Order,
-      Aspect_C_Pass_By_Copy,
       Aspect_Component_Size,
       Aspect_Discard_Names,
       Aspect_External_Tag,
@@ -56,16 +58,14 @@ package Aspects is
       Aspect_Inline_Always,                 -- GNAT
       Aspect_Invariant,
       Aspect_Machine_Radix,
+      Aspect_No_Return,
       Aspect_Object_Size,                   -- GNAT
       Aspect_Pack,
       Aspect_Persistent_BSS,                -- GNAT
       Aspect_Post,
-      Aspect_Postcondition,                 -- GNAT (equivalent to Post)
       Aspect_Pre,
-      Aspect_Precondition,                  -- GNAT (equivalent to Pre)
       Aspect_Predicate,                     -- GNAT???
       Aspect_Preelaborable_Initialization,
-      Aspect_Psect_Object,                  -- GNAT
       Aspect_Pure_Function,                 -- GNAT
       Aspect_Shared,                        -- GNAT (equivalent to Atomic)
       Aspect_Size,
@@ -83,17 +83,15 @@ package Aspects is
       Aspect_Value_Size,                    -- GNAT
       Aspect_Volatile,
       Aspect_Volatile_Components,
-      Aspect_Warnings,                      -- GNAT
-      Aspect_Weak_External);                -- GNAT
+      Aspect_Warnings);                     -- GNAT
 
    --  The following array indicates aspects that accept 'Class
 
    Class_Aspect_OK : constant array (Aspect_Id) of Boolean :=
                        (Aspect_Invariant     => True,
                         Aspect_Pre           => True,
-                        Aspect_Precondition  => True,
+                        Aspect_Predicate     => True,
                         Aspect_Post          => True,
-                        Aspect_Postcondition => True,
                         others               => False);
 
    --  The following type is used for indicating allowed expression forms
@@ -110,12 +108,10 @@ package Aspects is
                         Aspect_Ada_2005                     => Optional,
                         Aspect_Ada_2012                     => Optional,
                         Aspect_Address                      => Expression,
-                        Aspect_Aliased                      => Optional,
                         Aspect_Alignment                    => Expression,
                         Aspect_Atomic                       => Optional,
                         Aspect_Atomic_Components            => Optional,
                         Aspect_Bit_Order                    => Expression,
-                        Aspect_C_Pass_By_Copy               => Optional,
                         Aspect_Component_Size               => Expression,
                         Aspect_Discard_Names                => Optional,
                         Aspect_External_Tag                 => Expression,
@@ -124,20 +120,18 @@ package Aspects is
                         Aspect_Inline_Always                => Optional,
                         Aspect_Invariant                    => Expression,
                         Aspect_Machine_Radix                => Expression,
+                        Aspect_No_Return                    => Optional,
                         Aspect_Object_Size                  => Expression,
-                        Aspect_Pack                         => Optional,
                         Aspect_Persistent_BSS               => Optional,
+                        Aspect_Pack                         => Optional,
                         Aspect_Post                         => Expression,
-                        Aspect_Postcondition                => Expression,
                         Aspect_Pre                          => Expression,
-                        Aspect_Precondition                 => Expression,
                         Aspect_Predicate                    => Expression,
                         Aspect_Preelaborable_Initialization => Optional,
-                        Aspect_Psect_Object                 => Optional,
                         Aspect_Pure_Function                => Optional,
                         Aspect_Shared                       => Optional,
                         Aspect_Size                         => Expression,
-                        Aspect_Storage_Pool                 => Expression,
+                        Aspect_Storage_Pool                 => Name,
                         Aspect_Storage_Size                 => Expression,
                         Aspect_Stream_Size                  => Expression,
                         Aspect_Suppress                     => Name,
@@ -151,11 +145,50 @@ package Aspects is
                         Aspect_Value_Size                   => Expression,
                         Aspect_Volatile                     => Optional,
                         Aspect_Volatile_Components          => Optional,
-                        Aspect_Warnings                     => Name,
-                        Aspect_Weak_External                => Optional);
+                        Aspect_Warnings                     => Name);
 
    function Get_Aspect_Id (Name : Name_Id) return Aspect_Id;
+   pragma Inline (Get_Aspect_Id);
    --  Given a name Nam, returns the corresponding aspect id value. If the name
    --  does not match any aspect, then No_Aspect is returned as the result.
 
+   ---------------------------------------------------
+   -- Handling of Aspect Specifications in the Tree --
+   ---------------------------------------------------
+
+   --  Several kinds of declaration node permit aspect specifications in Ada
+   --  2012 mode. If there was room in all the corresponding declaration nodes,
+   --  we could just have a field Aspect_Specifications pointing to a list of
+   --  nodes for the aspects (N_Aspect_Specification nodes). But there isn't
+   --  room, so we adopt a different approach.
+
+   --  The following subprograms provide access to a specialized interface
+   --  implemented internally with a hash table in the body, that provides
+   --  access to aspect specifications.
+
+   function Permits_Aspect_Specifications (N : Node_Id) return Boolean;
+   --  Returns True if the node N is a declaration node that permits aspect
+   --  specifications. All such nodes have the Has_Aspect_Specifications
+   --  flag defined. Returns False for all other nodes.
+
+   function Aspect_Specifications (N : Node_Id) return List_Id;
+   --  Given a node N, returns the list of N_Aspect_Specification nodes that
+   --  are attached to this declaration node. If the node is in the class of
+   --  declaration nodes that permit aspect specifications, as defined by the
+   --  predicate above, and if their Has_Aspect_Specifications flag is set to
+   --  True, then this will always be a non-empty list. If this flag is set to
+   --  False, or the node is not in the declaration class permitting aspect
+   --  specifications, then No_List is returned.
+
+   procedure Set_Aspect_Specifications (N : Node_Id; L : List_Id);
+   --  The node N must be in the class of declaration nodes that permit aspect
+   --  specifications and the Has_Aspect_Specifications flag must be False on
+   --  entry. L must be a non-empty list of N_Aspect_Specification nodes. This
+   --  procedure sets the Has_Aspect_Specifications flag to True, and makes an
+   --  entry that can be retrieved by a subsequent Aspect_Specifications call.
+   --  The parent of list L is set to reference the declaration node N. It is
+   --  an error to call this procedure with a node that does not permit aspect
+   --  specifications, or a node that has its Has_Aspect_Specifications flag
+   --  set True on entry, or with L being an empty list or No_List.
+
 end Aspects;
Index: sem_ch6.adb
===================================================================
--- sem_ch6.adb	(revision 165295)
+++ sem_ch6.adb	(working copy)
@@ -23,6 +23,7 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
+with Aspects;  use Aspects;
 with Atree;    use Atree;
 with Checks;   use Checks;
 with Debug;    use Debug;
@@ -59,6 +60,7 @@ with Sem_Ch5;  use Sem_Ch5;
 with Sem_Ch8;  use Sem_Ch8;
 with Sem_Ch10; use Sem_Ch10;
 with Sem_Ch12; use Sem_Ch12;
+with Sem_Ch13; use Sem_Ch13;
 with Sem_Disp; use Sem_Disp;
 with Sem_Dist; use Sem_Dist;
 with Sem_Elim; use Sem_Elim;
@@ -352,6 +354,7 @@ package body Sem_Ch6 is
       Designator : constant Entity_Id :=
                      Analyze_Subprogram_Specification (Specification (N));
       Scop       : constant Entity_Id := Current_Scope;
+      AS         : constant List_Id   := Aspect_Specifications (N);
 
    begin
       Generate_Definition (Designator);
@@ -381,6 +384,7 @@ package body Sem_Ch6 is
 
       Generate_Reference_To_Formals (Designator);
       Check_Eliminated (Designator);
+      Analyze_Aspect_Specifications (N, Designator, AS);
    end Analyze_Abstract_Subprogram_Declaration;
 
    ----------------------------------------
@@ -2696,9 +2700,10 @@ package body Sem_Ch6 is
 
    procedure Analyze_Subprogram_Declaration (N : Node_Id) is
       Loc        : constant Source_Ptr := Sloc (N);
+      AS         : constant List_Id    := Aspect_Specifications (N);
+      Scop       : constant Entity_Id  := Current_Scope;
       Designator : Entity_Id;
       Form       : Node_Id;
-      Scop       : constant Entity_Id := Current_Scope;
       Null_Body  : Node_Id := Empty;
 
    --  Start of processing for Analyze_Subprogram_Declaration
@@ -2891,6 +2896,8 @@ package body Sem_Ch6 is
          Write_Location (Sloc (N));
          Write_Eol;
       end if;
+
+      Analyze_Aspect_Specifications (N, Designator, AS);
    end Analyze_Subprogram_Declaration;
 
    --------------------------------------
@@ -8334,20 +8341,19 @@ package body Sem_Ch6 is
                      if Is_Tagged_Type (Formal_Type) then
                         null;
 
-                     elsif Nkind_In (Parent (Parent (T)),
-                        N_Accept_Statement,
-                        N_Entry_Body,
-                        N_Subprogram_Body)
+                     elsif Nkind_In (Parent (Parent (T)), N_Accept_Statement,
+                                                          N_Entry_Body,
+                                                          N_Subprogram_Body)
                      then
                         Error_Msg_NE
                           ("invalid use of untagged incomplete type&",
-                             Ptype, Formal_Type);
+                           Ptype, Formal_Type);
                      end if;
 
                   else
                      Error_Msg_NE
                        ("invalid use of incomplete type&",
-                          Param_Spec, Formal_Type);
+                        Param_Spec, Formal_Type);
 
                      --  Further checks on the legality of incomplete types
                      --  in formal parts are delayed until the freeze point
@@ -8356,8 +8362,9 @@ package body Sem_Ch6 is
                end if;
 
             elsif Ekind (Formal_Type) = E_Void then
-               Error_Msg_NE ("premature use of&",
-                 Parameter_Type (Param_Spec), Formal_Type);
+               Error_Msg_NE
+                 ("premature use of&",
+                  Parameter_Type (Param_Spec), Formal_Type);
             end if;
 
             --  Ada 2005 (AI-231): Create and decorate an internal subtype
@@ -8378,8 +8385,7 @@ package body Sem_Ch6 is
                   then
                      Error_Msg_NE
                        ("`NOT NULL` not allowed (& already excludes null)",
-                        Param_Spec,
-                        Formal_Type);
+                        Param_Spec, Formal_Type);
                   end if;
 
                   Formal_Type :=
Index: sem_ch11.adb
===================================================================
--- sem_ch11.adb	(revision 165256)
+++ sem_ch11.adb	(working copy)
@@ -23,6 +23,7 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
+with Aspects;  use Aspects;
 with Atree;    use Atree;
 with Checks;   use Checks;
 with Einfo;    use Einfo;
@@ -39,6 +40,7 @@ with Rtsfind;  use Rtsfind;
 with Sem;      use Sem;
 with Sem_Ch5;  use Sem_Ch5;
 with Sem_Ch8;  use Sem_Ch8;
+with Sem_Ch13; use Sem_Ch13;
 with Sem_Res;  use Sem_Res;
 with Sem_Util; use Sem_Util;
 with Sem_Warn; use Sem_Warn;
@@ -55,6 +57,7 @@ package body Sem_Ch11 is
    procedure Analyze_Exception_Declaration (N : Node_Id) is
       Id : constant Entity_Id := Defining_Identifier (N);
       PF : constant Boolean   := Is_Pure (Current_Scope);
+      AS : constant List_Id   := Aspect_Specifications (N);
    begin
       Generate_Definition         (Id);
       Enter_Name                  (Id);
@@ -63,6 +66,7 @@ package body Sem_Ch11 is
       Set_Etype                   (Id, Standard_Exception_Type);
       Set_Is_Statically_Allocated (Id);
       Set_Is_Pure                 (Id, PF);
+      Analyze_Aspect_Specifications (N, Id, AS);
    end Analyze_Exception_Declaration;
 
    --------------------------------
Index: sem_cat.adb
===================================================================
--- sem_cat.adb	(revision 165283)
+++ sem_cat.adb	(working copy)
@@ -1754,8 +1754,8 @@ package body Sem_Cat is
    --  Start of processing for Validate_Remote_Access_Object_Type_Declaration
 
    begin
-      --  We are called from Analyze_Type_Declaration, and the Nkind of the
-      --  given node is N_Access_To_Object_Definition.
+      --  We are called from Analyze_Full_Type_Declaration, and the Nkind of
+      --  the given node is N_Access_To_Object_Definition.
 
       if not Comes_From_Source (T)
         or else (not In_RCI_Declaration (Parent (T))
@@ -2055,7 +2055,7 @@ package body Sem_Cat is
    --  Start of processing for Validate_SP_Access_Object_Type_Decl
 
    begin
-      --  We are called from Sem_Ch3.Analyze_Type_Declaration, and the
+      --  We are called from Sem_Ch3.Analyze_Full_Type_Declaration, and the
       --  Nkind of the given entity is N_Access_To_Object_Definition.
 
       if not Comes_From_Source (T)
Index: sprint.adb
===================================================================
--- sprint.adb	(revision 165281)
+++ sprint.adb	(working copy)
@@ -23,6 +23,7 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
+with Aspects;  use Aspects;
 with Atree;    use Atree;
 with Casing;   use Casing;
 with Csets;    use Csets;
@@ -182,6 +183,12 @@ package body Sprint is
    procedure Sprint_And_List (List : List_Id);
    --  Print the given list with items separated by vertical "and"
 
+   procedure Sprint_Aspect_Specifications (Node : Node_Id);
+   --  Node is a declaration node that accepts aspect specifications. This
+   --  procedure tests if aspect specifications are present, and if so prints
+   --  them, with a terminating semicolon. If no aspect specifications are
+   --  present, then a single semicolon is output.
+
    procedure Sprint_Bar_List (List : List_Id);
    --  Print the given list with items separated by vertical bars
 
@@ -619,6 +626,48 @@ package body Sprint is
       end if;
    end Sprint_And_List;
 
+   ----------------------------------
+   -- Sprint_Aspect_Specifications --
+   ----------------------------------
+
+   procedure Sprint_Aspect_Specifications (Node : Node_Id) is
+      AS : List_Id;
+      A  : Node_Id;
+
+   begin
+      if Has_Aspect_Specifications (Node) then
+         AS := Aspect_Specifications (Node);
+         Indent := Indent + 2;
+         Write_Indent;
+         Write_Str ("with ");
+         Indent := Indent + 5;
+
+         A := First (AS);
+         loop
+            Sprint_Node (Identifier (A));
+
+            if Class_Present (A) then
+               Write_Str ("'Class");
+            end if;
+
+            if Present (Expression (A)) then
+               Write_Str (" => ");
+               Sprint_Node (Expression (A));
+            end if;
+
+            Next (A);
+
+            exit when No (A);
+            Write_Char (',');
+            Write_Indent;
+         end loop;
+
+         Indent := Indent - 7;
+      end if;
+
+      Write_Char (';');
+   end Sprint_Aspect_Specifications;
+
    ---------------------
    -- Sprint_Bar_List --
    ---------------------
@@ -815,7 +864,8 @@ package body Sprint is
             Write_Indent;
             Sprint_Node (Specification (Node));
             Write_Str_With_Col_Check (" is ");
-            Write_Str_Sloc ("abstract;");
+            Write_Str_Sloc ("abstract");
+            Sprint_Aspect_Specifications (Node);
 
          when N_Accept_Alternative =>
             Sprint_Node_List (Pragmas_Before (Node));
@@ -1224,7 +1274,7 @@ package body Sprint is
                   Sprint_Node (Expression (Node));
                end if;
 
-               Write_Char (';');
+               Sprint_Aspect_Specifications (Node);
             end if;
 
          when N_Component_List =>
@@ -1453,7 +1503,7 @@ package body Sprint is
             end if;
 
             Write_Param_Specs (Node);
-            Write_Char (';');
+            Sprint_Aspect_Specifications (Node);
 
          when N_Entry_Index_Specification =>
             Write_Str_With_Col_Check_Sloc ("for ");
@@ -1499,7 +1549,7 @@ package body Sprint is
                   Sprint_Node (Expression (Node));
                end if;
 
-               Write_Char (';');
+               Sprint_Aspect_Specifications (Node);
             end if;
 
          when N_Exception_Handler =>
@@ -1625,7 +1675,7 @@ package body Sprint is
                Sprint_Node (Default_Name (Node));
             end if;
 
-            Write_Char (';');
+            Sprint_Aspect_Specifications (Node);
 
          when N_Formal_Concrete_Subprogram_Declaration =>
             Write_Indent_Str_Sloc ("with ");
@@ -1638,7 +1688,7 @@ package body Sprint is
                Sprint_Node (Default_Name (Node));
             end if;
 
-            Write_Char (';');
+            Sprint_Aspect_Specifications (Node);
 
          when N_Formal_Discrete_Type_Definition =>
             Write_Str_With_Col_Check_Sloc ("<>");
@@ -1686,7 +1736,7 @@ package body Sprint is
                   Sprint_Node (Default_Expression (Node));
                end if;
 
-               Write_Char (';');
+               Sprint_Aspect_Specifications (Node);
             end if;
 
          when N_Formal_Ordinary_Fixed_Point_Definition =>
@@ -1697,7 +1747,8 @@ package body Sprint is
             Write_Id (Defining_Identifier (Node));
             Write_Str_With_Col_Check (" is new ");
             Sprint_Node (Name (Node));
-            Write_Str_With_Col_Check (" (<>);");
+            Write_Str_With_Col_Check (" (<>)");
+            Sprint_Aspect_Specifications (Node);
 
          when N_Formal_Private_Type_Definition =>
             if Abstract_Present (Node) then
@@ -1729,7 +1780,7 @@ package body Sprint is
 
             Write_Str_With_Col_Check (" is ");
             Sprint_Node (Formal_Type_Definition (Node));
-            Write_Char (';');
+            Sprint_Aspect_Specifications (Node);
 
          when N_Free_Statement =>
             Write_Indent_Str_Sloc ("free ");
@@ -1770,7 +1821,7 @@ package body Sprint is
             Write_Discr_Specs (Node);
             Write_Str_With_Col_Check (" is ");
             Sprint_Node (Type_Definition (Node));
-            Write_Char (';');
+            Sprint_Aspect_Specifications (Node);
 
          when N_Function_Call =>
             Set_Debug_Sloc;
@@ -1783,7 +1834,7 @@ package body Sprint is
             Write_Str_With_Col_Check (" is new ");
             Sprint_Node (Name (Node));
             Sprint_Opt_Paren_Comma_List (Generic_Associations (Node));
-            Write_Char (';');
+            Sprint_Aspect_Specifications (Node);
 
          when N_Function_Specification =>
             Write_Str_With_Col_Check_Sloc ("function ");
@@ -1824,7 +1875,7 @@ package body Sprint is
             Sprint_Indented_List (Generic_Formal_Declarations (Node));
             Write_Indent;
             Sprint_Node (Specification (Node));
-            Write_Char (';');
+            Sprint_Aspect_Specifications (Node);
 
          when N_Generic_Package_Renaming_Declaration =>
             Write_Indent_Str_Sloc ("generic package ");
@@ -1846,7 +1897,7 @@ package body Sprint is
             Sprint_Indented_List (Generic_Formal_Declarations (Node));
             Write_Indent;
             Sprint_Node (Specification (Node));
-            Write_Char (';');
+            Sprint_Aspect_Specifications (Node);
 
          when N_Goto_Statement =>
             Write_Indent_Str_Sloc ("goto ");
@@ -2077,7 +2128,7 @@ package body Sprint is
                      Sprint_Node (Expression (Node));
                   end if;
 
-                  Write_Char (';');
+                  Sprint_Aspect_Specifications (Node);
 
                   --  Handle implicit importation and implicit exportation of
                   --  object declarations:
@@ -2318,7 +2369,7 @@ package body Sprint is
             Extra_Blank_Line;
             Write_Indent;
             Sprint_Node_Sloc (Specification (Node));
-            Write_Char (';');
+            Sprint_Aspect_Specifications (Node);
 
          when N_Package_Instantiation =>
             Extra_Blank_Line;
@@ -2327,7 +2378,7 @@ package body Sprint is
             Write_Str (" is new ");
             Sprint_Node (Name (Node));
             Sprint_Opt_Paren_Comma_List (Generic_Associations (Node));
-            Write_Char (';');
+            Sprint_Aspect_Specifications (Node);
 
          when N_Package_Renaming_Declaration =>
             Write_Indent_Str_Sloc ("package ");
@@ -2410,6 +2461,50 @@ package body Sprint is
          when N_Pop_Storage_Error_Label =>
             Write_Indent_Str ("%pop_storage_error_label");
 
+         when N_Private_Extension_Declaration =>
+            Write_Indent_Str_Sloc ("type ");
+            Write_Id (Defining_Identifier (Node));
+
+            if Present (Discriminant_Specifications (Node)) then
+               Write_Discr_Specs (Node);
+            elsif Unknown_Discriminants_Present (Node) then
+               Write_Str_With_Col_Check ("(<>)");
+            end if;
+
+            Write_Str_With_Col_Check (" is new ");
+            Sprint_Node (Subtype_Indication (Node));
+
+            if Present (Interface_List (Node)) then
+               Write_Str_With_Col_Check (" and ");
+               Sprint_And_List (Interface_List (Node));
+            end if;
+
+            Write_Str_With_Col_Check (" with private");
+            Sprint_Aspect_Specifications (Node);
+
+         when N_Private_Type_Declaration =>
+            Write_Indent_Str_Sloc ("type ");
+            Write_Id (Defining_Identifier (Node));
+
+            if Present (Discriminant_Specifications (Node)) then
+               Write_Discr_Specs (Node);
+            elsif Unknown_Discriminants_Present (Node) then
+               Write_Str_With_Col_Check ("(<>)");
+            end if;
+
+            Write_Str (" is ");
+
+            if Tagged_Present (Node) then
+               Write_Str_With_Col_Check ("tagged ");
+            end if;
+
+            if Limited_Present (Node) then
+               Write_Str_With_Col_Check ("limited ");
+            end if;
+
+            Write_Str_With_Col_Check ("private");
+            Sprint_Aspect_Specifications (Node);
+
          when N_Push_Constraint_Error_Label =>
             Write_Indent_Str ("%push_constraint_error_label (");
 
@@ -2458,48 +2553,6 @@ package body Sprint is
 
             Sprint_Node (Expression (Node));
 
-         when N_Private_Type_Declaration =>
-            Write_Indent_Str_Sloc ("type ");
-            Write_Id (Defining_Identifier (Node));
-
-            if Present (Discriminant_Specifications (Node)) then
-               Write_Discr_Specs (Node);
-            elsif Unknown_Discriminants_Present (Node) then
-               Write_Str_With_Col_Check ("(<>)");
-            end if;
-
-            Write_Str (" is ");
-
-            if Tagged_Present (Node) then
-               Write_Str_With_Col_Check ("tagged ");
-            end if;
-
-            if Limited_Present (Node) then
-               Write_Str_With_Col_Check ("limited ");
-            end if;
-
-            Write_Str_With_Col_Check ("private;");
-
-         when N_Private_Extension_Declaration =>
-            Write_Indent_Str_Sloc ("type ");
-            Write_Id (Defining_Identifier (Node));
-
-            if Present (Discriminant_Specifications (Node)) then
-               Write_Discr_Specs (Node);
-            elsif Unknown_Discriminants_Present (Node) then
-               Write_Str_With_Col_Check ("(<>)");
-            end if;
-
-            Write_Str_With_Col_Check (" is new ");
-            Sprint_Node (Subtype_Indication (Node));
-
-            if Present (Interface_List (Node)) then
-               Write_Str_With_Col_Check (" and ");
-               Sprint_And_List (Interface_List (Node));
-            end if;
-
-            Write_Str_With_Col_Check (" with private;");
-
          when N_Procedure_Call_Statement =>
             Write_Indent;
             Set_Debug_Sloc;
@@ -2513,7 +2566,7 @@ package body Sprint is
             Write_Str_With_Col_Check (" is new ");
             Sprint_Node (Name (Node));
             Sprint_Opt_Paren_Comma_List (Generic_Associations (Node));
-            Write_Char (';');
+            Sprint_Aspect_Specifications (Node);
 
          when N_Procedure_Specification =>
             Write_Str_With_Col_Check_Sloc ("procedure ");
@@ -2560,7 +2613,7 @@ package body Sprint is
 
             Sprint_Node (Protected_Definition (Node));
             Write_Id (Defining_Identifier (Node));
-            Write_Char (';');
+            Sprint_Aspect_Specifications (Node);
 
          when N_Qualified_Expression =>
             Sprint_Node (Subtype_Mark (Node));
@@ -2756,7 +2809,7 @@ package body Sprint is
             Write_Str (" is");
             Sprint_Node (Protected_Definition (Node));
             Write_Id (Defining_Identifier (Node));
-            Write_Char (';');
+            Sprint_Aspect_Specifications (Node);
 
          when N_Single_Task_Declaration =>
             Write_Indent_Str_Sloc ("task ");
@@ -2767,7 +2820,7 @@ package body Sprint is
                Sprint_Node (Task_Definition (Node));
             end if;
 
-            Write_Char (';');
+            Sprint_Aspect_Specifications (Node);
 
          when N_Selected_Component =>
             Sprint_Node (Prefix (Node));
@@ -2840,7 +2893,7 @@ package body Sprint is
                Write_Str_With_Col_Check (" is null");
             end if;
 
-            Write_Char (';');
+            Sprint_Aspect_Specifications (Node);
 
          when N_Subprogram_Info =>
             Sprint_Node (Identifier (Node));
@@ -2865,7 +2918,7 @@ package body Sprint is
             end if;
 
             Sprint_Node (Subtype_Indication (Node));
-            Write_Char (';');
+            Sprint_Aspect_Specifications (Node);
 
          when N_Subtype_Indication =>
             Sprint_Node_Sloc (Subtype_Mark (Node));
@@ -2928,11 +2981,10 @@ package body Sprint is
                Sprint_Node (Task_Definition (Node));
             end if;
 
-            Write_Char (';');
+            Sprint_Aspect_Specifications (Node);
 
          when N_Terminate_Alternative =>
             Sprint_Node_List (Pragmas_Before (Node));
-
             Write_Indent;
 
             if Present (Condition (Node)) then
Index: sem_ch13.adb
===================================================================
--- sem_ch13.adb	(revision 165283)
+++ sem_ch13.adb	(working copy)
@@ -23,6 +23,7 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
+with Aspects;  use Aspects;
 with Atree;    use Atree;
 with Checks;   use Checks;
 with Einfo;    use Einfo;
@@ -618,6 +619,217 @@ package body Sem_Ch13 is
       end if;
    end Alignment_Check_For_Esize_Change;
 
+   -----------------------------------
+   -- Analyze_Aspect_Specifications --
+   -----------------------------------
+
+   procedure Analyze_Aspect_Specifications
+     (N : Node_Id;
+      E : Entity_Id;
+      L : List_Id)
+   is
+      Aspect : Node_Id;
+      Ent    : Node_Id;
+      Result : Boolean;
+      Ritem  : Node_Id;
+
+      Ins_Node : Node_Id := N;
+      --  Insert pragmas after this node
+
+   begin
+      if L = No_List then
+         return;
+      end if;
+
+      Aspect := First (L);
+      while Present (Aspect) loop
+         declare
+            Id   : constant Node_Id  := Identifier (Aspect);
+            Expr : constant Node_Id  := Expression (Aspect);
+            Nam  : constant Name_Id  := Chars (Id);
+            Anod : Node_Id;
+
+         begin
+            --  Check for duplicate aspect
+
+            Anod := First (L);
+            while Anod /= Aspect loop
+               if Nam = Chars (Identifier (Anod)) then
+                  Error_Msg_Name_1 := Nam;
+                  Error_Msg_Sloc := Sloc (Anod);
+                  Error_Msg_NE
+                    ("aspect% for & ignored, already given at#", Id, E);
+                  goto Continue;
+               end if;
+
+               Next (Anod);
+            end loop;
+
+            --  Processing based on specific aspect
+
+            case Get_Aspect_Id (Nam) is
+
+               --  No_Aspect should be impossible
+
+               when No_Aspect =>
+                  raise Program_Error;
+
+                  --  Aspects taking an optional boolean argument. For all of
+                  --  these we just create a matching pragma and insert it,
+                  --  setting flag Cancel_Aspect if the expression is False.
+
+               when Aspect_Ada_2005                     |
+                    Aspect_Ada_2012                     |
+                    Aspect_Atomic                       |
+                    Aspect_Atomic_Components            |
+                    Aspect_Discard_Names                |
+                    Aspect_Favor_Top_Level              |
+                    Aspect_Inline                       |
+                    Aspect_Inline_Always                |
+                    Aspect_No_Return                    |
+                    Aspect_Pack                         |
+                    Aspect_Persistent_BSS               |
+                    Aspect_Preelaborable_Initialization |
+                    Aspect_Pure_Function                |
+                    Aspect_Shared                       |
+                    Aspect_Suppress_Debug_Info          |
+                    Aspect_Unchecked_Union              |
+                    Aspect_Universal_Aliasing           |
+                    Aspect_Unmodified                   |
+                    Aspect_Unreferenced                 |
+                    Aspect_Unreferenced_Objects         |
+                    Aspect_Volatile                     |
+                    Aspect_Volatile_Components          =>
+
+                  if No (Expr) then
+                     Result := True;
+
+                  else
+                     Analyze_And_Resolve (Expr);
+
+                     if not Is_OK_Static_Expression (Expr) then
+                        Error_Msg_N
+                          ("static boolean expression required here", Expr);
+                        Result := True;
+
+                     else
+                        Result := Is_True (Expr_Value (Expr));
+                     end if;
+                  end if;
+
+                  Ent := New_Occurrence_Of (E, Sloc (Id));
+
+                  Ritem :=
+                    Make_Pragma (Sloc (Aspect),
+                      Pragma_Argument_Associations => New_List (Ent),
+                      Pragma_Identifier            =>
+                         Make_Identifier (Sloc (Id), Chars (Id)));
+
+                  if Result = False then
+                     Set_Aspect_Cancel (Ritem);
+                  end if;
+
+               --  Aspects corresponding to attribute definition clauses. We
+               --  create the matching clause and insert it following the
+               --  declaration in the tree.
+
+               when Aspect_Address        |
+                    Aspect_Alignment      |
+                    Aspect_Bit_Order      |
+                    Aspect_Component_Size |
+                    Aspect_External_Tag   |
+                    Aspect_Machine_Radix  |
+                    Aspect_Object_Size    |
+                    Aspect_Size           |
+                    Aspect_Storage_Pool   |
+                    Aspect_Storage_Size   |
+                    Aspect_Stream_Size    |
+                    Aspect_Value_Size     =>
+
+                  Ritem :=
+                    Make_Attribute_Definition_Clause (Sloc (Aspect),
+                      Name       => New_Occurrence_Of (E, Sloc (Id)),
+                      Chars      => Chars (Id),
+                      Expression => Relocate_Node (Expr));
+
+               --  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.
+
+               when Aspect_Suppress   |
+                    Aspect_Unsuppress =>
+
+                  Ritem :=
+                    Make_Pragma (Sloc (Aspect),
+                      Pragma_Argument_Associations => New_List (
+                        New_Occurrence_Of (E, Sloc (Expr)),
+                        Relocate_Node (Expr)),
+                      Pragma_Identifier            =>
+                         Make_Identifier (Sloc (Id), Chars (Id)));
+
+               --  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_Warnings =>
+
+                  Ritem :=
+                    Make_Pragma (Sloc (Aspect),
+                      Pragma_Argument_Associations => New_List (
+                        Relocate_Node (Expr),
+                        New_Occurrence_Of (E, Sloc (Expr))),
+                      Pragma_Identifier            =>
+                         Make_Identifier (Sloc (Id), Chars (Id)));
+
+               --  Aspect Post corresponds to pragma Postcondition with single
+               --  argument that is the expression (we never give a message
+               --  argument. This is inserted right after the declaration, to
+               --  to get the required pragma placement.
+
+               when Aspect_Post =>
+
+                  Insert_After (N,
+                    Make_Pragma (Sloc (Expr),
+                      Pragma_Argument_Associations => New_List (
+                        Relocate_Node (Expr)),
+                      Pragma_Identifier            =>
+                         Make_Identifier (Sloc (Id), Name_Postcondition)));
+                  goto Continue;
+
+               --  Aspect Pre corresponds to pragma Precondition with single
+               --  argument that is the expression (we never give a message
+               --  argument. This is inserted right after the declaration, to
+               --  get the required pragma placement.
+
+               when Aspect_Pre =>
+
+                  Insert_After (N,
+                    Make_Pragma (Sloc (Expr),
+                      Pragma_Argument_Associations => New_List (
+                        Relocate_Node (Expr)),
+                      Pragma_Identifier            =>
+                        Make_Identifier (Sloc (Id), Name_Precondition)));
+                  goto Continue;
+
+               --  Aspects currently unimplemented
+
+               when Aspect_Invariant |
+                    Aspect_Predicate =>
+
+                  Error_Msg_N ("aspect& not implemented", Identifier (Aspect));
+                  goto Continue;
+            end case;
+
+            Set_From_Aspect_Specification (Ritem);
+            Insert_After (Ins_Node, Ritem);
+            Ins_Node := Ritem;
+         end;
+
+         <<Continue>>
+            Next (Aspect);
+      end loop;
+   end Analyze_Aspect_Specifications;
+
    -----------------------
    -- Analyze_At_Clause --
    -----------------------
@@ -684,6 +896,12 @@ package body Sem_Ch13 is
       --  Common processing for 'Read, 'Write, 'Input and 'Output attribute
       --  definition clauses.
 
+      function Duplicate_Clause return Boolean;
+      --  This routine checks if the aspect for U_Ent being given by attribute
+      --  definition clause N is for an aspect that has already been specified,
+      --  and if so gives an error message. If there is a duplicate, True is
+      --  returned, otherwise if there is no error, False is returned.
+
       -----------------------------------
       -- Analyze_Stream_TSS_Definition --
       -----------------------------------
@@ -820,6 +1038,40 @@ package body Sem_Ch13 is
          end if;
       end Analyze_Stream_TSS_Definition;
 
+      ----------------------
+      -- Duplicate_Clause --
+      ----------------------
+
+      function Duplicate_Clause return Boolean is
+         A   : constant Node_Id :=
+                 Get_Attribute_Definition_Clause
+                   (U_Ent, Get_Attribute_Id (Chars (N)));
+
+      begin
+         --  Nothing to do if this attribute definition clause comes from an
+         --  aspect specification, since we could not be duplicating an
+         --  explicit clause, and we dealt with the case of duplicated aspects
+         --  in Analyze_Aspect_Specifications.
+
+         if From_Aspect_Specification (N) then
+            return False;
+         end if;
+
+         --  Otherwise current pragma may duplicate previous pragma or a
+         --  previously given aspect specification for the same pragma.
+
+         if Present (A) then
+            if Entity (A) = U_Ent then
+               Error_Msg_Name_1 := Chars (N);
+               Error_Msg_Sloc := Sloc (A);
+               Error_Msg_NE ("aspect% for & previously specified#", N, U_Ent);
+               return True;
+            end if;
+         end if;
+
+         return False;
+      end Duplicate_Clause;
+
    --  Start of processing for Analyze_Attribute_Definition_Clause
 
    begin
@@ -928,6 +1180,8 @@ package body Sem_Ch13 is
          return;
       end if;
 
+      Set_Entity (N, U_Ent);
+
       --  Switch on particular attribute
 
       case Id is
@@ -969,8 +1223,8 @@ package body Sem_Ch13 is
                return;
             end if;
 
-            if Present (Address_Clause (U_Ent)) then
-               Error_Msg_N ("address already given for &", Nam);
+            if Duplicate_Clause then
+               null;
 
             --  Case of address clause for subprogram
 
@@ -1235,9 +1489,8 @@ package body Sem_Ch13 is
             then
                Error_Msg_N ("alignment cannot be given for &", Nam);
 
-            elsif Has_Alignment_Clause (U_Ent) then
-               Error_Msg_Sloc := Sloc (Alignment_Clause (U_Ent));
-               Error_Msg_N ("alignment clause previously given#", N);
+            elsif Duplicate_Clause then
+               null;
 
             elsif Align /= No_Uint then
                Set_Has_Alignment_Clause (U_Ent);
@@ -1266,6 +1519,9 @@ package body Sem_Ch13 is
                Error_Msg_N
                  ("Bit_Order can only be defined for record type", Nam);
 
+            elsif Duplicate_Clause then
+               null;
+
             else
                Analyze_And_Resolve (Expr, RTE (RE_Bit_Order));
 
@@ -1307,9 +1563,8 @@ package body Sem_Ch13 is
             Btype := Base_Type (U_Ent);
             Ctyp := Component_Type (Btype);
 
-            if Has_Component_Size_Clause (Btype) then
-               Error_Msg_N
-                 ("component size clause for& previously given", Nam);
+            if Duplicate_Clause then
+               null;
 
             elsif Rep_Item_Too_Early (Btype, N) then
                null;
@@ -1391,28 +1646,33 @@ package body Sem_Ch13 is
                Error_Msg_N ("should be a tagged type", Nam);
             end if;
 
-            Analyze_And_Resolve (Expr, Standard_String);
-
-            if not Is_Static_Expression (Expr) then
-               Flag_Non_Static_Expr
-                 ("static string required for tag name!", Nam);
-            end if;
+            if Duplicate_Clause then
+               null;
 
-            if VM_Target = No_VM then
-               Set_Has_External_Tag_Rep_Clause (U_Ent);
             else
-               Error_Msg_Name_1 := Attr;
-               Error_Msg_N
-                 ("% attribute unsupported in this configuration", Nam);
-            end if;
+               Analyze_And_Resolve (Expr, Standard_String);
 
-            if not Is_Library_Level_Entity (U_Ent) then
-               Error_Msg_NE
-                 ("?non-unique external tag supplied for &", N, U_Ent);
-               Error_Msg_N
-                 ("?\same external tag applies to all subprogram calls", N);
-               Error_Msg_N
-                 ("?\corresponding internal tag cannot be obtained", N);
+               if not Is_Static_Expression (Expr) then
+                  Flag_Non_Static_Expr
+                    ("static string required for tag name!", Nam);
+               end if;
+
+               if VM_Target = No_VM then
+                  Set_Has_External_Tag_Rep_Clause (U_Ent);
+               else
+                  Error_Msg_Name_1 := Attr;
+                  Error_Msg_N
+                    ("% attribute unsupported in this configuration", Nam);
+               end if;
+
+               if not Is_Library_Level_Entity (U_Ent) then
+                  Error_Msg_NE
+                    ("?non-unique external tag supplied for &", N, U_Ent);
+                  Error_Msg_N
+                    ("?\same external tag applies to all subprogram calls", N);
+                  Error_Msg_N
+                    ("?\corresponding internal tag cannot be obtained", N);
+               end if;
             end if;
          end External_Tag;
 
@@ -1437,9 +1697,8 @@ package body Sem_Ch13 is
             if not Is_Decimal_Fixed_Point_Type (U_Ent) then
                Error_Msg_N ("decimal fixed-point type expected for &", Nam);
 
-            elsif Has_Machine_Radix_Clause (U_Ent) then
-               Error_Msg_Sloc := Sloc (Alignment_Clause (U_Ent));
-               Error_Msg_N ("machine radix clause previously given#", N);
+            elsif Duplicate_Clause then
+               null;
 
             elsif Radix /= No_Uint then
                Set_Has_Machine_Radix_Clause (U_Ent);
@@ -1471,8 +1730,8 @@ package body Sem_Ch13 is
             if not Is_Type (U_Ent) then
                Error_Msg_N ("Object_Size cannot be given for &", Nam);
 
-            elsif Has_Object_Size_Clause (U_Ent) then
-               Error_Msg_N ("Object_Size already given for &", Nam);
+            elsif Duplicate_Clause then
+               null;
 
             else
                Check_Size (Expr, U_Ent, Size, Biased);
@@ -1526,8 +1785,8 @@ package body Sem_Ch13 is
          begin
             FOnly := True;
 
-            if Has_Size_Clause (U_Ent) then
-               Error_Msg_N ("size already given for &", Nam);
+            if Duplicate_Clause then
+               null;
 
             elsif not Is_Type (U_Ent)
               and then Ekind (U_Ent) /= E_Variable
@@ -1709,8 +1968,7 @@ package body Sem_Ch13 is
                  ("storage pool cannot be given for a derived access type",
                   Nam);
 
-            elsif Has_Storage_Size_Clause (U_Ent) then
-               Error_Msg_N ("storage size already given for &", Nam);
+            elsif Duplicate_Clause then
                return;
 
             elsif Present (Associated_Storage_Pool (U_Ent)) then
@@ -1839,8 +2097,8 @@ package body Sem_Ch13 is
                  ("storage size cannot be given for a derived access type",
                   Nam);
 
-            elsif Has_Storage_Size_Clause (Btype) then
-               Error_Msg_N ("storage size already given for &", Nam);
+            elsif Duplicate_Clause then
+               null;
 
             else
                Analyze_And_Resolve (Expr, Any_Integer);
@@ -1884,8 +2142,8 @@ package body Sem_Ch13 is
                Check_Restriction (No_Implementation_Attributes, N);
             end if;
 
-            if Has_Stream_Size_Clause (U_Ent) then
-               Error_Msg_N ("Stream_Size already given for &", Nam);
+            if Duplicate_Clause then
+               null;
 
             elsif Is_Elementary_Type (U_Ent) then
                if Size /= System_Storage_Unit
@@ -1929,11 +2187,8 @@ package body Sem_Ch13 is
             if not Is_Type (U_Ent) then
                Error_Msg_N ("Value_Size cannot be given for &", Nam);
 
-            elsif Present
-                   (Get_Attribute_Definition_Clause
-                     (U_Ent, Attribute_Value_Size))
-            then
-               Error_Msg_N ("Value_Size already given for &", Nam);
+            elsif Duplicate_Clause then
+               null;
 
             elsif Is_Array_Type (U_Ent)
               and then not Is_Constrained (U_Ent)
Index: sem_ch13.ads
===================================================================
--- sem_ch13.ads	(revision 165256)
+++ sem_ch13.ads	(working copy)
@@ -36,6 +36,17 @@ package Sem_Ch13 is
    procedure Analyze_Record_Representation_Clause       (N : Node_Id);
    procedure Analyze_Code_Statement                     (N : Node_Id);
 
+   procedure Analyze_Aspect_Specifications
+     (N : Node_Id;
+      E : Entity_Id;
+      L : List_Id);
+   --  This procedure is called to analyze aspect spefications for node N. E is
+   --  the corresponding entity declared by the declaration node N, and L is
+   --  the list of aspect specifications for this node. If L is No_List, the
+   --  call is ignored. Note that we can't use a simpler interface of just
+   --  passing the node N, since the analysis of the node may cause it to be
+   --  rewritten to a node not permitting aspect specifications.
+
    procedure Adjust_Record_For_Reverse_Bit_Order (R : Entity_Id);
    --  Called from Freeze where R is a record entity for which reverse bit
    --  order is specified and there is at least one component clause. Adjusts
Index: par-ch3.adb
===================================================================
--- par-ch3.adb	(revision 165283)
+++ par-ch3.adb	(working copy)
@@ -327,7 +327,7 @@ package body Ch3 is
       Type_Start_Col   : Column_Number;
       Unknown_Dis      : Boolean;
 
-      Typedef_Node     : Node_Id;
+      Typedef_Node : Node_Id;
       --  Normally holds type definition, except in the case of a private
       --  extension declaration, in which case it holds the declaration itself
 
@@ -476,22 +476,18 @@ package body Ch3 is
             when Tok_Access |
                  Tok_Not    => --  Ada 2005 (AI-231)
                Typedef_Node := P_Access_Type_Definition;
-               TF_Semicolon;
                exit;
 
             when Tok_Array =>
                Typedef_Node := P_Array_Type_Definition;
-               TF_Semicolon;
                exit;
 
             when Tok_Delta =>
                Typedef_Node := P_Fixed_Point_Definition;
-               TF_Semicolon;
                exit;
 
             when Tok_Digits =>
                Typedef_Node := P_Floating_Point_Definition;
-               TF_Semicolon;
                exit;
 
             when Tok_In =>
@@ -500,12 +496,10 @@ package body Ch3 is
             when Tok_Integer_Literal =>
                T_Range;
                Typedef_Node := P_Signed_Integer_Type_Definition;
-               TF_Semicolon;
                exit;
 
             when Tok_Null =>
                Typedef_Node := P_Record_Definition;
-               TF_Semicolon;
                exit;
 
             when Tok_Left_Paren =>
@@ -517,12 +511,10 @@ package body Ch3 is
                Set_Comes_From_Source (End_Labl, False);
 
                Set_End_Label (Typedef_Node, End_Labl);
-               TF_Semicolon;
                exit;
 
             when Tok_Mod =>
                Typedef_Node := P_Modular_Type_Definition;
-               TF_Semicolon;
                exit;
 
             when Tok_New =>
@@ -540,12 +532,10 @@ package body Ch3 is
                     (Record_Extension_Part (Typedef_Node), End_Labl);
                end if;
 
-               TF_Semicolon;
                exit;
 
             when Tok_Range =>
                Typedef_Node := P_Signed_Integer_Type_Definition;
-               TF_Semicolon;
                exit;
 
             when Tok_Record =>
@@ -557,7 +547,6 @@ package body Ch3 is
                Set_Comes_From_Source (End_Labl, False);
 
                Set_End_Label (Typedef_Node, End_Labl);
-               TF_Semicolon;
                exit;
 
             when Tok_Tagged =>
@@ -640,7 +629,6 @@ package body Ch3 is
                   end if;
                end if;
 
-               TF_Semicolon;
                exit;
 
             when Tok_Limited =>
@@ -733,7 +721,6 @@ package body Ch3 is
                   T_Private; -- past PRIVATE (or complain if not there!)
                end if;
 
-               TF_Semicolon;
                exit;
 
             --  Here we have an identifier after the IS, which is certainly
@@ -748,7 +735,6 @@ package body Ch3 is
 
                if not Token_Is_At_Start_Of_Line then
                   Typedef_Node := P_Derived_Type_Def_Or_Private_Ext_Decl;
-                  TF_Semicolon;
 
                --  If the identifier is at the start of the line, and is in the
                --  same column as the type declaration itself then we consider
@@ -769,7 +755,6 @@ package body Ch3 is
 
                else
                   Typedef_Node := P_Record_Definition;
-                  TF_Semicolon;
                end if;
 
                exit;
@@ -779,13 +764,11 @@ package body Ch3 is
             when Tok_Interface =>
                Typedef_Node := P_Interface_Type_Definition (Abstract_Present);
                Abstract_Present := True;
-               TF_Semicolon;
                exit;
 
             when Tok_Private =>
                Decl_Node := New_Node (N_Private_Type_Declaration, Type_Loc);
                Scan; -- past PRIVATE
-               TF_Semicolon;
                exit;
 
             --  Ada 2005 (AI-345): Protected, synchronized or task interface
@@ -849,7 +832,6 @@ package body Ch3 is
                   end if;
                end;
 
-               TF_Semicolon;
                exit;
 
             --  Anything else is an error
@@ -933,6 +915,7 @@ package body Ch3 is
 
       Set_Defining_Identifier (Decl_Node, Ident_Node);
       Set_Discriminant_Specifications (Decl_Node, Discr_List);
+      P_Aspect_Specifications (Decl_Node);
       return Decl_Node;
    end P_Type_Declaration;
 
@@ -980,7 +963,7 @@ package body Ch3 is
 
       Set_Subtype_Indication
         (Decl_Node, P_Subtype_Indication (Not_Null_Present));
-      TF_Semicolon;
+      P_Aspect_Specifications (Decl_Node);
       return Decl_Node;
    end P_Subtype_Declaration;
 
@@ -1836,8 +1819,8 @@ package body Ch3 is
             end if;
          end if;
 
-         TF_Semicolon;
          Set_Defining_Identifier (Decl_Node, Idents (Ident));
+         P_Aspect_Specifications (Decl_Node);
 
          if List_OK then
             if Ident < Num_Idents then
@@ -1976,7 +1959,16 @@ package body Ch3 is
       --  missing in the case of "type X is new Y record ..." or in the
       --  case of "type X is new Y null record".
 
-      if Token = Tok_With
+      --  First make sure we don't have an aspect specification. If we do
+      --  return now, so that our caller can check it (the WITH here is not
+      --  part of a type extension).
+
+      if Aspect_Specifications_Present then
+         return Typedef_Node;
+
+      --  OK, not an aspect specification, so continue test for extension
+
+      elsif Token = Tok_With
         or else Token = Tok_Record
         or else Token = Tok_Null
       then
@@ -3470,10 +3462,9 @@ package body Ch3 is
          Ident := Ident + 1;
          Restore_Scan_State (Scan_State);
          T_Colon;
-
       end loop Ident_Loop;
 
-      TF_Semicolon;
+      P_Aspect_Specifications (Decl_Node);
    end P_Component_Items;
 
    --------------------------------
Index: gcc-interface/Makefile.in
===================================================================
--- gcc-interface/Makefile.in	(revision 165256)
+++ gcc-interface/Makefile.in	(working copy)
@@ -296,7 +296,7 @@ GNATLINK_OBJS = gnatlink.o \
  sdefault.o snames.o stylesw.o switch.o system.o table.o targparm.o tree_io.o \
  types.o validsw.o widechar.o
 
-GNATMAKE_OBJS = a-except.o ali.o ali-util.o s-casuti.o \
+GNATMAKE_OBJS = a-except.o ali.o ali-util.o aspects.o s-casuti.o \
  alloc.o atree.o binderr.o butil.o casing.o csets.o debug.o elists.o einfo.o\
  erroutc.o errutil.o err_vars.o fmap.o fname.o fname-uf.o fname-sf.o \
  gnatmake.o gnatvsn.o hostparm.o interfac.o i-c.o i-cstrin.o krunch.o lib.o \
Index: gcc-interface/Make-lang.in
===================================================================
--- gcc-interface/Make-lang.in	(revision 165281)
+++ gcc-interface/Make-lang.in	(working copy)
@@ -368,6 +368,7 @@ GNATBIND_OBJS = \
  ada/ali-util.o   \
  ada/ali.o        \
  ada/alloc.o      \
+ ada/aspects.o    \
  ada/atree.o      \
  ada/bcheck.o     \
  ada/binde.o      \
