diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 7d8274ab57187671c4fd3d0066a502b960edae63..0b8ef0b5e018f943e0bb8af81814d08f6e08c32d 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -9505,6 +9505,7 @@ duplicate_allocatable_coarray (tree dest, tree dest_tok, tree src, tree type,
 				  gfc_build_addr_expr (NULL_TREE, dest_tok),
 				  NULL_TREE, NULL_TREE, NULL_TREE,
 				  GFC_CAF_COARRAY_ALLOC_REGISTER_ONLY);
+      gfc_add_modify (&block, dest, gfc_conv_descriptor_data_get (dummy_desc));
       null_data = gfc_finish_block (&block);
 
       gfc_init_block (&block);
@@ -9514,6 +9515,7 @@ duplicate_allocatable_coarray (tree dest, tree dest_tok, tree src, tree type,
 				  gfc_build_addr_expr (NULL_TREE, dest_tok),
 				  NULL_TREE, NULL_TREE, NULL_TREE,
 				  GFC_CAF_COARRAY_ALLOC);
+      gfc_add_modify (&block, dest, gfc_conv_descriptor_data_get (dummy_desc));
 
       tmp = builtin_decl_explicit (BUILT_IN_MEMCPY);
       tmp = build_call_expr_loc (input_location, tmp, 3, dest, src,
diff --git a/gcc/testsuite/gfortran.dg/coarray/alloc_comp_10.f90 b/gcc/testsuite/gfortran.dg/coarray/alloc_comp_10.f90
new file mode 100644
index 0000000000000000000000000000000000000000..a31d005498c11d1cb664b2a5e1d17e78a517474b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/alloc_comp_10.f90
@@ -0,0 +1,24 @@
+!{ dg-do run }
+
+! Check that copying of memory for allocated scalar is assigned
+! to coarray object.
+
+! Contributed by G. Steinmetz  <gscfq@t-online.de>
+
+program p
+  type t
+    integer, allocatable :: a
+  end type
+  type t2
+    type(t), allocatable :: b
+  end type
+  type(t2) :: x, y[*]
+
+  x%b = t(1)
+  y = x
+  y%b%a = 2
+
+  if (x%b%a /= 1) stop 1
+  if (y%b%a /= 2) stop 2
+end
+