Message ID | 51AF2896.1030800@net-b.de |
---|---|
State | New |
Headers | show |
I accidentally attached a slightly out-dated patch. The old patch permitted CLASS<->TYPE differences in cases where the characteristic had to match (e.g. dummy arguments in a proc-pointer assignment). - Sorry for the confusion. Build and regtested on x86-64-gnu-linux. OK for the trunk? Tobias Tobias Burnus wrote: > A TYPE is type compatible with a CLASS if both have the same declared > type. > > Or in words of the standard (cf. PR): > "A nonpolymorphic entity is type compatible only with entities of the > same declared type. A polymorphic entity that is not an unlimited > polymorphic entity is type compatible with entities of the same > declared type or any of its extensions." (F2008, 4.3.1.3). > > Build and regtested on x86-64-gnu-linux. > OK for the trunk?
2013-06-05 Tobias Burnus <burnus@net-b.de> PR fortran/57530 * symbol.c (gfc_type_compatible): A type is type compatible with a class if both have the same declared type. 2013-06-05 Tobias Burnus <burnus@net-b.de> PR fortran/57530 * gfortran.dg/pointer_assign_8.f90: New. diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c index c72974d..9d23e8b 100644 --- a/gcc/fortran/symbol.c +++ b/gcc/fortran/symbol.c @@ -4489,6 +4489,9 @@ gfc_type_compatible (gfc_typespec *ts1, gfc_typespec *ts2) if (is_derived1 && is_derived2) return gfc_compare_derived_types (ts1->u.derived, ts2->u.derived); + if (is_derived1 && is_class2) + return gfc_compare_derived_types (ts1->u.derived, + ts2->u.derived->components->ts.u.derived); if (is_class1 && is_derived2) return gfc_type_is_extension_of (ts1->u.derived->components->ts.u.derived, ts2->u.derived); --- /dev/null 2013-06-05 09:13:09.179105369 +0200 +++ gcc/gcc/testsuite/gfortran.dg/pointer_assign_8.f90 2013-06-05 13:55:12.580621132 +0200 @@ -0,0 +1,14 @@ +! { dg-do compile } +! +! PR fortran/57530 +! +module m + type t + end type t +contains + subroutine sub (tgt) + class(t), target :: tgt + type(t), pointer :: ptr + ptr => tgt ! TYPE => CLASS of same declared type + end subroutine sub +end module m