https://gcc.gnu.org/g:37d794253e77d0a5aa682387a04b63411e9c2cf1
commit r16-4153-g37d794253e77d0a5aa682387a04b63411e9c2cf1 Author: Paul Thomas <[email protected]> Date: Wed Oct 1 08:14:00 2025 +0100 Fortran: Generic interface checking with use associated PDTs [PR122089] 2025-10-01 Paul Thomas <[email protected]> gcc/fortran PR fortran/122089 * decl.cc (gfc_get_pdt_instance): If the pdt_template is use associated, 'module' field should be copied to this instance. gcc/testsuite/ PR fortran/122089 * gfortran.dg/pdt_51.f03: New test. Diff: --- gcc/fortran/decl.cc | 2 ++ gcc/testsuite/gfortran.dg/pdt_51.f03 | 57 ++++++++++++++++++++++++++++++++++++ 2 files changed, 59 insertions(+) diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc index a891dc86eae9..f00f0e11378c 100644 --- a/gcc/fortran/decl.cc +++ b/gcc/fortran/decl.cc @@ -4076,6 +4076,8 @@ gfc_get_pdt_instance (gfc_actual_arglist *param_list, gfc_symbol **sym, /* Start building the new instance of the parameterized type. */ gfc_copy_attr (&instance->attr, &pdt->attr, &pdt->declared_at); + if (pdt->attr.use_assoc) + instance->module = pdt->module; instance->attr.pdt_template = 0; instance->attr.pdt_type = 1; instance->declared_at = gfc_current_locus; diff --git a/gcc/testsuite/gfortran.dg/pdt_51.f03 b/gcc/testsuite/gfortran.dg/pdt_51.f03 new file mode 100644 index 000000000000..46697bf1c09a --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pdt_51.f03 @@ -0,0 +1,57 @@ +! { dg-do compile } +! { dg-options "-fdump-tree-original" } +! +! Test the fix for PR122089 in which the generic interface checking failed. +! +! Contributed by Damian Rouson <[email protected]> +! +module tensor_m + implicit none + + type tensor_t(k) + integer, kind :: k = kind(1.) + real(k) values_ + contains + generic :: values => double_precision_values + procedure double_precision_values + end type + +contains + function double_precision_values(self) + class(tensor_t(kind(1D0))) self + double precision double_precision_values + double_precision_values = self%values_ + end function +end module + +module input_output_pair_m + use tensor_m, only : tensor_t + implicit none + + type input_output_pair_t(k) + integer, kind :: k = kind(1.) + type(tensor_t(k)) inputs_ + end type + + interface + module subroutine double_precision_write_to_stdout(input_output_pairs) + implicit none + type(input_output_pair_t(kind(1D0))) input_output_pairs + end subroutine + end interface +end module + +submodule(input_output_pair_m) input_output_pair_s + implicit none +contains + module procedure double_precision_write_to_stdout + print *, input_output_pairs%inputs_%values() + end procedure +end submodule + + use input_output_pair_m + type(input_output_pair_t(kind(1d0))) :: tgt + tgt%inputs_%values_ = 42d0 + call double_precision_write_to_stdout(tgt) +end +! { dg-final { scan-tree-dump-times "double_precision_write_to_stdout \\(&tgt\\);" 1 "original" } }
