[Patch, fortran] PR87669 -Select type, incorrect handling of parameterized derived type

[Paul Richard Thomas]

Hi All,

The attached ChangeLogs explain the chunk in expr.cc. The chunk
in is_extension_of was something of a surprise to me since I thought that
we had stopped using the hash to identify derived types and to restrict
their use to intrinsic types a long time ago. Using the vptr location is
unambiguous.

Regtests (yes, really :-) ) on FC42, x86_64. OK for mainline?

Paul

Change.Logs
Description: Binary data

diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc
index b8d04ff6f36..97f931a3792 100644
--- a/gcc/fortran/expr.cc
+++ b/gcc/fortran/expr.cc
@@ -5911,6 +5911,7 @@ gfc_spec_list_type (gfc_actual_arglist *param_list, gfc_symbol *derived)
   gfc_component *c;
   bool seen_assumed = false;
   bool seen_deferred = false;
+  bool seen_len = false;
 
   if (derived == NULL)
     {
@@ -5932,10 +5933,12 @@ gfc_spec_list_type (gfc_actual_arglist *param_list, gfc_symbol *derived)
 	    return SPEC_EXPLICIT;
 	  seen_assumed = param_list->spec_type == SPEC_ASSUMED;
 	  seen_deferred = param_list->spec_type == SPEC_DEFERRED;
+	  if (c->attr.pdt_len)
+	    seen_len = true;
 	  if (seen_assumed && seen_deferred)
 	    return SPEC_EXPLICIT;
 	}
-      res = seen_assumed ? SPEC_ASSUMED : SPEC_DEFERRED;
+      res = (seen_assumed || !seen_len) ? SPEC_ASSUMED : SPEC_DEFERRED;
     }
   return res;
 }
diff --git a/gcc/testsuite/gfortran.dg/pdt_41.f03 b/gcc/testsuite/gfortran.dg/pdt_41.f03
new file mode 100644
index 00000000000..47743d13201
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pdt_41.f03
@@ -0,0 +1,46 @@
+! { dg-do run )
+!
+! Test the fix for PR87669 in which SELECT TYPE was not identifying the difference
+! between derived types with different type kind parameters, when the selector
+! is unlimited polymorphic.
+!
+! Contributed by Etienne Descamps  <etdesc...@gmail.com>
+!
+Program Devtest
+  Type dvtype(k)
+    Integer, Kind :: k
+    Real(k) :: a, b, c
+  End Type dvtype
+  type(dvtype(8)) :: dv
+  type(dvtype(4)) :: fv
+  integer :: ctr = 0
+
+  dv%a = 1; dv%b = 2; dv%c = 3
+  call dvtype_print(dv)
+  if (ctr /= 2) stop 1
+
+  fv%a = 1; fv%b = 2; fv%c = 3
+  call dvtype_print(fv)
+  if (ctr /= 0) stop 2
+
+Contains
+  Subroutine dvtype_print(p)
+    class(*), intent(in) :: p
+    Select Type(p)
+    class is (dvtype(4))
+      ctr = ctr - 1
+    End Select
+    Select Type(p)
+    class is (dvtype(8))
+      ctr = ctr + 1
+    End Select
+    Select Type(p)
+    type is (dvtype(4))
+      ctr = ctr - 1
+    End Select
+    Select Type(p)
+    type is (dvtype(8))
+      ctr = ctr + 1
+    End Select
+  End Subroutine dvtype_print
+End
diff --git a/libgfortran/intrinsics/extends_type_of.c b/libgfortran/intrinsics/extends_type_of.c
index 8768b2d52c3..dab14ee140f 100644
--- a/libgfortran/intrinsics/extends_type_of.c
+++ b/libgfortran/intrinsics/extends_type_of.c
@@ -58,7 +58,7 @@ is_extension_of (struct vtype *v1, struct vtype *v2)
 
   while (v1)
     {
-      if (v1->hash == v2->hash) return 1;
+      if (v1 == v2) return 1;
       v1 = v1->extends;
     }
   return 0;