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 +! +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;