From: Paul Thomas <pault@gcc.gnu.org>
Date: Wed, 1 Oct 2025 07:14:00 +0000 (+0100)
Subject: Fortran: Generic interface checking with use associated PDTs [PR122089]
X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=37d794253e77d0a5aa682387a04b63411e9c2cf1;p=thirdparty%2Fgcc.git

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 a891dc86eae..f00f0e11378 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 00000000000..46697bf1c09
--- /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" } }