https://gcc.gnu.org/g:027f46816732f408aad6230516876948b3960df1
commit r17-5352-g027f46816732f408aad6230516876948b3960df1 Author: Paul Thomas <[email protected]> Date: Mon Oct 19 10:10:39 2026 +0100 Fortran: [PDT] (7/16) Parameterized derived type errors [PR82173] 2026-10-19 Paul Thomas <[email protected]> gcc/fortran PR fortran/82173 * trans-array.cc (structure_alloc_comps): While recursing into PDT components, it has to be checked that all the components of the param_list are explicit before allocating the paramterized components. If this not the case, use the components own param_ list to replace the assumed expressions. gcc/testsuite/ PR fortran/82173 * gfortran.dg/pdt_bug11.f90: New test. * gfortran.dg/pdt_bug21.f90: New test. Diff: --- gcc/fortran/trans-array.cc | 28 ++++++++++++++++++++----- gcc/testsuite/gfortran.dg/pdt_bug11.f90 | 37 +++++++++++++++++++++++++++++++++ gcc/testsuite/gfortran.dg/pdt_bug21.f90 | 33 +++++++++++++++++++++++++++++ 3 files changed, 93 insertions(+), 5 deletions(-) diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc index 80411f9df1a9..ab1aa6d457d5 100644 --- a/gcc/fortran/trans-array.cc +++ b/gcc/fortran/trans-array.cc @@ -11274,17 +11274,35 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, tree dest, /* Recurse in to PDT components. */ if ((IS_PDT (c) || IS_CLASS_PDT (c)) - && !(c->attr.pointer || c->attr.allocatable)) + && !(c->attr.pointer || c->attr.allocatable)) { - gfc_actual_arglist *tail = c->param_list; + gfc_actual_arglist *tail = c->param_list, *parms; + bool ext; + + ext = gfc_get_derived_super_type (der_type) == c->ts.u.derived; for (; tail; tail = tail->next) - if (tail->expr) - gfc_insert_parameter_exprs (tail->expr, pdt_param_list); + if (tail->spec_type != SPEC_EXPLICIT && tail->expr) + break; + + if (tail && ext) + /* 'der_type' extends the type of this component but has no + type parameters of its own and so some of the components + might be assumed. The pdt_param_list will have what is + needed. */ + parms = pdt_param_list; + else + /* Otherwise, use the component's type parameters. */ + { + tail = parms = c->param_list; + for (; tail; tail = tail->next) + if (tail->expr) + gfc_insert_parameter_exprs (tail->expr, pdt_param_list); + } tmp = gfc_allocate_pdt_comp (c->ts.u.derived, comp, c->as ? c->as->rank : 0, - c->param_list); + parms); gfc_add_expr_to_block (&fnblock, tmp); } diff --git a/gcc/testsuite/gfortran.dg/pdt_bug11.f90 b/gcc/testsuite/gfortran.dg/pdt_bug11.f90 new file mode 100644 index 000000000000..7e3acdadff9b --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pdt_bug11.f90 @@ -0,0 +1,37 @@ +! { dg-do run } +! See attachment to PR82173 comment 10 - reproducers/bug11-class-dummy-extension-len.f90 +module m4 + type :: base(k, n) + integer, kind :: k = 4 + integer, len :: n = 1 + real(k) :: v(n) + end type + type, extends(base) :: child + integer :: extra = 5 + end type +contains + subroutine show (c) + class(base(4, *)), intent(in) :: c + select type (c) + type is (base(4, *)) + if (c%n /= 3) stop 1 + if (size (c%v) /= 3) stop 2 + type is (child(4, *)) + if (c%n /= 5) stop 3 + if (size (c%v) /= 5) stop 4 + if (c%extra /= 42) stop 5 + class default + stop 6 + end select + end subroutine +end module +program i4 + use m4 + type(base(4, 3)) :: b + type(child(4, 5)) :: c + b%v = 0.0 + c%v = 0.0 + c%extra = 42 + call show (b) + call show (c) +end program diff --git a/gcc/testsuite/gfortran.dg/pdt_bug21.f90 b/gcc/testsuite/gfortran.dg/pdt_bug21.f90 new file mode 100644 index 000000000000..2881bd2b903f --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pdt_bug21.f90 @@ -0,0 +1,33 @@ +! { dg-do run } +! See attachment to PR82173 comment 10 - reproducers/bug21-assumed-dummy-corrupts-inherited-param.f90 +module base4_m + type :: base(k, n) + integer, kind :: k = 4 + integer, len :: n = 1 + real(k) :: b(n) + end type +end module +module ext4_m + use base4_m + type, extends(base) :: ext(m) + integer, len :: m = 1 + real(k) :: e(n + m) + end type +contains + integer function esize (a) + type(ext(4, *, *)), intent(in) :: a + esize = size (a%e) + end function +end module +program u4 + use ext4_m + type(ext(4, 2, 3)) :: x + x%b = 1.0 + x%e = 2.0 + if (x%k /= 4) stop 1 + if (x%n /= 2) stop 2 + if (x%m /= 3) stop 3 + if (esize (x) /= 5) stop 4 + if (int (sum (x%b)) /= x%n) stop 5 + if (int (sum (x%e)) /= 2 * (x%n + x%m)) stop 6 +end program
