Hi All, This patch is only a temporary fix because the chunks in trans-array.cc are representation dependent. As a whole, the patch is so straightforward that the ChangeLog serves as an explanation.
Regtests with FC32/x86_64 - OK for mainline? Paul
Change.Logs
Description: Binary data
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 7e6437bbdf7..af6d1e5e63d 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -10710,6 +10710,15 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, tree dest,
cdecl, NULL_TREE);
dcmp = fold_convert (TREE_TYPE (comp), dcmp);
+ if (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.pdt_type
+ && !c->attr.allocatable)
+ {
+ tmp = gfc_copy_alloc_comp (c->ts.u.derived, comp, dcmp,
+ 0, 0);
+ gfc_add_expr_to_block (&fnblock, tmp);
+ continue;
+ }
+
if (c->ts.type == BT_CLASS && CLASS_DATA (c)->attr.allocatable)
{
tree ftn_tree;
@@ -10829,7 +10838,8 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, tree dest,
false, false, size, NULL_TREE);
gfc_add_expr_to_block (&fnblock, tmp);
}
- else if (c->attr.pdt_array)
+ else if (c->attr.pdt_array
+ && !c->attr.allocatable && !c->attr.pointer)
{
tmp = duplicate_allocatable (dcmp, comp, ctype,
c->as ? c->as->rank : 0,
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 69952b33eaa..771d2c24fa9 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -6520,6 +6520,18 @@ conv_dummy_value (gfc_se * parmse, gfc_expr * e, gfc_symbol * fsym,
gcc_assert (fsym && fsym->attr.value && !fsym->attr.dimension);
+ if (e->ts.type == BT_DERIVED && e->ts.u.derived->attr.pdt_type)
+ {
+ tmp = gfc_create_var (TREE_TYPE (parmse->expr), "PDT");
+ gfc_add_modify (&parmse->pre, tmp, parmse->expr);
+ gfc_add_expr_to_block (&parmse->pre,
+ gfc_copy_alloc_comp (e->ts.u.derived,
+ parmse->expr, tmp,
+ e->rank, 0));
+ parmse->expr = tmp;
+ return;
+ }
+
/* Absent actual argument for optional scalar dummy. */
if ((e == NULL || e->expr_type == EXPR_NULL) && fsym->attr.optional)
{
diff --git a/gcc/testsuite/gfortran.dg/pdt_41.f03 b/gcc/testsuite/gfortran.dg/pdt_41.f03
new file mode 100644
index 00000000000..be2e871c2fc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pdt_41.f03
@@ -0,0 +1,47 @@
+! { dg-do run }
+!
+! Test the fix for pr99709 in which the object being passed to a PDT dummy
+! with the value attribute was not a deep copy.
+!
+! Contribute by Xiao Liu <xiao....@compiler-dev.com>
+!
+program value_f2008
+ implicit none
+ type :: matrix(k)
+ integer, len :: k
+ integer :: elements(k, k)
+ !integer :: elements(2, 2)
+ end type matrix
+
+ type, extends(matrix) :: child
+ end type child
+
+ integer, parameter :: array_parm(2, 2) = reshape([1, 2, 3, 4], [2, 2])
+
+ type(child(2)) :: obj
+ obj%elements = array_parm
+
+ call test_value_attr(2, obj)
+ if (any (obj%elements /= array_parm)) stop 1
+
+ call test(2, obj)
+ if (any (obj%elements /= 0)) stop 2
+
+contains
+
+ subroutine test(n, nonconstant_length_object)
+ integer :: n
+ type(child(n)) :: nonconstant_length_object
+ if (nonconstant_length_object%k /= 2) stop 3
+ if (any (nonconstant_length_object%elements /= array_parm)) stop 4
+ nonconstant_length_object%elements = 0
+ end subroutine test
+
+ subroutine test_value_attr(n, nonconstant_length_object)
+ integer :: n
+ type(child(n)), value :: nonconstant_length_object
+ if (nonconstant_length_object%k /= 2) stop 5
+ if (any (nonconstant_length_object%elements /= array_parm)) stop 6
+ nonconstant_length_object%elements = 0
+ end subroutine test_value_attr
+end program value_f2008
