https://gcc.gnu.org/g:2d93be8907fa33f8791409490ed06e45de5c8420
commit r16-3528-g2d93be8907fa33f8791409490ed06e45de5c8420
Author: Paul Thomas <pa...@gcc.gnu.org>
Date: Tue Sep 2 21:48:55 2025 +0100
Fortran: Handle PDTs correctly with unlimited selector [PR87669]
2025-09-02 Paul Thomas <pa...@gcc.gnu.org>
gcc/fortran
PR fortran/87669
* expr.cc (gfc_spec_list_type): If no LEN components are seen,
unconditionally return 'SPEC_ASSUMED'. This suppresses an
invalid error in match.cc(gfc_match_type_is).
gcc/testsuite/
PR fortran/87669
* gfortran.dg/pdt_42.f03: New test.
libgfortran/
PR fortran/87669
* intrinsics/extends_type_of.c (is_extension_of): Use the vptr
rather than the hash value to identify the types.
Diff:
---
gcc/fortran/expr.cc | 5 +++-
gcc/testsuite/gfortran.dg/pdt_42.f03 | 46 ++++++++++++++++++++++++++++++++
libgfortran/intrinsics/extends_type_of.c | 2 +-
3 files changed, 51 insertions(+), 2 deletions(-)
diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc
index b8d04ff6f365..97f931a3792d 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_42.f03
b/gcc/testsuite/gfortran.dg/pdt_42.f03
new file mode 100644
index 000000000000..47743d132014
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pdt_42.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 8768b2d52c39..dab14ee140fb 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;
