https://gcc.gnu.org/g:52154ade9695aed91e3f921d7cb4f0998a7e02bb
commit r16-5935-g52154ade9695aed91e3f921d7cb4f0998a7e02bb Author: Paul Thomas <[email protected]> Date: Sat Dec 6 08:00:21 2025 +0000 Fortran: [PDT] Mismatched types with same name in assignment [PR122670] 2025-12-06 Paul Thomas <[email protected]> gcc/fortran PR fortran/122670 * decl.cc (gfc_get_pdt_instance): Ensure that, in an interface body, PDT instances imported implicitly if the template has been explicitly imported. * module.cc (read_module): If a PDT template appears in a use only statement, implicitly add the instances as well. gcc/testsuite PR fortran/122670 * gfortran.dg/pdt_74.f03: New test. Diff: --- gcc/fortran/decl.cc | 22 ++++++++++++++++- gcc/fortran/module.cc | 14 +++++++++++ gcc/testsuite/gfortran.dg/pdt_74.f03 | 48 ++++++++++++++++++++++++++++++++++++ 3 files changed, 83 insertions(+), 1 deletion(-) diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc index 20260ec57ce7..dfedb962bad6 100644 --- a/gcc/fortran/decl.cc +++ b/gcc/fortran/decl.cc @@ -3969,6 +3969,7 @@ gfc_get_pdt_instance (gfc_actual_arglist *param_list, gfc_symbol **sym, gfc_expr *kind_expr; gfc_component *c1, *c2; match m; + gfc_symtree *s = NULL; type_param_spec_list = NULL; @@ -4178,10 +4179,29 @@ gfc_get_pdt_instance (gfc_actual_arglist *param_list, gfc_symbol **sym, goto error_return; } + /* If we are in an interface body, the instance will not have been imported. + Make sure that it is imported implicitly. */ + s = gfc_find_symtree (gfc_current_ns->sym_root, pdt->name); + if (gfc_current_ns->proc_name + && gfc_current_ns->proc_name->attr.if_source == IFSRC_IFBODY + && s && s->import_only && pdt->attr.imported) + { + s = gfc_find_symtree (gfc_current_ns->sym_root, instance->name); + if (!s) + { + gfc_get_sym_tree (instance->name, gfc_current_ns, &s, false, + &gfc_current_locus); + s->n.sym = instance; + } + s->n.sym->attr.imported = 1; + s->import_only = 1; + } + m = MATCH_YES; if (instance->attr.flavor == FL_DERIVED - && instance->attr.pdt_type) + && instance->attr.pdt_type + && instance->components) { instance->refs++; if (ext_param_list) diff --git a/gcc/fortran/module.cc b/gcc/fortran/module.cc index 262f72b8e7c3..9b845b5d57e0 100644 --- a/gcc/fortran/module.cc +++ b/gcc/fortran/module.cc @@ -5842,6 +5842,20 @@ read_module (void) || startswith (name, "__vtype_"))) p = name; + /* Include pdt_types if their associated pdt_template is in a + USE, ONLY list. */ + if (p == NULL && name[0] == 'P' + && startswith (name, "Pdt") + && module_list) + { + gfc_use_list *ml = module_list; + for (; ml; ml = ml->next) + if (ml->rename + && !strncmp (&name[3], ml->rename->use_name, + strlen (ml->rename->use_name))) + p = name; + } + /* Skip symtree nodes not in an ONLY clause, unless there is an existing symtree loaded from another USE statement. */ if (p == NULL) diff --git a/gcc/testsuite/gfortran.dg/pdt_74.f03 b/gcc/testsuite/gfortran.dg/pdt_74.f03 new file mode 100644 index 000000000000..c12db790bd11 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pdt_74.f03 @@ -0,0 +1,48 @@ +! { dg-do compile } +! +! Tests the fix for pr122670, where use only did not compile for PDTs. Also, it +! was found in the course of developing the fix that import only did not work +! either. +! +! Contributed by Damian Rouson <[email protected]> +! +module tensor_m + implicit none + + type tensor_t(k) + integer, kind :: k = kind(0.) + real(k), allocatable :: value_ + end type + + interface + function myfunc (arg) + import tensor_t + implicit none + type (tensor_t) myfunc + type (tensor_t), intent(in) :: arg + end function + end interface + +contains + function y(x) + type(tensor_t) x, y + y = tensor_t(x%value_) + end function +end module + +function myfunc (arg) + use tensor_m, only : tensor_t + implicit none + type (tensor_t) myfunc + type (tensor_t), intent(in) :: arg + myfunc = arg + myfunc%value_ = myfunc%value_ * 2.0 +end function + + use tensor_m, only : tensor_t, y, myfunc + implicit none + type(tensor_t) desired_output + desired_output = y(tensor_t(42.)) + desired_output = myfunc (desired_output) + print *, desired_output%value_ +end
