diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index 319254dfd63..a6a54e892e2 100644
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -5243,7 +5243,7 @@ package body Exp_Aggr is
          --  The bounds of the aggregate for this dimension
 
          Ind_Typ : constant Entity_Id := Aggr_Index_Typ (Dim);
-         --  The index type for this dimension.xxx
+         --  The index type for this dimension.
 
          Cond  : Node_Id;
          Assoc : Node_Id;
@@ -7344,6 +7344,12 @@ package body Exp_Aggr is
       --  choices that are ranges, subtype indications, subtype names, and
       --  iterated component associations.
 
+      function Make_Array_Delta_Assignment_LHS
+        (Choice : Node_Id; Temp : Entity_Id) return Node_Id;
+      --  Generate the LHS for the assignment associated with one
+      --  component association. This can be more complex than just an
+      --  indexed component in the case of a deep delta aggregate.
+
       -------------------
       -- Generate_Loop --
       -------------------
@@ -7380,6 +7386,60 @@ package body Exp_Aggr is
               End_Label       => Empty);
       end Generate_Loop;
 
+      function Make_Array_Delta_Assignment_LHS
+        (Choice : Node_Id; Temp : Entity_Id) return Node_Id
+      is
+         function Make_Delta_Choice_LHS
+           (Choice      : Node_Id;
+            Deep_Choice : Boolean) return Node_Id;
+         --  Recursively (but recursion only in deep delta aggregate case)
+         --  build up the LHS by successively applying selectors.
+
+         ---------------------------
+         -- Make_Delta_Choice_LHS --
+         ---------------------------
+
+         function Make_Delta_Choice_LHS
+           (Choice      : Node_Id;
+            Deep_Choice : Boolean) return Node_Id
+         is
+         begin
+            if not Deep_Choice
+              or else Is_Root_Prefix_Of_Deep_Choice (Choice)
+            then
+               return Make_Indexed_Component (Sloc (Choice),
+                        Prefix      => New_Occurrence_Of (Temp, Loc),
+                        Expressions => New_List (New_Copy_Tree (Choice)));
+
+            else
+               --  a deep delta aggregate choice
+               pragma Assert (All_Extensions_Allowed);
+
+               declare
+                  --  recursively get name for prefix
+                  LHS_Prefix : constant Node_Id
+                    := Make_Delta_Choice_LHS (Prefix (Choice), Deep_Choice);
+               begin
+                  if Nkind (Choice) = N_Indexed_Component then
+                     return Make_Indexed_Component (Sloc (Choice),
+                        Prefix      => LHS_Prefix,
+                        Expressions => New_Copy_List (Expressions (Choice)));
+                  else
+                     return Make_Selected_Component (Sloc (Choice),
+                              Prefix        => LHS_Prefix,
+                              Selector_Name =>
+                                Make_Identifier
+                                  (Sloc (Choice),
+                                   Chars (Selector_Name (Choice))));
+                  end if;
+               end;
+            end if;
+         end Make_Delta_Choice_LHS;
+      begin
+         return Make_Delta_Choice_LHS
+           (Choice, Is_Deep_Choice (Choice, Etype (N)));
+      end Make_Array_Delta_Assignment_LHS;
+
       --  Local variables
 
       Choice : Node_Id;
@@ -7416,9 +7476,7 @@ package body Exp_Aggr is
                   Append_To (Deltas,
                     Make_Assignment_Statement (Sloc (Choice),
                       Name       =>
-                        Make_Indexed_Component (Sloc (Choice),
-                          Prefix      => New_Occurrence_Of (Temp, Loc),
-                          Expressions => New_List (New_Copy_Tree (Choice))),
+                        Make_Array_Delta_Assignment_LHS (Choice, Temp),
                       Expression => New_Copy_Tree (Expression (Assoc))));
                end if;
 
@@ -7443,6 +7501,43 @@ package body Exp_Aggr is
       Assoc  : Node_Id;
       Choice : Node_Id;
 
+      function Make_Record_Delta_Assignment_LHS
+        (Selector : Node_Id) return Node_Id;
+      --  Generate the LHS for an assignment to a component (or subcomponent
+      --  if -gnatX specified) of the result object.
+
+      --------------------------------------
+      -- Make_Record_Delta_Assignment_LHS --
+      --------------------------------------
+
+      function Make_Record_Delta_Assignment_LHS
+        (Selector : Node_Id) return Node_Id
+      is
+      begin
+         if Nkind (Selector) = N_Selected_Component then
+            --  a deep delta aggregate, requires -gnatX0
+            return
+              Make_Selected_Component
+                (Sloc (Choice),
+                 Prefix        => Make_Record_Delta_Assignment_LHS
+                                    (Prefix (Selector)),
+                 Selector_Name =>
+                   Make_Identifier (Loc, Chars (Selector_Name (Selector))));
+         elsif Nkind (Selector) = N_Indexed_Component then
+            --  a deep delta aggregate, requires -gnatX0
+            return
+              Make_Indexed_Component
+                (Sloc (Choice),
+                 Prefix        => Make_Record_Delta_Assignment_LHS
+                                    (Prefix (Selector)),
+                 Expressions   => Expressions (Selector));
+         else
+            return Make_Selected_Component
+                    (Sloc (Choice),
+                     Prefix        => New_Occurrence_Of (Temp, Loc),
+                     Selector_Name => Make_Identifier (Loc, Chars (Selector)));
+         end if;
+      end Make_Record_Delta_Assignment_LHS;
    begin
       Assoc := First (Component_Associations (N));
 
@@ -7451,10 +7546,7 @@ package body Exp_Aggr is
          while Present (Choice) loop
             Append_To (Deltas,
               Make_Assignment_Statement (Sloc (Choice),
-                Name       =>
-                  Make_Selected_Component (Sloc (Choice),
-                    Prefix        => New_Occurrence_Of (Temp, Loc),
-                    Selector_Name => Make_Identifier (Loc, Chars (Choice))),
+                Name       => Make_Record_Delta_Assignment_LHS (Choice),
                 Expression => New_Copy_Tree (Expression (Assoc))));
             Next (Choice);
          end loop;
diff --git a/gcc/ada/exp_spark.adb b/gcc/ada/exp_spark.adb
index c344dc1e706..c19aa201bde 100644
--- a/gcc/ada/exp_spark.adb
+++ b/gcc/ada/exp_spark.adb
@@ -43,6 +43,7 @@ with Restrict;       use Restrict;
 with Rident;         use Rident;
 with Rtsfind;        use Rtsfind;
 with Sem;            use Sem;
+with Sem_Aggr;       use Sem_Aggr;
 with Sem_Aux;        use Sem_Aux;
 with Sem_Ch7;        use Sem_Ch7;
 with Sem_Ch8;        use Sem_Ch8;
@@ -186,15 +187,47 @@ package body Exp_SPARK is
      (Typ  : Entity_Id;
       Aggr : Node_Id)
    is
+      procedure Apply_Range_Checks (Choice : Node_Id);
+      --  Apply range checks on indexes from a deep choice
+
+      ------------------------
+      -- Apply_Range_Checks --
+      ------------------------
+
+      procedure Apply_Range_Checks (Choice : Node_Id) is
+         Pref  : Node_Id := Choice;
+         Index : N_Subexpr_Id;
+      begin
+         loop
+            if Nkind (Pref) = N_Indexed_Component then
+               Index := First (Expressions (Choice));
+               Apply_Scalar_Range_Check (Index, Etype (Index));
+
+            elsif Is_Array_Type (Typ)
+              and then Is_Root_Prefix_Of_Deep_Choice (Pref)
+            then
+               Index := Pref;
+               Apply_Scalar_Range_Check (Index, Etype (Index));
+            end if;
+
+            exit when Is_Root_Prefix_Of_Deep_Choice (Pref);
+
+            Pref := Prefix (Pref);
+         end loop;
+      end Apply_Range_Checks;
+
+      --  Local variables
+
       Assoc     : Node_Id;
       Comp      : Node_Id;
-      Comp_Id   : Entity_Id;
       Comp_Type : Entity_Id;
       Expr      : Node_Id;
       Index     : Node_Id;
       Index_Typ : Entity_Id;
       New_Assoc : Node_Id;
 
+   --  Start of processing for Expand_SPARK_Delta_Or_Update
+
    begin
       --  Apply scalar range checks on the updated components, if needed
 
@@ -277,6 +310,9 @@ package body Exp_SPARK is
                   if Nkind (Index) in N_Range | N_Subtype_Indication then
                      null;
 
+                  elsif Is_Deep_Choice (Index, Typ) then
+                     Apply_Range_Checks (Index);
+
                   --  Otherwise the index denotes a single expression where
                   --  range checks need to be applied or a subtype name
                   --  (without range constraints) where applying checks is
@@ -346,15 +382,16 @@ package body Exp_SPARK is
             Comp := First (Choices (Assoc));
 
             while Present (Comp) loop
-               Comp_Id   := Entity (Comp);
-               Comp_Type := Etype (Comp_Id);
+               if Is_Deep_Choice (Comp, Typ) then
+                  Comp_Type := Etype (Comp);
+               else
+                  Comp_Type := Etype (Entity (Comp));
+               end if;
 
                New_Assoc :=
                  Make_Component_Association
                    (Sloc       => Sloc (Assoc),
-                    Choices    =>
-                      New_List
-                        (New_Occurrence_Of (Comp_Id, Sloc (Comp))),
+                    Choices    => New_List (New_Copy_Tree (Comp)),
                     Expression => New_Copy_Tree (Expr));
 
                --  New association must be attached to the aggregate before we
@@ -364,6 +401,10 @@ package body Exp_SPARK is
 
                Analyze_And_Resolve (Expression (New_Assoc), Comp_Type);
 
+               if Is_Deep_Choice (Comp, Typ) then
+                  Apply_Range_Checks (First (Choices (New_Assoc)));
+               end if;
+
                if Is_Scalar_Type (Comp_Type) then
                   Apply_Scalar_Range_Check
                     (Expression (New_Assoc), Comp_Type);
diff --git a/gcc/ada/par-ch4.adb b/gcc/ada/par-ch4.adb
index 52f2b02361a..2ff6e001f39 100644
--- a/gcc/ada/par-ch4.adb
+++ b/gcc/ada/par-ch4.adb
@@ -1393,6 +1393,8 @@ package body Ch4 is
       Start_Token : constant Token_Type := Token;
       --  Used to prevent mismatches (...] and [...)
 
+      Saved_Delta_Aggregate_Flag : constant Boolean := Inside_Delta_Aggregate;
+
    --  Start of processing for P_Aggregate_Or_Paren_Expr
 
    begin
@@ -1497,6 +1499,7 @@ package body Ch4 is
             Scan; -- past WITH
             if Token = Tok_Delta then
                Scan; -- past DELTA
+               Inside_Delta_Aggregate := True;
                Aggregate_Node := New_Node (N_Delta_Aggregate, Lparen_Sloc);
                Set_Expression (Aggregate_Node, Expr_Node);
                Expr_Node := Empty;
@@ -1707,6 +1710,16 @@ package body Ch4 is
       end if;
 
       Set_Component_Associations (Aggregate_Node, Assoc_List);
+
+      --  Inside_Delta_Aggregate is only tested if Serious_Errors = 0, so
+      --  it is ok if we fail to restore the saved I_D_A value in an error
+      --  path. In particular, it is ok that we do not restore it if
+      --  Error_Resync is propagated. Earlier return statements (which return
+      --  without restoring the saved I_D_A value) should either be in error
+      --  paths or in paths where I_D_A could not have been modified.
+
+      Inside_Delta_Aggregate := Saved_Delta_Aggregate_Flag;
+
       return Aggregate_Node;
    end P_Aggregate_Or_Paren_Expr;
 
@@ -2519,6 +2532,109 @@ package body Ch4 is
          Expr_Form := EF_Simple;
       end if;
 
+      --  If all extensions are enabled and we have a deep delta aggregate
+      --  whose type is an array type with an element type that is a
+      --  record type, then we can encounter legal things like
+      --    with delta (Some_Index_Expression).Some_Component
+      --  where a parenthesized expression precedes a dot.
+      --  Similarly, if the element type is an array type then we can see
+      --    with delta (Some_Index_Expression)(Another_Index_Expression)
+      --  where a parenthesized expression precedes a left parenthesis.
+
+      if Token in Tok_Dot | Tok_Left_Paren
+        and then Prev_Token = Tok_Right_Paren
+        and then Serious_Errors_Detected = 0
+        and then Inside_Delta_Aggregate
+        and then All_Extensions_Allowed
+      then
+         if Token = Tok_Dot then
+            Node2 := New_Node (N_Selected_Component, Token_Ptr);
+            Scan; -- past dot
+            declare
+               Tail  : constant Node_Id := P_Simple_Expression;
+               --  remaining selectors occurring after the dot
+
+               Rover : Node_Id := Tail;
+               Prev  : Node_Id := Empty;
+            begin
+               --  If Tail already has a prefix, then we want to prepend
+               --  Node1 onto that prefix and then return Tail.
+               --  Otherwise, Tail should simply be an identifier so
+               --  we want to build a Selected_Component with Tail as the
+               --  selector name and return that.
+
+               Set_Prefix (Node2, Node1);
+
+               while Nkind (Rover)
+                       in N_Indexed_Component | N_Selected_Component loop
+                  Prev := Rover;
+                  Rover := Prefix (Rover);
+               end loop;
+
+               case Nkind (Prev) is
+                  when N_Selected_Component | N_Indexed_Component =>
+                     --  We've scanned a dot, so an identifier should follow
+                     if Nkind (Prefix (Prev)) = N_Identifier then
+                        Set_Selector_Name (Node2, Prefix (Prev));
+                        Set_Prefix (Prev, Node2);
+                        return Tail;
+                     end if;
+
+                  when N_Empty =>
+                     --  We've scanned a dot, so an identifier should follow
+                     if Nkind (Tail) = N_Identifier then
+                        Set_Selector_Name (Node2, Tail);
+                        return Node2;
+                     end if;
+
+                  when others =>
+                     null;
+               end case;
+
+               --  fall through to error case
+            end;
+         else
+            Node2 := New_Node (N_Indexed_Component, Token_Ptr);
+            declare
+               Tail  : constant Node_Id := P_Simple_Expression;
+               --  remaining selectors
+
+               Rover : Node_Id := Tail;
+               Prev  : Node_Id := Empty;
+            begin
+               --  If Tail already has a prefix, then we want to prepend
+               --  Node1 onto that prefix and then return Tail.
+               --  Otherwise, Tail should be an index expression and
+               --  we want to build an Indexed_Component with Tail as the
+               --  index value and return that.
+
+               Set_Prefix (Node2, Node1);
+
+               while Nkind (Rover)
+                       in N_Indexed_Component | N_Selected_Component loop
+                  Prev := Rover;
+                  Rover := Prefix (Rover);
+               end loop;
+
+               case Nkind (Prev) is
+                  when N_Selected_Component | N_Indexed_Component =>
+                     Set_Expressions (Node2, New_List (Prefix (Prev)));
+                     Set_Prefix (Prev, Node2);
+                     return Tail;
+
+                  when N_Empty =>
+                     Set_Expressions (Node2, New_List (Tail));
+                     return Node2;
+
+                  when others =>
+                     null;
+               end case;
+
+               --  fall through to error case
+            end;
+         end if;
+      end if;
+
       --  Come here at end of simple expression, where we do a couple of
       --  special checks to improve error recovery.
 
@@ -2529,8 +2645,8 @@ package body Ch4 is
       if Token = Tok_Dot then
          Error_Msg_SC ("prefix for selection is not a name");
 
-         --  If qualified expression, comment and continue, otherwise something
-         --  is pretty nasty so do an Error_Resync call.
+         --  If qualified expression, comment and continue, otherwise
+         --  something is pretty nasty so do an Error_Resync call.
 
          if Ada_Version < Ada_2012
            and then Nkind (Node1) = N_Qualified_Expression
diff --git a/gcc/ada/par.adb b/gcc/ada/par.adb
index 5206899b261..180ec08561c 100644
--- a/gcc/ada/par.adb
+++ b/gcc/ada/par.adb
@@ -76,6 +76,11 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is
    --  Variable used to save values of config switches while we parse the
    --  new unit, to be restored on exit for proper recursive behavior.
 
+   Inside_Delta_Aggregate : Boolean := False;
+   --  True within a delta aggregate (but only after the "delta" token has
+   --  been scanned). Used to distinguish syntax errors from syntactically
+   --  correct "deep" delta aggregates (enabled via -gnatX0).
+
    --------------------
    -- Error Recovery --
    --------------------
diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb
index 36db7987d91..c1d25404ae4 100644
--- a/gcc/ada/sem_aggr.adb
+++ b/gcc/ada/sem_aggr.adb
@@ -27,7 +27,6 @@ with Aspects;        use Aspects;
 with Atree;          use Atree;
 with Checks;         use Checks;
 with Einfo;          use Einfo;
-with Einfo.Entities; use Einfo.Entities;
 with Einfo.Utils;    use Einfo.Utils;
 with Elists;         use Elists;
 with Errout;         use Errout;
@@ -423,6 +422,9 @@ package body Sem_Aggr is
 
    procedure Resolve_Delta_Array_Aggregate  (N : Node_Id; Typ : Entity_Id);
    procedure Resolve_Delta_Record_Aggregate (N : Node_Id; Typ : Entity_Id);
+   procedure Resolve_Deep_Delta_Assoc (N : Node_Id; Typ : Entity_Id);
+   --  Resolve the names/expressions in a component association for
+   --  a deep delta aggregate. Typ is the type of the enclosing object.
 
    ------------------------
    -- Array_Aggr_Subtype --
@@ -759,6 +761,28 @@ package body Sem_Aggr is
       end if;
    end Check_Expr_OK_In_Limited_Aggregate;
 
+   --------------------
+   -- Is_Deep_Choice --
+   --------------------
+
+   function Is_Deep_Choice
+     (Choice    : Node_Id;
+      Aggr_Type : Type_Kind_Id) return Boolean
+   is
+      Pref : Node_Id := Choice;
+   begin
+      while not Is_Root_Prefix_Of_Deep_Choice (Pref) loop
+         Pref := Prefix (Pref);
+      end loop;
+
+      if Is_Array_Type (Aggr_Type) then
+         return Paren_Count (Pref) > 0
+           and then Pref /= Choice;
+      else
+         return Pref /= Choice;
+      end if;
+   end Is_Deep_Choice;
+
    -------------------------
    -- Is_Others_Aggregate --
    -------------------------
@@ -771,6 +795,17 @@ package body Sem_Aggr is
         and then Nkind (First (Choice_List (First (Assoc)))) = N_Others_Choice;
    end Is_Others_Aggregate;
 
+   -----------------------------------
+   -- Is_Root_Prefix_Of_Deep_Choice --
+   -----------------------------------
+
+   function Is_Root_Prefix_Of_Deep_Choice (Pref : Node_Id) return Boolean is
+   begin
+      return Paren_Count (Pref) > 0
+        or else Nkind (Pref) not in N_Indexed_Component
+                                  | N_Selected_Component;
+   end Is_Root_Prefix_Of_Deep_Choice;
+
    -------------------------
    -- Is_Single_Aggregate --
    -------------------------
@@ -3713,31 +3748,38 @@ package body Sem_Aggr is
          else
             Choice := First (Choice_List (Assoc));
             while Present (Choice) loop
-               Analyze (Choice);
+               if Is_Deep_Choice (Choice, Typ) then
+                  pragma Assert (All_Extensions_Allowed);
 
-               if Nkind (Choice) = N_Others_Choice then
-                  Error_Msg_N
-                    ("OTHERS not allowed in delta aggregate", Choice);
+                  --  a deep delta aggregate
+                  Resolve_Deep_Delta_Assoc (Assoc, Typ);
+               else
+                  Analyze (Choice);
 
-               elsif Is_Entity_Name (Choice)
-                 and then Is_Type (Entity (Choice))
-               then
-                  --  Choice covers a range of values
+                  if Nkind (Choice) = N_Others_Choice then
+                     Error_Msg_N
+                       ("OTHERS not allowed in delta aggregate", Choice);
 
-                  if Base_Type (Entity (Choice)) /=
-                     Base_Type (Index_Type)
+                  elsif Is_Entity_Name (Choice)
+                    and then Is_Type (Entity (Choice))
                   then
-                     Error_Msg_NE
-                       ("choice does not match index type of &",
-                        Choice, Typ);
-                  end if;
+                     --  Choice covers a range of values
 
-               elsif Nkind (Choice) = N_Subtype_Indication then
-                  Resolve_Discrete_Subtype_Indication
-                    (Choice, Base_Type (Index_Type));
+                     if Base_Type (Entity (Choice)) /=
+                        Base_Type (Index_Type)
+                     then
+                        Error_Msg_NE
+                          ("choice does not match index type of &",
+                           Choice, Typ);
+                     end if;
 
-               else
-                  Resolve (Choice, Index_Type);
+                  elsif Nkind (Choice) = N_Subtype_Indication then
+                     Resolve_Discrete_Subtype_Indication
+                       (Choice, Base_Type (Index_Type));
+
+                  else
+                     Resolve (Choice, Index_Type);
+                  end if;
                end if;
 
                Next (Choice);
@@ -3773,14 +3815,15 @@ package body Sem_Aggr is
       Comp_Ref : Entity_Id := Empty; -- init to avoid warning
       Variant  : Node_Id;
 
-      procedure Check_Variant (Id : Entity_Id);
+      procedure Check_Variant (Id : Node_Id);
       --  If a given component of the delta aggregate appears in a variant
       --  part, verify that it is within the same variant as that of previous
       --  specified variant components of the delta.
 
-      function Get_Component (Nam : Node_Id) return Entity_Id;
-      --  Locate component with a given name and return it. If none found then
-      --  report error and return Empty.
+      function Get_Component_Type
+        (Selector : Node_Id; Enclosing_Type : Entity_Id) return Entity_Id;
+      --  Locate component with a given name and return its type.
+      --  If none found then report error and return Empty.
 
       function Nested_In (V1 : Node_Id; V2 : Node_Id) return Boolean;
       --  Determine whether variant V1 is within variant V2
@@ -3792,7 +3835,7 @@ package body Sem_Aggr is
       --  Check_Variant --
       --------------------
 
-      procedure Check_Variant (Id : Entity_Id) is
+      procedure Check_Variant (Id : Node_Id) is
          Comp         : Entity_Id;
          Comp_Variant : Node_Id;
 
@@ -3843,30 +3886,80 @@ package body Sem_Aggr is
          end if;
       end Check_Variant;
 
-      -------------------
-      -- Get_Component --
-      -------------------
+      ------------------------
+      -- Get_Component_Type --
+      ------------------------
 
-      function Get_Component (Nam : Node_Id) return Entity_Id is
+      function Get_Component_Type
+        (Selector : Node_Id; Enclosing_Type : Entity_Id) return Entity_Id
+      is
          Comp : Entity_Id;
-
       begin
-         Comp := First_Entity (Typ);
+         case Nkind (Selector) is
+            when N_Selected_Component | N_Indexed_Component =>
+               --  a deep delta aggregate choice
+
+               declare
+                  Prefix_Type : constant Entity_Id :=
+                    Get_Component_Type (Prefix (Selector), Enclosing_Type);
+               begin
+                  if not Present (Prefix_Type) then
+                     pragma Assert (Serious_Errors_Detected > 0);
+                     return Empty;
+                  end if;
+
+                  --  Set the type of the prefix for GNATprove
+
+                  Set_Etype (Prefix (Selector), Prefix_Type);
+
+                  if Nkind (Selector) = N_Selected_Component then
+                     return Get_Component_Type
+                              (Selector_Name (Selector),
+                               Enclosing_Type => Prefix_Type);
+                  elsif not Is_Array_Type (Prefix_Type) then
+                     Error_Msg_NE
+                       ("type& is not an array type",
+                        Selector, Prefix_Type);
+                  elsif Number_Dimensions (Prefix_Type) /= 1 then
+                     Error_Msg_NE
+                       ("array type& not one-dimensional",
+                        Selector, Prefix_Type);
+                  elsif List_Length (Expressions (Selector)) /= 1 then
+                     Error_Msg_NE
+                       ("wrong number of indices for array type&",
+                        Selector, Prefix_Type);
+                  else
+                     Analyze_And_Resolve
+                       (First (Expressions (Selector)),
+                        Etype (First_Index (Prefix_Type)));
+                     return Component_Type (Prefix_Type);
+                  end if;
+               end;
+
+            when others =>
+               null;
+         end case;
+
+         Comp := First_Entity (Enclosing_Type);
          while Present (Comp) loop
-            if Chars (Comp) = Chars (Nam) then
+            if Chars (Comp) = Chars (Selector) then
                if Ekind (Comp) = E_Discriminant then
-                  Error_Msg_N ("delta cannot apply to discriminant", Nam);
+                  Error_Msg_N ("delta cannot apply to discriminant", Selector);
                end if;
 
-               return Comp;
+               Set_Entity (Selector, Comp);
+               Set_Etype  (Selector, Etype (Comp));
+
+               return Etype (Comp);
             end if;
 
             Next_Entity (Comp);
          end loop;
 
-         Error_Msg_NE ("type& has no component with this name", Nam, Typ);
+         Error_Msg_NE
+           ("type& has no component with this name", Selector, Enclosing_Type);
          return Empty;
-      end Get_Component;
+      end Get_Component_Type;
 
       ---------------
       -- Nested_In --
@@ -3911,10 +4004,10 @@ package body Sem_Aggr is
 
       Deltas : constant List_Id := Component_Associations (N);
 
-      Assoc     : Node_Id;
-      Choice    : Node_Id;
-      Comp      : Entity_Id;
-      Comp_Type : Entity_Id := Empty; -- init to avoid warning
+      Assoc       : Node_Id;
+      Choice      : Node_Id;
+      Comp_Type   : Entity_Id := Empty; -- init to avoid warning
+      Deep_Choice : Boolean;
 
    --  Start of processing for Resolve_Delta_Record_Aggregate
 
@@ -3925,19 +4018,27 @@ package body Sem_Aggr is
       while Present (Assoc) loop
          Choice := First (Choice_List (Assoc));
          while Present (Choice) loop
-            Comp := Get_Component (Choice);
+            Deep_Choice := Nkind (Choice) /= N_Identifier;
+            if Deep_Choice then
+               Error_Msg_GNAT_Extension
+                 ("deep delta aggregate", Sloc (Choice));
+            end if;
 
-            if Present (Comp) then
-               Check_Variant (Choice);
+            Comp_Type := Get_Component_Type
+                          (Selector => Choice, Enclosing_Type => Typ);
 
-               Comp_Type := Etype (Comp);
+            --  Set the type of the choice for GNATprove
 
-               --  Decorate the component reference by setting its entity and
-               --  type, as otherwise backends like GNATprove would have to
-               --  rediscover this information by themselves.
+            if Deep_Choice then
+               Set_Etype (Choice, Comp_Type);
+            end if;
 
-               Set_Entity (Choice, Comp);
-               Set_Etype  (Choice, Comp_Type);
+            if Present (Comp_Type) then
+               if not Deep_Choice then
+                  --  ??? Not clear yet how RM 4.3.1(17.7) applies to a
+                  --  deep delta aggregate.
+                  Check_Variant (Choice);
+               end if;
             else
                Comp_Type := Any_Type;
             end if;
@@ -3973,6 +4074,95 @@ package body Sem_Aggr is
       end loop;
    end Resolve_Delta_Record_Aggregate;
 
+   ------------------------------
+   -- Resolve_Deep_Delta_Assoc --
+   ------------------------------
+
+   procedure Resolve_Deep_Delta_Assoc (N : Node_Id; Typ : Entity_Id) is
+      Choice         : constant Node_Id := First (Choice_List (N));
+      Enclosing_Type : Entity_Id := Typ;
+
+      procedure Resolve_Choice_Prefix
+        (Choice_Prefix : Node_Id; Enclosing_Type : in out Entity_Id);
+      --  Recursively analyze selectors. Enclosing_Type is set to
+      --  type of the last component.
+
+      ---------------------------
+      -- Resolve_Choice_Prefix --
+      ---------------------------
+
+      procedure Resolve_Choice_Prefix
+        (Choice_Prefix : Node_Id; Enclosing_Type : in out Entity_Id)
+      is
+         Selector : Node_Id := Choice_Prefix;
+      begin
+         if not Is_Root_Prefix_Of_Deep_Choice (Choice_Prefix) then
+            Resolve_Choice_Prefix (Prefix (Choice_Prefix), Enclosing_Type);
+
+            if Nkind (Choice_Prefix) = N_Selected_Component then
+               Selector := Selector_Name (Choice_Prefix);
+            else
+               pragma Assert (Nkind (Choice_Prefix) = N_Indexed_Component);
+               Selector := First (Expressions (Choice_Prefix));
+            end if;
+         end if;
+
+         if Is_Array_Type (Enclosing_Type) then
+            Analyze_And_Resolve (Selector,
+                                 Etype (First_Index (Enclosing_Type)));
+            Enclosing_Type := Component_Type (Enclosing_Type);
+         else
+            declare
+               Comp : Entity_Id := First_Entity (Enclosing_Type);
+               Found : Boolean := False;
+            begin
+               while Present (Comp) and not Found loop
+                  if Chars (Comp) = Chars (Selector) then
+                     if Ekind (Comp) = E_Discriminant then
+                        Error_Msg_N ("delta cannot apply to discriminant",
+                                     Selector);
+                     end if;
+                     Found := True;
+                     Set_Entity (Selector, Comp);
+                     Set_Etype (Selector, Etype (Comp));
+                     Set_Analyzed (Selector);
+                     Enclosing_Type := Etype (Comp);
+                  else
+                     Next_Entity (Comp);
+                  end if;
+               end loop;
+               if not Found then
+                  Error_Msg_NE
+                    ("type& has no component with this name",
+                     Selector, Enclosing_Type);
+               end if;
+            end;
+         end if;
+
+         --  Set the type of the prefix for GNATprove, except for the root
+         --  prefix, whose type is already the expected one for a record
+         --  delta aggregate, or the type of the array index for an
+         --  array delta aggregate (the only case here really since
+         --  Resolve_Deep_Delta_Assoc is only called for array delta
+         --  aggregates).
+
+         if Selector /= Choice_Prefix then
+            Set_Etype (Choice_Prefix, Enclosing_Type);
+         end if;
+      end Resolve_Choice_Prefix;
+   begin
+      declare
+         Unimplemented : exception; -- TEMPORARY
+      begin
+         if Present (Next (Choice)) then
+            raise Unimplemented;
+         end if;
+      end;
+
+      Resolve_Choice_Prefix (Choice, Enclosing_Type);
+      Analyze_And_Resolve (Expression (N), Enclosing_Type);
+   end Resolve_Deep_Delta_Assoc;
+
    ---------------------------------
    -- Resolve_Extension_Aggregate --
    ---------------------------------
diff --git a/gcc/ada/sem_aggr.ads b/gcc/ada/sem_aggr.ads
index 46d28aee059..386a16161b2 100644
--- a/gcc/ada/sem_aggr.ads
+++ b/gcc/ada/sem_aggr.ads
@@ -26,7 +26,8 @@
 --  This package contains the resolution code for aggregates. It is logically
 --  part of Sem_Res, but is split off since the aggregate code is so complex.
 
-with Types; use Types;
+with Einfo.Entities; use Einfo.Entities;
+with Types;          use Types;
 
 package Sem_Aggr is
 
@@ -50,4 +51,15 @@ package Sem_Aggr is
    function Is_Null_Array_Aggregate_High_Bound (N : Node_Id) return Boolean;
    --  Returns True for the high bound of a null array aggregate.
 
+   function Is_Deep_Choice
+     (Choice    : Node_Id;
+      Aggr_Type : Type_Kind_Id) return Boolean;
+   --  Returns whether Choice from a delta aggregate of type Aggr_Type is a
+   --  deep choice.
+
+   function Is_Root_Prefix_Of_Deep_Choice (Pref : Node_Id) return Boolean;
+   --  Returns whether prefix Pref of a deep choice is its root prefix. Except
+   --  for its use in Is_Deep_Choice, this function should only be called on
+   --  prefixes of a deep choice as identified by Is_Deep_Choice.
+
 end Sem_Aggr;
