diff options
| author | Paul Thomas <pault@gcc.gnu.org> | 2025-09-02 21:48:55 +0100 |
|---|---|---|
| committer | Paul Thomas <pault@gcc.gnu.org> | 2025-09-02 21:48:55 +0100 |
| commit | 2d93be8907fa33f8791409490ed06e45de5c8420 (patch) | |
| tree | c7c3d248998e163883dd4e6e6e4bb63a4b8dcbfa /gcc | |
| parent | 4ce7722c02e449b5f9947a255705502d13632c90 (diff) | |
| download | gcc-2d93be8907fa33f8791409490ed06e45de5c8420.zip gcc-2d93be8907fa33f8791409490ed06e45de5c8420.tar.gz gcc-2d93be8907fa33f8791409490ed06e45de5c8420.tar.bz2 | |
Fortran: Handle PDTs correctly with unlimited selector [PR87669]
2025-09-02 Paul Thomas <pault@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.
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/fortran/expr.cc | 5 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/pdt_42.f03 | 46 |
2 files changed, 50 insertions, 1 deletions
diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc index b8d04ff..97f931a 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 0000000..47743d1 --- /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 <etdescdev@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 |