Index: sem_aggr.adb
===================================================================
--- sem_aggr.adb	(revision 160834)
+++ sem_aggr.adb	(working copy)
@@ -2488,10 +2488,14 @@ package body Sem_Aggr is
       --  whose value may already have been specified by N's ancestor part.
       --  This routine checks whether this is indeed the case and if so returns
       --  False, signaling that no value for Discr should appear in N's
-      --  aggregate part. Also, in this case, the routine appends
-      --  New_Assoc_List Discr the discriminant value specified in the ancestor
+      --  aggregate part. Also, in this case, the routine appends to
+      --  New_Assoc_List the discriminant value specified in the ancestor
       --  part.
-      --  Can't parse previous sentence, appends what where???
+      --  If the aggregate is in a context with expansion delayed, it will be
+      --  reanalyzed, The inherited discriminant values must not be reinserted
+      --  in the component list to prevent spurious errors, but it must be
+      --  present on first analysis to build the proper subtype indications.
+      --  The flag Inherited_Discriminant is used to prevent the re-insertion.
 
       function Get_Value
         (Compon                 : Node_Id;
@@ -2556,6 +2560,7 @@ package body Sem_Aggr is
          Loc : Source_Ptr;
 
          Ancestor     : Node_Id;
+         Comp_Assoc   : Node_Id;
          Discr_Expr   : Node_Id;
 
          Ancestor_Typ : Entity_Id;
@@ -2570,6 +2575,20 @@ package body Sem_Aggr is
             return True;
          end if;
 
+         --  Check whether inherited discriminant values have already been
+         --  inserted in the aggregate. This will be the case if we are
+         --  re-analyzing an aggregate whose expansion was delayed.
+
+         if Present (Component_Associations (N)) then
+            Comp_Assoc := First (Component_Associations (N));
+            while Present (Comp_Assoc) loop
+               if Inherited_Discriminant (Comp_Assoc) then
+                  return True;
+               end if;
+               Next (Comp_Assoc);
+            end loop;
+         end if;
+
          Ancestor     := Ancestor_Part (N);
          Ancestor_Typ := Etype (Ancestor);
          Loc          := Sloc (Ancestor);
@@ -2627,6 +2646,7 @@ package body Sem_Aggr is
                end if;
 
                Resolve_Aggr_Expr (Discr_Expr, Discr);
+               Set_Inherited_Discriminant (Last (New_Assoc_List));
                return False;
             end if;
 
Index: sinfo.adb
===================================================================
--- sinfo.adb	(revision 160834)
+++ sinfo.adb	(working copy)
@@ -1572,6 +1572,14 @@ package body Sinfo is
       return Flag11 (N);
    end Includes_Infinities;
 
+   function Inherited_Discriminant
+      (N : Node_Id) return Boolean is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Component_Association);
+      return Flag13 (N);
+   end Inherited_Discriminant;
+
    function Instance_Spec
       (N : Node_Id) return Node_Id is
    begin
@@ -4466,6 +4474,14 @@ package body Sinfo is
       Set_Flag11 (N, Val);
    end Set_Includes_Infinities;
 
+   procedure Set_Inherited_Discriminant
+      (N : Node_Id; Val : Boolean := True) is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Component_Association);
+      Set_Flag13 (N, Val);
+   end Set_Inherited_Discriminant;
+
    procedure Set_Instance_Spec
       (N : Node_Id; Val : Node_Id) is
    begin
Index: sinfo.ads
===================================================================
--- sinfo.ads	(revision 160834)
+++ sinfo.ads	(working copy)
@@ -1180,6 +1180,12 @@ package Sinfo is
    --    range is given by the programmer, even if that range is identical to
    --    the range for Float.
 
+   --  Inherited_Discriminant (Flag13-Sem)
+   --    This flag is present in N_Component_Association nodes. It indicates
+   --    that a given component association in an extension aggregate is the
+   --    value obtained from a constraint on an ancestor. Used to prevent
+   --    double expansion when the aggregate has expansion delayed.
+
    --  Instance_Spec (Node5-Sem)
    --    This field is present in generic instantiation nodes, and also in
    --    formal package declaration nodes (formal package declarations are
@@ -3340,6 +3346,7 @@ package Sinfo is
       --  Loop_Actions (List2-Sem)
       --  Expression (Node3)
       --  Box_Present (Flag15)
+      --  Inherited_Discriminant (Flag13)
 
       --  Note: this structure is used for both record component associations
       --  and array component associations, since the two cases aren't always
@@ -8117,6 +8124,9 @@ package Sinfo is
    function Includes_Infinities
      (N : Node_Id) return Boolean;    -- Flag11
 
+   function Inherited_Discriminant
+     (N : Node_Id) return Boolean;    -- Flag13
+
    function Instance_Spec
      (N : Node_Id) return Node_Id;    -- Node5
 
@@ -9041,6 +9051,9 @@ package Sinfo is
    procedure Set_Includes_Infinities
      (N : Node_Id; Val : Boolean := True);    -- Flag11
 
+   procedure Set_Inherited_Discriminant
+     (N : Node_Id; Val : Boolean := True);    -- Flag13
+
    procedure Set_Instance_Spec
      (N : Node_Id; Val : Node_Id);            -- Node5
 
@@ -11332,6 +11345,7 @@ package Sinfo is
    pragma Inline (Interface_Present);
    pragma Inline (Includes_Infinities);
    pragma Inline (In_Present);
+   pragma Inline (Inherited_Discriminant);
    pragma Inline (Instance_Spec);
    pragma Inline (Intval);
    pragma Inline (Is_Accessibility_Actual);
@@ -11636,6 +11650,7 @@ package Sinfo is
    pragma Inline (Set_Interface_List);
    pragma Inline (Set_Interface_Present);
    pragma Inline (Set_In_Present);
+   pragma Inline (Set_Inherited_Discriminant);
    pragma Inline (Set_Instance_Spec);
    pragma Inline (Set_Intval);
    pragma Inline (Set_Is_Accessibility_Actual);