1 files changed, 43 insertions, 11 deletions

diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index f6ce3cf..39285b1 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -2644,6 +2644,13 @@ gfc_get_ha_sym_tree (const char *name, gfc_symtree **result)
   int i;
 
   i = gfc_find_sym_tree (name, gfc_current_ns, 0, &st);
+
+  /* Special case: If we're in a SELECT TYPE block,
+     replace the selector variable by a temporary.  */
+  if (gfc_current_state () == COMP_SELECT_TYPE
+      && st && st->n.sym == type_selector)
+    st = select_type_tmp;
+
   if (st != NULL)
     {
       save_symbol_data (st->n.sym);
@@ -4534,6 +4541,34 @@ gfc_get_derived_super_type (gfc_symbol* derived)
 }
 
 
+/* Get the ultimate super-type of a given derived type.  */
+
+gfc_symbol*
+gfc_get_ultimate_derived_super_type (gfc_symbol* derived)
+{
+  if (!derived->attr.extension)
+    return NULL;
+
+  derived = gfc_get_derived_super_type (derived);
+
+  if (derived->attr.extension)
+    return gfc_get_ultimate_derived_super_type (derived);
+  else
+    return derived;
+}
+
+
+/* Check if a derived type t2 is an extension of (or equal to) a type t1.  */
+
+bool
+gfc_type_is_extension_of (gfc_symbol *t1, gfc_symbol *t2)
+{
+  while (!gfc_compare_derived_types (t1, t2) && t2->attr.extension)
+    t2 = gfc_get_derived_super_type (t2);
+  return gfc_compare_derived_types (t1, t2);
+}
+
+
 /* Check if two typespecs are type compatible (F03:5.1.1.2):
    If ts1 is nonpolymorphic, ts2 must be the same type.
    If ts1 is polymorphic (CLASS), ts2 must be an extension of ts1.  */
@@ -4541,19 +4576,16 @@ gfc_get_derived_super_type (gfc_symbol* derived)
 bool
 gfc_type_compatible (gfc_typespec *ts1, gfc_typespec *ts2)
 {
-  if (ts1->type == BT_DERIVED && ts2->type == BT_DERIVED)
+  if ((ts1->type == BT_DERIVED || ts1->type == BT_CLASS)
+      && (ts2->type == BT_DERIVED || ts2->type == BT_CLASS))
     {
-      gfc_symbol *t0, *t;
-      if (ts1->is_class)
-	{
-	  t0 = ts1->u.derived;
-	  t = ts2->u.derived;
-	  while (t0 != t && t->attr.extension)
-	    t = gfc_get_derived_super_type (t);
-	  return (t0 == t);
-	}
+      if (ts1->type == BT_CLASS)
+	return gfc_type_is_extension_of (ts1->u.derived->components->ts.u.derived,
+					 ts2->u.derived);
+      else if (ts2->type != BT_CLASS)
+	return gfc_compare_derived_types (ts1->u.derived, ts2->u.derived);
       else
-	return (ts1->u.derived == ts2->u.derived);
+	return 0;
     }
   else
     return (ts1->type == ts2->type);