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.
* interface.c (compare_type): Reject CLASS/TYPE even if they
are type compatible.
2013-06-05 Tobias Burnus <burnus@net-b.de>
PR fortran/57530
* gfortran.dg/pointer_assign_8.f90: New.
@@ -514,6 +514,12 @@ compare_type (gfc_symbol *s1, gfc_symbol *s2)
if (s2->attr.ext_attr & (1 << EXT_ATTR_NO_ARG_CHECK))
return 1;
+ /* TYPE and CLASS of the same declared type are type compatible,
+ but have different characteristics. */
+ if ((s1->ts.type == BT_CLASS && s2->ts.type == BT_DERIVED)
+ || (s1->ts.type == BT_DERIVED && s2->ts.type == BT_CLASS))
+ return 0;
+
return gfc_compare_types (&s1->ts, &s2->ts) || s2->ts.type == BT_ASSUMED;
}
@@ -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);
@@ -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