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

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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 6e00cdc64b03db6a54d92645a2b93aec89e4bf69..8faf7ec01e7cc3ff652bd7fc48b2677875647d83 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,11 @@
+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

diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index 339dd243c127256e1b589e0d9f62b1ff5cc7a5e4..9055cf538f12ed98cd147a56b509a7e275fd023b 100644 (file)
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -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;
 }
 

diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index c72974dc00338f1fd5d53ac62f39f9f745b593a6..9d23e8b48a3f8ada857fbbd19a4f5ed7aa6a619d 100644 (file)
--- 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);