Hi all,
attached patch fixes deep-copying (or rather its former absence) for
allocatable components of derived types having cyclic dependencies.
Regtested ok on x86_64-pc-linux-gnu / F41. Ok for mainline?
Regards,
Andre
--
Andre Vehreschild * Email: vehre ad gmx dot de
From 4721060d14920335c1b50816d93196c847064ebe Mon Sep 17 00:00:00 2001
From: Andre Vehreschild <ve...@gcc.gnu.org>
Date: Fri, 13 Dec 2024 12:07:01 +0100
Subject: [PATCH] Fortran: Ensure deep copy of allocatable components in cylic
types [PR114612]
gcc/fortran/ChangeLog:
PR fortran/114612
* trans-array.cc (structure_alloc_comps): Ensure deep copy is
also done for types having cycles.
gcc/testsuite/ChangeLog:
* gfortran.dg/alloc_comp_deep_copy_4.f03: New test.
---
gcc/fortran/trans-array.cc | 7 ++---
.../gfortran.dg/alloc_comp_deep_copy_4.f03 | 29 +++++++++++++++++++
2 files changed, 32 insertions(+), 4 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/alloc_comp_deep_copy_4.f03
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 366127d5651..bec14ec254c 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -10583,10 +10583,9 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, tree dest,
false, false, NULL_TREE, NULL_TREE);
gfc_add_expr_to_block (&fnblock, tmp);
}
- else if ((c->attr.allocatable)
- && !c->attr.proc_pointer && !same_type
- && (!(cmp_has_alloc_comps && c->as) || c->attr.codimension
- || caf_in_coarray (caf_mode)))
+ else if (c->attr.allocatable && !c->attr.proc_pointer
+ && (!(cmp_has_alloc_comps && c->as) || c->attr.codimension
+ || caf_in_coarray (caf_mode)))
{
rank = c->as ? c->as->rank : 0;
if (c->attr.codimension)
diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_deep_copy_4.f03 b/gcc/testsuite/gfortran.dg/alloc_comp_deep_copy_4.f03
new file mode 100644
index 00000000000..3c445be032f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/alloc_comp_deep_copy_4.f03
@@ -0,0 +1,29 @@
+!{ dg-do run }
+!
+! Contributed Vladimir Terzi <vterzi1...@gmail.com>
+! Check that deep-copy for b=a works.
+
+program pr114672
+ type node
+ integer::val
+ type(node),allocatable::next
+ end type
+
+ type(node)::a,b
+
+ allocate(a%next)
+ a%val=1
+ a%next%val=2
+! print*,a%val,a%next%val
+ b=a
+ b%val=3
+ b%next%val=4
+ if (loc(b) == loc(a)) stop 1
+ if (loc(b%next) == loc(a%next)) stop 2
+! print*,a%val,a%next%val
+ deallocate(b%next)
+ if (.NOT. allocated(a%next)) stop 3
+! print*,a%val,a%next%val
+ deallocate(a%next)
+end
+
--
2.47.1
