[Patch, fortran] PR122089 - generic resolution problem with composite PDT

[Paul Richard Thomas]

The testcase was failing at
interface.cc(gfc_compare_derived_types):683 and so a specific
procedure was not being found. I posted a "fix" on the PR, which works
but is incorrect. The attached fixes this by ensuring that PDT
instances of a use associated PDT template, take the use association
and module name from the template. This allows the strcmp to pass and
the generic matching to succeed.

Regtested on FC42/x86_64. OK for mainline?

Paul

Change.Logs
Description: Binary data

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" } }