From: Paul Thomas <pault@gcc.gnu.org>
Date: Sat, 6 Dec 2025 08:00:21 +0000 (+0000)
Subject: Fortran: [PDT] Mismatched types with same name in assignment [PR122670]
X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=52154ade9695aed91e3f921d7cb4f0998a7e02bb;p=thirdparty%2Fgcc.git

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 20260ec57ce..dfedb962bad 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 262f72b8e7c..9b845b5d57e 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 00000000000..c12db790bd1
--- /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