diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index eb552ea26..9ec506496 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -1828,6 +1828,13 @@ package body Exp_Ch6 is
       N_Node   : Node_Id;
       E_Actual : Entity_Id;
       E_Formal : Entity_Id;
+      Actual_Storage_Model : Entity_Id;
+
+      function Storage_Model_Of_Actual (N : Node_Id) return Entity_Id;
+      --  Return the storage model of the innermost dereference underlying N,
+      --  if any. Components are part of the designated object and must use
+      --  the model of their nearest dereference. Conversions in a component
+      --  prefix do not change that model.
 
       procedure Add_Call_By_Copy_Code;
       --  For cases where the parameter must be passed by copy, this routine
@@ -2604,6 +2611,31 @@ package body Exp_Ch6 is
          end if;
       end Make_Var;
 
+      -----------------------------
+      -- Storage_Model_Of_Actual --
+      -----------------------------
+
+      function Storage_Model_Of_Actual (N : Node_Id) return Entity_Id is
+         Obj : Node_Id := N;
+
+      begin
+         while Nkind (Obj) in N_Indexed_Component
+                            | N_Selected_Component
+                            | N_Slice
+         loop
+            Obj := Unqual_Conv (Prefix (Obj));
+         end loop;
+
+         if Nkind (Obj) = N_Explicit_Dereference
+           and then
+             Has_Designated_Storage_Model_Aspect (Etype (Prefix (Obj)))
+         then
+            return Storage_Model_Object (Etype (Prefix (Obj)));
+         else
+            return Empty;
+         end if;
+      end Storage_Model_Of_Actual;
+
       -------------------------
       -- Reset_Packed_Prefix --
       -------------------------
@@ -2682,6 +2714,7 @@ package body Exp_Ch6 is
       while Present (Formal) loop
          E_Formal := Etype (Formal);
          E_Actual := Etype (Actual);
+         Actual_Storage_Model := Storage_Model_Of_Actual (Actual);
 
          --  Handle formals whose type comes from the limited view
 
@@ -2804,17 +2837,15 @@ package body Exp_Ch6 is
 
             --  If the actual has a nonnative storage model, we need a copy
 
-            elsif Nkind (Actual) = N_Explicit_Dereference
-              and then
-                Has_Designated_Storage_Model_Aspect (Etype (Prefix (Actual)))
+            elsif Present (Actual_Storage_Model)
               and then
                 (Present (Storage_Model_Copy_To
-                            (Storage_Model_Object (Etype (Prefix (Actual)))))
+                            (Actual_Storage_Model))
                   or else
                     (Ekind (Formal) = E_In_Out_Parameter
                       and then
                         Present (Storage_Model_Copy_From
-                          (Storage_Model_Object (Etype (Prefix (Actual)))))))
+                          (Actual_Storage_Model))))
             then
                Add_Simple_Call_By_Copy_Code (Force => True);
 
@@ -2970,12 +3001,10 @@ package body Exp_Ch6 is
 
             --  If the actual has a nonnative storage model, we need a copy
 
-            elsif Nkind (Actual) = N_Explicit_Dereference
-              and then
-                Has_Designated_Storage_Model_Aspect (Etype (Prefix (Actual)))
+            elsif Present (Actual_Storage_Model)
               and then
                 Present (Storage_Model_Copy_From
-                           (Storage_Model_Object (Etype (Prefix (Actual)))))
+                           (Actual_Storage_Model))
             then
                Add_Simple_Call_By_Copy_Code (Force => True);
 
diff --git a/gcc/testsuite/gnat.dg/storage_model_actuals.adb b/gcc/testsuite/gnat.dg/storage_model_actuals.adb
new file mode 100644
index 000000000..31f351d00
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/storage_model_actuals.adb
@@ -0,0 +1,280 @@
+--  { dg-do run }
+--  { dg-options "-gnatX0 -gnata" }
+
+with Ada.Text_IO;             use Ada.Text_IO;
+with Interfaces;              use Interfaces;
+with Interfaces.C;
+with System;
+with System.Storage_Elements; use System.Storage_Elements;
+
+procedure Storage_Model_Actuals is
+   type Shared_Address is mod 2 ** 64;
+   Null_Shared_Address : constant Shared_Address := 0;
+
+   type Byte_Array is array (Storage_Offset range 0 .. 8_191)
+     of aliased Unsigned_8;
+
+   type Shared_Model is limited record
+      Bytes       : Byte_Array := (others => 0);
+      Next        : Storage_Offset := 8;
+      Reads       : Natural := 0;
+      Writes      : Natural := 0;
+      Read_Bytes  : Storage_Count := 0;
+      Write_Bytes : Storage_Count := 0;
+   end record
+     with Storage_Model_Type =>
+       (Address_Type => Shared_Address,
+        Allocate     => Allocate,
+        Deallocate   => Deallocate,
+        Copy_To      => Copy_To,
+        Copy_From    => Copy_From,
+        Storage_Size => Storage_Size,
+        Null_Address => Null_Shared_Address);
+
+   procedure Allocate
+     (Model           : in out Shared_Model;
+      Storage_Address : out Shared_Address;
+      Size            : Storage_Count;
+      Alignment       : Storage_Count);
+
+   procedure Deallocate
+     (Model           : in out Shared_Model;
+      Storage_Address : Shared_Address;
+      Size            : Storage_Count;
+      Alignment       : Storage_Count);
+
+   procedure Copy_To
+     (Model  : in out Shared_Model;
+      Target : Shared_Address;
+      Source : System.Address;
+      Size   : Storage_Count);
+
+   procedure Copy_From
+     (Model  : in out Shared_Model;
+      Target : System.Address;
+      Source : Shared_Address;
+      Size   : Storage_Count);
+
+   function Storage_Size (Model : Shared_Model) return Storage_Count;
+
+   function C_Memcpy
+     (Destination : System.Address;
+      Source      : System.Address;
+      Size        : Interfaces.C.size_t) return System.Address
+     with Import, Convention => C, External_Name => "memcpy";
+
+   procedure Allocate
+     (Model           : in out Shared_Model;
+      Storage_Address : out Shared_Address;
+      Size            : Storage_Count;
+      Alignment       : Storage_Count)
+   is
+      Aligned : constant Storage_Offset :=
+        ((Model.Next + Storage_Offset (Alignment) - 1)
+         / Storage_Offset (Alignment)) * Storage_Offset (Alignment);
+   begin
+      Storage_Address := Shared_Address (Aligned);
+      Model.Next := Aligned + Storage_Offset (Size);
+   end Allocate;
+
+   procedure Deallocate
+     (Model           : in out Shared_Model;
+      Storage_Address : Shared_Address;
+      Size            : Storage_Count;
+      Alignment       : Storage_Count)
+   is
+      pragma Unreferenced (Model, Storage_Address, Size, Alignment);
+   begin
+      null;
+   end Deallocate;
+
+   procedure Copy_To
+     (Model  : in out Shared_Model;
+      Target : Shared_Address;
+      Source : System.Address;
+      Size   : Storage_Count)
+   is
+      Ignored : System.Address;
+   begin
+      Model.Writes := Model.Writes + 1;
+      Model.Write_Bytes := Model.Write_Bytes + Size;
+      Ignored := C_Memcpy
+        (Model.Bytes (0)'Address + Storage_Offset (Target),
+         Source,
+         Interfaces.C.size_t (Size));
+   end Copy_To;
+
+   procedure Copy_From
+     (Model  : in out Shared_Model;
+      Target : System.Address;
+      Source : Shared_Address;
+      Size   : Storage_Count)
+   is
+      Ignored : System.Address;
+   begin
+      Model.Reads := Model.Reads + 1;
+      Model.Read_Bytes := Model.Read_Bytes + Size;
+      Put_Line
+        ("Copy_From source=" & Shared_Address'Image (Source)
+         & " size=" & Storage_Count'Image (Size));
+      Flush;
+      Ignored := C_Memcpy
+        (Target,
+         Model.Bytes (0)'Address + Storage_Offset (Source),
+         Interfaces.C.size_t (Size));
+   end Copy_From;
+
+   function Storage_Size (Model : Shared_Model) return Storage_Count is
+   begin
+      return Storage_Count (Model.Bytes'Length) - Storage_Count (Model.Next);
+   end Storage_Size;
+
+   Arena : Shared_Model;
+
+   type Node;
+   type Node_Pointer is access Node
+     with Designated_Storage_Model => Arena;
+   type Node is record
+      Value : Integer;
+      Next  : Node_Pointer;
+   end record;
+
+   type Integer_Array is array (Positive range <>) of Integer;
+   subtype Three_Integers is Integer_Array (1 .. 3);
+   type Array_Pointer is access Three_Integers
+     with Designated_Storage_Model => Arena;
+
+   P : Node_Pointer := new Node'(Value => 10, Next => null);
+   Q : Node_Pointer := new Node'(Value => 20, Next => null);
+   A : Array_Pointer := new Three_Integers'(1, 2, 3);
+
+   procedure Consume_Integer (Item, Expected : Integer) is
+   begin
+      pragma Assert (Item = Expected);
+   end Consume_Integer;
+
+   procedure Increment_Integer (Item : in out Integer) is
+   begin
+      Item := Item + 1;
+   end Increment_Integer;
+
+   procedure Consume_Node (Item : Node; Expected : Integer) is
+   begin
+      pragma Assert (Item.Value = Expected);
+   end Consume_Node;
+
+   procedure Increment_Node (Item : in out Node) is
+   begin
+      Item.Value := Item.Value + 1;
+   end Increment_Node;
+
+   procedure Assert_Read (Before : Natural) is
+   begin
+      pragma Assert (Arena.Reads > Before);
+   end Assert_Read;
+
+   procedure Assert_Write (Before : Natural) is
+   begin
+      pragma Assert (Arena.Writes > Before);
+   end Assert_Write;
+
+   Before_Reads  : Natural;
+   Before_Writes : Natural;
+   Got           : Integer;
+begin
+   --  Whole designated object as an IN actual.
+   Put_Line ("STEP whole-in");
+   Flush;
+   Before_Reads := Arena.Reads;
+   Consume_Node (P.all, 10);
+   Assert_Read (Before_Reads);
+
+   --  Explicit and implicit selected-component IN actuals.
+   Put_Line ("STEP selected-in");
+   Flush;
+   Before_Reads := Arena.Reads;
+   Consume_Integer (P.all.Value, 10);
+   Assert_Read (Before_Reads);
+
+   Put_Line ("STEP implicit-selected-in");
+   Flush;
+
+   Before_Reads := Arena.Reads;
+   Consume_Integer (P.Value, 10);
+   Assert_Read (Before_Reads);
+
+   --  Nested selected component, rooted at two model access values.
+   Put_Line ("STEP nested-in");
+   Flush;
+   P.Next := Q;
+   Before_Reads := Arena.Reads;
+   Consume_Integer (P.Next.Value, 20);
+   Assert_Read (Before_Reads);
+
+   --  Indexed component rooted at a model access value.
+   Put_Line ("STEP indexed-in");
+   Flush;
+   Before_Reads := Arena.Reads;
+   Consume_Integer (A.all (2), 2);
+   Assert_Read (Before_Reads);
+
+   Before_Reads := Arena.Reads;
+   Consume_Integer (A (3), 3);
+   Assert_Read (Before_Reads);
+
+   --  Scalar IN OUT host copy and copyback.
+   Put_Line ("STEP scalar-in-out");
+   Flush;
+   Before_Reads := Arena.Reads;
+   Before_Writes := Arena.Writes;
+   Increment_Integer (P.Value);
+   Assert_Read (Before_Reads);
+   Assert_Write (Before_Writes);
+   Got := P.Value;
+   pragma Assert (Got = 11);
+
+   --  Whole-record IN OUT host copy and copyback.
+   Put_Line ("STEP whole-in-out");
+   Flush;
+   Before_Reads := Arena.Reads;
+   Before_Writes := Arena.Writes;
+   Increment_Node (P.all);
+   Assert_Read (Before_Reads);
+   Assert_Write (Before_Writes);
+   Got := P.Value;
+   pragma Assert (Got = 12);
+
+   --  Assignment reads and writes retain normal source syntax.
+   Put_Line ("STEP assignments");
+   Flush;
+   Before_Reads := Arena.Reads;
+   Got := P.Value;
+   Assert_Read (Before_Reads);
+   pragma Assert (Got = 12);
+
+   Before_Writes := Arena.Writes;
+   P.Value := 30;
+   Assert_Write (Before_Writes);
+   Got := P.Value;
+   pragma Assert (Got = 30);
+
+   Before_Writes := Arena.Writes;
+   A (2) := 40;
+   Assert_Write (Before_Writes);
+   Got := A (2);
+   pragma Assert (Got = 40);
+
+   --  Access-value null and equality do not dereference the offset.
+   Put_Line ("STEP access-values");
+   Flush;
+   pragma Assert (P /= null);
+   pragma Assert (Q /= null);
+   pragma Assert (P = P);
+   pragma Assert (P /= Q);
+
+   Put_Line
+     ("PASS reads=" & Natural'Image (Arena.Reads)
+      & " writes=" & Natural'Image (Arena.Writes)
+      & " read_bytes=" & Storage_Count'Image (Arena.Read_Bytes)
+      & " write_bytes=" & Storage_Count'Image (Arena.Write_Bytes));
+end Storage_Model_Actuals;
