https://gcc.gnu.org/g:361903ad1affd508bafdb9b771d6a6ffc98a2100
commit r15-3707-g361903ad1affd508bafdb9b771d6a6ffc98a2100
Author: Andre Vehreschild <ve...@gcc.gnu.org>
Date: Fri Aug 23 09:07:09 2024 +0200
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:
---
gcc/fortran/trans-array.cc | 16 +++++++--------
gcc/fortran/trans-expr.cc | 2 +-
gcc/testsuite/gfortran.dg/coarray/alloc_comp_9.f90 | 23 ++++++++++++++++++++++
3 files changed, 32 insertions(+), 9 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 8c35926436d7..838b6d3da800 100644
--- 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 07e28a9f7a8d..01cf3f0ff148 100644
--- 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
index 000000000000..d8e739a07d87
--- /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 <gs...@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
+
