Fix deep copy allocatable components in coarrays. [PR85002]

Fix code for deep copy of allocatable components in derived type nested
structures generated, but not inserted when the copy had to be done in
a coarray.  Additionally fix a comment.

gcc/fortran/ChangeLog:

	PR fortran/85002
	* trans-array.cc (duplicate_allocatable_coarray): Allow adding
	of deep copy code in the when-allocated case.  Add bounds
	computation before condition, because coarrays need the bounds
	also when not allocated.
	(structure_alloc_comps): Duplication in the coarray case is done
	already, omit it.  Add the deep-code when duplication a coarray.
	* trans-expr.cc (gfc_trans_structure_assign): Fix comment.

gcc/testsuite/ChangeLog:

	* gfortran.dg/coarray/alloc_comp_9.f90: New test.

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 8c35926436d7364d5893a08c163852c07a0b7ba3..838b6d3da800d5ee174f0f70690825d4a30e90c6 100644 (file)
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -9417,10 +9417,9 @@ gfc_duplicate_allocatable_nocopy (tree dest, tree src, tree type, int rank)
                                NULL_TREE, NULL_TREE);
 }
 
-
 static tree
-duplicate_allocatable_coarray (tree dest, tree dest_tok, tree src,
-                              tree type, int rank)
+duplicate_allocatable_coarray (tree dest, tree dest_tok, tree src, tree type,
+                              int rank, tree add_when_allocated)
 {
   tree tmp;
   tree size;
@@ -9474,7 +9473,7 @@ duplicate_allocatable_coarray (tree dest, tree dest_tok, tree src,
       gfc_add_modify (&globalblock, tmp, build_int_cst (TREE_TYPE (tmp), rank));
 
       if (rank)
-       nelems = gfc_full_array_size (&block, src, rank);
+       nelems = gfc_full_array_size (&globalblock, src, rank);
       else
        nelems = integer_one_node;
 
@@ -9505,7 +9504,7 @@ duplicate_allocatable_coarray (tree dest, tree dest_tok, tree src,
                                 fold_convert (size_type_node, size));
       gfc_add_expr_to_block (&block, tmp);
     }
-
+  gfc_add_expr_to_block (&block, add_when_allocated);
   tmp = gfc_finish_block (&block);
 
   /* Null the destination if the source is null; otherwise do
@@ -9684,7 +9683,7 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, tree dest,
         gfc_duplicate_allocatable (), where the deep copy code is just added
         into the if's body, by adding tmp (the deep copy code) as last
         argument to gfc_duplicate_allocatable ().  */
-      if (purpose == COPY_ALLOC_COMP
+      if (purpose == COPY_ALLOC_COMP && caf_mode == 0
          && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (dest)))
        tmp = gfc_duplicate_allocatable (dest, decl, decl_type, rank,
                                         tmp);
@@ -10414,8 +10413,9 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, tree dest,
                                                 c->caf_token,
                                                 NULL_TREE);
                    }
-                 tmp = duplicate_allocatable_coarray (dcmp, dst_tok, comp,
-                                                      ctype, rank);
+                 tmp
+                   = duplicate_allocatable_coarray (dcmp, dst_tok, comp, ctype,
+                                                    rank, add_when_allocated);
                }
              else
                tmp = gfc_duplicate_allocatable (dcmp, comp, ctype, rank,

diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 07e28a9f7a8db802a640d247b3821d0c1f4adaa1..01cf3f0ff148c392ddd284768b3d8984f0d3522a 100644 (file)
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -9645,7 +9645,7 @@ gfc_trans_structure_assign (tree dest, gfc_expr * expr, bool init, bool coarray)
 
       /* Register the component with the caf-lib before it is initialized.
         Register only allocatable components, that are not coarray'ed
-        components (%comp[*]).  Only register when the constructor is not the
+        components (%comp[*]).  Only register when the constructor is the
         null-expression.  */
       if (coarray && !cm->attr.codimension
          && (cm->attr.allocatable || cm->attr.pointer)

diff --git a/gcc/testsuite/gfortran.dg/coarray/alloc_comp_9.f90 b/gcc/testsuite/gfortran.dg/coarray/alloc_comp_9.f90
new file mode 100644 (file)
index 0000000..d8e739a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/alloc_comp_9.f90
@@ -0,0 +1,23 @@
+!{ dg-do run }
+
+! Check PR85002 is fixed.
+! Contributed by G. Steinmetz  <gscfq@t-online.de>
+
+program pr85002
+   type t
+      integer, allocatable :: a(:)
+   end type
+   type t2
+      type(t), allocatable :: b(:)
+   end type
+   type(t) :: x
+   type(t2) :: y(2)[*]
+
+   allocate (x%a(2))
+   x%a = 123
+   y = t2([x])
+
+   if (.not. all((/(allocated(y(i)%b), i=1, 2)/))) stop 1
+   if (any ((/(y(i)%b(1)%a /= 123, i=1,2)/))) stop 2
+end
+