Hi Harald and Jerry,
As it happens, I had done the regtesting, caught the failures of
value_optional_[1-2].f90 but failed to update the .diff for submission. Mea
culpa for not checking the submission.
More importantly, I forgot to deallocate the parameterized components - see
the attachment. Unlike the dereferencing error, this might have sat
undetected for a long time
This version has been regtested :-) I will push to mainline later today
unless there are any objections.
Thanks
Paul
On Sat, 30 Aug 2025 at 18:34, Harald Anlauf <[email protected]> wrote:
> Am 30.08.25 um 18:22 schrieb Jerry D:
> > On 8/30/25 9:16 AM, Harald Anlauf wrote:
> >> On 8/30/25 18:04, Jerry D wrote:
> >>> On 8/30/25 8:04 AM, Paul Richard Thomas wrote:
> >>>> 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
> >>>
> >>> Yes, OK and thanks for the fix.
> >>>
> >>> Regards,
> >>>
> >>> Jerry
> >>>
> >>
> >> Actually - and obviously - it is NOT OK. It fails here on
> >>
> >> gfortran.dg/value_optional_1.f90
> >> gfortran.dg/value_optional_2.f90
> >>
> >> because of the new non-caught NULL-pointer dereference here:
> >>
> >> 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)
> >>
> >> Note that e == NULL for a missing actual argument, so you need to
> >> check for this case.
> >>
> >> Thanks,
> >> Harald
> >>
> >
> > oops, reviewed and did not apply and test. my bad.
>
> Yes, happens all the time ... ;-)
>
> (Seems that Paul short-cut the regtesting.)
>
> I just happen to know these testcases very well.
>
> > Jerry
> >
>
>
diff --git a/gcc/doc/install.texi b/gcc/doc/install.texi
index f404a922d40..cb48e248186 100644
--- a/gcc/doc/install.texi
+++ b/gcc/doc/install.texi
@@ -3803,8 +3803,7 @@ Microsoft Windows:
@item
The @uref{https://sourceware.org/cygwin/,,Cygwin} project;
@item
-The @uref{https://osdn.net/projects/mingw/,,MinGW} and
-@uref{https://www.mingw-w64.org/,,mingw-w64} projects.
+the @uref{https://www.mingw-w64.org/,,mingw-w64} project.
@end itemize
@item
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 193bac51240..0449c26ce6d 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..6a21e8c10e8 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -6520,6 +6520,20 @@ conv_dummy_value (gfc_se * parmse, gfc_expr * e, gfc_symbol * fsym,
gcc_assert (fsym && fsym->attr.value && !fsym->attr.dimension);
+ if (e && 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;
+ tmp = gfc_deallocate_pdt_comp (e->ts.u.derived, tmp, e->rank);
+ gfc_add_expr_to_block (&parmse->post, 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 <[email protected]>
+!
+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
