https://gcc.gnu.org/g:cd98d18005dcda2af9e11fd84f8810e08e100cc3
commit r17-5612-gcd98d18005dcda2af9e11fd84f8810e08e100cc3 Author: Paul Thomas <[email protected]> Date: Tue Oct 27 12:57:32 2026 +0100 Fortran: [PDT] (11/16) Parameterized derived type errors [PR82173] 2026-10-27 Paul Thomas <[email protected]> gcc/fortran PR fortran/82173 * decl.cc (get_proc_name): Transfer the interface result parms to the stashed procedure decl 'sym->tlink'... (gfc_match_submod_proc): ... so that they can be copied to the final procedure symbol. * resolve.cc (resolve_pdt): Finally, transfer the parms to the explicit result, if present. * trans-decl.cc (gfc_trans_deferred_vars): If a PDT procedure result has no default initializer or it is in a submodule then allocate the parameterized components using its param_list if present. * trans-stmt.cc (gfc_trans_allocate): If a PDT MOLD expr3 is a variable, use the symbol's param_list. Assert that there is a param_list. gcc/testsuite/ PR fortran/82173 * gfortran.dg/pdt_bug16.f90: New test. * gfortran.dg/pdt_bug23.f90: New test. Diff: --- gcc/fortran/decl.cc | 11 ++++ gcc/fortran/resolve.cc | 9 ++- gcc/fortran/trans-decl.cc | 5 +- gcc/fortran/trans-stmt.cc | 6 ++ gcc/testsuite/gfortran.dg/pdt_bug16.f90 | 31 +++++++++++ gcc/testsuite/gfortran.dg/pdt_bug23.f90 | 98 +++++++++++++++++++++++++++++++++ 6 files changed, 158 insertions(+), 2 deletions(-) diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc index 63d4973c018b..88bdb54dd2fc 100644 --- a/gcc/fortran/decl.cc +++ b/gcc/fortran/decl.cc @@ -1378,6 +1378,7 @@ get_proc_name (const char *name, gfc_symbol **result, bool module_fcn_entry) if (sym->attr.module_procedure && sym->attr.if_source == IFSRC_IFBODY) { + gfc_actual_arglist *parms = NULL; /* Create a partially populated interface symbol to carry the characteristics of the procedure and the result. */ sym->tlink = gfc_new_symbol (name, sym->ns); @@ -1386,6 +1387,13 @@ get_proc_name (const char *name, gfc_symbol **result, bool module_fcn_entry) if (sym->attr.dimension) sym->tlink->as = gfc_copy_array_spec (sym->as); + /* The result parameters coming from the interface have to be copied + to the procedure symbol itself because of the modifications to + the result further downstream. This is required in trans-decl.cc + when the result is initialized. */ + if (sym->result && IS_PDT (sym->result) && sym->result->param_list) + parms = gfc_copy_actual_arglist (sym->result->param_list); + /* Ideally, at this point, a copy would be made of the formal arguments and their namespace. However, this does not appear to be necessary, albeit at the expense of not being able to @@ -1394,11 +1402,13 @@ get_proc_name (const char *name, gfc_symbol **result, bool module_fcn_entry) if (sym->result && sym->result != sym) { sym->tlink->result = sym->result; + sym->tlink->param_list = parms; sym->result = NULL; } else if (sym->result) { sym->tlink->result = sym->tlink; + sym->tlink->param_list = parms; } } else if (sym && !sym->gfc_new @@ -10811,6 +10821,7 @@ gfc_match_submod_proc (void) st->n.sym = sym->result; sym->result->refs++; } + sym->param_list = gfc_copy_actual_arglist (sym->tlink->param_list); } else sym->result = sym; diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc index bd1f36b0e5a0..099f996e54f2 100644 --- a/gcc/fortran/resolve.cc +++ b/gcc/fortran/resolve.cc @@ -18766,6 +18766,14 @@ resolve_pdt (gfc_symbol* sym) gcc_assert (derived->attr.pdt_type); + /* Now that the result symbol has been corrected for these module + procedures, we can transfer the param_list from the proc sym. */ + if (sym->abr_modproc_decl && sym->result && sym != sym->result) + { + sym->result->param_list = sym->param_list; + sym->param_list = NULL; + } + for (param = sym->param_list; param; param = param->next) { c = gfc_find_component (derived, param->name, false, true, NULL); @@ -18787,7 +18795,6 @@ resolve_pdt (gfc_symbol* sym) "or ALLOCATABLE attribute", sym->name, &sym->declared_at, param->name); - } if (!const_len_exprs diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc index 08252ac4f2ca..c8261d88b21f 100644 --- a/gcc/fortran/trans-decl.cc +++ b/gcc/fortran/trans-decl.cc @@ -5071,7 +5071,10 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block) if (sym && !sym->attr.allocatable && !sym->attr.pointer && sym->attr.referenced - && IS_PDT (sym) && !gfc_has_default_initializer (sym->ts.u.derived)) + && IS_PDT (sym) + && sym->param_list + && (!gfc_has_default_initializer (sym->ts.u.derived) + || proc_sym->attr.used_in_submodule)) { gfc_init_block (&tmpblock); tmp = gfc_allocate_pdt_comp (sym->ts.u.derived, diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc index 60db7fdba067..0906606b74aa 100644 --- a/gcc/fortran/trans-stmt.cc +++ b/gcc/fortran/trans-stmt.cc @@ -7754,10 +7754,16 @@ gfc_trans_allocate (gfc_code * code, gfc_omp_namelist *omp_allocate) if (code->expr3 && code->expr3->param_list) param_list = code->expr3->param_list; + else if (code->expr3 && code->expr3->mold + && code->expr3->expr_type == EXPR_VARIABLE) + param_list = code->expr3->symtree->n.sym->param_list; else if (expr->param_list) param_list = expr->param_list; else param_list = expr->symtree->n.sym->param_list; + + gcc_assert (param_list); + /* For array allocations the allocate-shape-spec expression has rank 0 even though the symbol is an array. Use the rank from the array descriptor when se.expr is a GFC descriptor so that diff --git a/gcc/testsuite/gfortran.dg/pdt_bug16.f90 b/gcc/testsuite/gfortran.dg/pdt_bug16.f90 new file mode 100644 index 000000000000..1b457620568e --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pdt_bug16.f90 @@ -0,0 +1,31 @@ +! { dg-do run } +! ALLOCATE with MOLD= did not propagate the LEN parameter; SOURCE= does. +! See attachment to PR82173 comment 10 - ~/reducers/bug16-mold-loses-len.f90 +program p + type :: t(n) + integer, len :: n = 1 + integer :: v(n) + end type + type(t(:)), allocatable :: viaSource, viaMold + type(t(5)) :: src1 + type(t(7)) :: src2 + src1%v = 1 + src2%v = 2 + allocate (viaSource, source=src1) + allocate (viaMold, mold=src1) + if (viaSource%n /= viaMold%n) stop 1 + if (size (viaSource%v, 1) /= size (viaMold%v, 1)) stop 2 +! +! Do it again with a different value for n +! + deallocate (viaSource, viaMold) + allocate (viaSource, source=src2) + allocate (viaMold, mold=src2) + viaMold%v = 2 + if (viaSource%n /= 7) stop 3 + if (viaSource%n /= viaMold%n) stop 4 + if (size (viaMold%v, 1) /= 7) stop 5 + if (size (viaSource%v, 1) /= size (viaMold%v, 1)) stop 6 + if (sum (viaSource%v) /= sum (viaMold%v)) stop 7 + deallocate (viaSource, viaMold) +end program diff --git a/gcc/testsuite/gfortran.dg/pdt_bug23.f90 b/gcc/testsuite/gfortran.dg/pdt_bug23.f90 new file mode 100644 index 000000000000..38ed4d842b32 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pdt_bug23.f90 @@ -0,0 +1,98 @@ +! { dg-do run } +! ALLOCATE with MOLD= did not propagate the LEN parameter; SOURCE= does. +! The abreviated form of MODULE PROCEDURE was found not to work and has been fixed. +! See attachment to PR82173 comment 10 - ~/reducers/bug23-submodule-pdt-result.f90 +module s_m + type :: t(n) + integer, len :: n = 1 + real :: v(n) + end type + interface +! First test the MODULE FUNCTIONs + module function make (arg1) result (r) ! Explicit result using integer arg + integer, intent(in) :: arg1 + type(t(arg1)) :: r + end function + module function make2 (arg1) result (r) ! Explicit result using deferred len arg + type(t(:)), allocatable :: arg1 + type(t(arg1%n)) :: r + end function + module function make3 (arg1) result (r) ! Explicit result using assumed len arg + type(t(*)) :: arg1 + type(t(arg1%n)) :: r + end function +! Then the MODULE PROCEDUREs + module function make4 (arg1) result (r) ! Explicit result using integer arg + integer, intent(in) :: arg1 + type(t(arg1)) :: r + end function + module function make5 (arg1) result (r) ! Explicit result using assumed len arg + type(t(*)), intent(in) :: arg1 + type(t(arg1%n)) :: r + end function + module function make6 (arg1) result (r) ! Explicit result using deferred len arg + type(t(:)), allocatable, intent(in) :: arg1 + type(t(arg1%n)) :: r + end function + end interface +end module + +submodule (s_m) s_impl +contains +! test module functions + module function make (arg1) result (r) + integer, intent(in) :: arg1 + type(t(arg1)) :: r + r%v = 2.0 + end function + module function make2 (arg1) result (r) + type(t(:)), allocatable :: arg1 + type(t(arg1%n)) :: r + if (allocated (arg1)) then + r = arg1 + else + allocate (arg1, source = t(5)([1.,2.,3.,4.,5.])) + r = arg1 + end if + end function + module function make3 (arg1) result (r) + type(t(*)) :: arg1 + type(t(arg1%n)) :: r + r%v = arg1%v - 5 + end function + +! Test module procedures + module procedure make4 + integer :: i + r%v = [(real (i), i = 1, size (r%v, 1))] + end procedure + module procedure make5 + r%v = 3.0 * arg1%v + end procedure + module procedure make6 + if (.not.allocated (arg1)) stop 99 + r%v = arg1%v / 3.0 + end procedure +end submodule + +program v3 + use s_m + type(t(5)) :: a + type(t(:)), allocatable :: b + integer :: i + a = make (5) + IF (a%n /= 5) STOP 1 + IF (INT (sum (a%v)) /= 10) STOP 2 + allocate (b, source = t(5)([1.,2.,3.,4.,5.])) + a = make2 (b) + if (int (sum (a%v)) /= 15) stop 3 + b = make3 (a) + if (int (sum (b%v)) /= -10) stop 4 + b = make4 (10) + if (any (int (b%v) /= [(i, i = 1, b%n)])) stop 5 + b = make5 (a) + if (any (int (b%v) /= 3 * int (a%v))) stop 6 + b = make6 (b) + if (int (sum (b%v)) /= 15) stop 7 + deallocate (b) +end program
