Fortran: [PDT] Mismatched types with same name in assignment [PR122670]

2025-12-06  Paul Thomas  <pault@gcc.gnu.org>

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 --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc
index 20260ec57ce79f5268affefc3c15a27bef45f25c..dfedb962bad60d08236669075fec88ca05c5b675 100644 (file)
--- 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 262f72b8e7c32dbe4c48d8d2902de52018127198..9b845b5d57e052c2f32837162b017531119b6bfc 100644 (file)
--- 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 (file)
index 0000000..c12db79
--- /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  <damian@archaeologic.codes>
+!
+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