1 files changed, 16 insertions, 88 deletions

diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 23ac5c3..90f30b3 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -1025,88 +1025,6 @@ verify_c_interop_param (gfc_symbol *sym)
 }
 
 
-/* Build a polymorphic CLASS entity, using the symbol that comes from build_sym.
-   A CLASS entity is represented by an encapsulating type, which contains the
-   declared type as '$data' component, plus an integer component '$vindex'
-   which determines the dynamic type, and another integer '$size', which
-   contains the size of the dynamic type structure.  */
-
-static gfc_try
-encapsulate_class_symbol (gfc_typespec *ts, symbol_attribute *attr,
-			  gfc_array_spec **as)
-{
-  char name[GFC_MAX_SYMBOL_LEN + 5];
-  gfc_symbol *fclass;
-  gfc_component *c;
-
-  /* Determine the name of the encapsulating type.  */
-  if ((*as) && (*as)->rank && attr->allocatable)
-    sprintf (name, ".class.%s.%d.a", ts->u.derived->name, (*as)->rank);
-  else if ((*as) && (*as)->rank)
-    sprintf (name, ".class.%s.%d", ts->u.derived->name, (*as)->rank);
-  else if (attr->allocatable)
-    sprintf (name, ".class.%s.a", ts->u.derived->name);
-  else
-    sprintf (name, ".class.%s", ts->u.derived->name);
-
-  gfc_find_symbol (name, ts->u.derived->ns, 0, &fclass);
-  if (fclass == NULL)
-    {
-      gfc_symtree *st;
-      /* If not there, create a new symbol.  */
-      fclass = gfc_new_symbol (name, ts->u.derived->ns);
-      st = gfc_new_symtree (&ts->u.derived->ns->sym_root, name);
-      st->n.sym = fclass;
-      gfc_set_sym_referenced (fclass);
-      fclass->refs++;
-      fclass->ts.type = BT_UNKNOWN;
-      fclass->vindex = ts->u.derived->vindex;
-      fclass->attr.abstract = ts->u.derived->attr.abstract;
-      if (ts->u.derived->f2k_derived)
-	fclass->f2k_derived = gfc_get_namespace (NULL, 0);
-      if (gfc_add_flavor (&fclass->attr, FL_DERIVED,
-	  NULL, &gfc_current_locus) == FAILURE)
-	return FAILURE;
-
-      /* Add component '$data'.  */
-      if (gfc_add_component (fclass, "$data", &c) == FAILURE)
-   	return FAILURE;
-      c->ts = *ts;
-      c->ts.type = BT_DERIVED;
-      c->attr.access = ACCESS_PRIVATE;
-      c->ts.u.derived = ts->u.derived;
-      c->attr.pointer = attr->pointer || attr->dummy;
-      c->attr.allocatable = attr->allocatable;
-      c->attr.dimension = attr->dimension;
-      c->attr.abstract = ts->u.derived->attr.abstract;
-      c->as = (*as);
-      c->initializer = gfc_get_expr ();
-      c->initializer->expr_type = EXPR_NULL;
-
-      /* Add component '$vindex'.  */
-      if (gfc_add_component (fclass, "$vindex", &c) == FAILURE)
-   	return FAILURE;
-      c->ts.type = BT_INTEGER;
-      c->ts.kind = 4;
-      c->attr.access = ACCESS_PRIVATE;
-      c->initializer = gfc_int_expr (0);
-
-      /* Add component '$size'.  */
-      if (gfc_add_component (fclass, "$size", &c) == FAILURE)
-   	return FAILURE;
-      c->ts.type = BT_INTEGER;
-      c->ts.kind = 4;
-      c->attr.access = ACCESS_PRIVATE;
-      c->initializer = gfc_int_expr (0);
-    }
-
-  fclass->attr.extension = 1;
-  fclass->attr.is_class = 1;
-  ts->u.derived = fclass;
-  attr->allocatable = attr->pointer = attr->dimension = 0;
-  (*as) = NULL;  /* XXX */
-  return SUCCESS;
-}
 
 /* Function called by variable_decl() that adds a name to the symbol table.  */
 
@@ -1185,7 +1103,7 @@ build_sym (const char *name, gfc_charlen *cl,
       sym->attr.class_ok = (sym->attr.dummy
 			      || sym->attr.pointer
 			      || sym->attr.allocatable) ? 1 : 0;
-      encapsulate_class_symbol (&sym->ts, &sym->attr, &sym->as);
+      gfc_build_class_symbol (&sym->ts, &sym->attr, &sym->as);
     }
 
   return SUCCESS;
@@ -1594,7 +1512,7 @@ build_struct (const char *name, gfc_charlen *cl, gfc_expr **init,
 
 scalar:
   if (c->ts.type == BT_CLASS)
-    encapsulate_class_symbol (&c->ts, &c->attr, &c->as);
+    gfc_build_class_symbol (&c->ts, &c->attr, &c->as);
 
   return t;
 }
@@ -6926,13 +6844,23 @@ gfc_match_derived_decl (void)
 
       /* Add the extended derived type as the first component.  */
       gfc_add_component (sym, parent, &p);
-      sym->attr.extension = attr.extension;
       extended->refs++;
       gfc_set_sym_referenced (extended);
 
       p->ts.type = BT_DERIVED;
       p->ts.u.derived = extended;
       p->initializer = gfc_default_initializer (&p->ts);
+      
+      /* Set extension level.  */
+      if (extended->attr.extension == 255)
+	{
+	  /* Since the extension field is 8 bit wide, we can only have
+	     up to 255 extension levels.  */
+	  gfc_error ("Maximum extension level reached with type '%s' at %L",
+		     extended->name, &extended->declared_at);
+	  return MATCH_ERROR;
+	}
+      sym->attr.extension = extended->attr.extension + 1;
 
       /* Provide the links between the extended type and its extension.  */
       if (!extended->f2k_derived)
@@ -6941,9 +6869,9 @@ gfc_match_derived_decl (void)
       st->n.sym = sym;
     }
 
-  if (!sym->vindex)
-    /* Set the vindex for this type.  */
-    sym->vindex = hash_value (sym);
+  if (!sym->hash_value)
+    /* Set the hash for the compound name for this type.  */
+    sym->hash_value = hash_value (sym);
 
   /* Take over the ABSTRACT attribute.  */
   sym->attr.abstract = attr.abstract;