Commit 60de1c7d by Tobias Burnus Committed by Tobias Burnus

re PR fortran/57530 ([OOP] Wrongly rejects type_pointer => class_target (which…

re PR fortran/57530 ([OOP] Wrongly rejects  type_pointer => class_target (which have identical declared type))

2013-07-30  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.

From-SVN: r201329
parent b882aaa8
2013-07-30 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-07-30 Tobias Burnus <burnus@net-b.de>
PR fortran/57530
* trans-expr.c (gfc_trans_class_assign): Handle CLASS array
functions.
(gfc_trans_pointer_assign): Ditto and support pointer assignment of
......
......@@ -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);
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment