Fortran: Generic interface checking with use associated PDTs [PR122089]

2025-10-01  Paul Thomas  <pault@gcc.gnu.org>

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 --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc
index a891dc86eae9a98ce1f3e7a881f1473e76cd867c..f00f0e11378cdac5949308b70524be8b880bb44b 100644 (file)
--- 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 (file)
index 0000000..46697bf
--- /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  <damian@archaeologic.codes>
+!
+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" } }