gfortran.h (CLASS_DATA): New macro for accessing the $data component of a class container.

2010-05-30  Janus Weil  <janus@gcc.gnu.org>

	* gcc/fortran/gfortran.h (CLASS_DATA): New macro for accessing the
	$data component of a class container.
	* gcc/fortran/decl.c (attr_decl1): Use macro CLASS_DATA.
	* gcc/fortran/expr.c (gfc_check_pointer_assign,gfc_check_assign_symbol,
	gfc_has_ultimate_allocatable,gfc_has_ultimate_pointer): Ditto.
	* gcc/fortran/interface.c (matching_typebound_op): Ditto.
	* gcc/fortran/match.c (gfc_match_allocate, gfc_match_deallocate): Ditto.
	* gcc/fortran/parse.c (parse_derived): Ditto.
	* gcc/fortran/primary.c (gfc_match_varspec, gfc_variable_attr,
	gfc_expr_attr): Ditto.
	* gcc/fortran/resolve.c (resolve_structure_cons, find_array_spec,
	resolve_deallocate_expr, resolve_allocate_expr, resolve_select_type,
	resolve_fl_var_and_proc, resolve_typebound_procedure,
	resolve_fl_derived): Ditto.
	* gcc/fortran/symbol.c (gfc_type_compatible): Restructured.
	* gcc/fortran/trans-array.c (structure_alloc_comps): Use macro
	CLASS_DATA.
	* gcc/fortran/trans-decl.c (gfc_get_symbol_decl,
	gfc_trans_deferred_vars): Ditto.
	* gcc/fortran/trans-stmt.c (gfc_trans_allocate): Ditto.

From-SVN: r160060

13 files changed, 103 insertions, 113 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 267cdd5..b156f77 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,26 @@
+2010-05-30  Janus Weil  <janus@gcc.gnu.org>
+
+	* gcc/fortran/gfortran.h (CLASS_DATA): New macro for accessing the
+	$data component of a class container.
+	* gcc/fortran/decl.c (attr_decl1): Use macro CLASS_DATA.
+	* gcc/fortran/expr.c (gfc_check_pointer_assign,gfc_check_assign_symbol,
+	gfc_has_ultimate_allocatable,gfc_has_ultimate_pointer): Ditto.
+	* gcc/fortran/interface.c (matching_typebound_op): Ditto.
+	* gcc/fortran/match.c (gfc_match_allocate, gfc_match_deallocate): Ditto.
+	* gcc/fortran/parse.c (parse_derived): Ditto.
+	* gcc/fortran/primary.c (gfc_match_varspec, gfc_variable_attr,
+	gfc_expr_attr): Ditto.
+	* gcc/fortran/resolve.c (resolve_structure_cons, find_array_spec,
+	resolve_deallocate_expr, resolve_allocate_expr, resolve_select_type,
+	resolve_fl_var_and_proc, resolve_typebound_procedure,
+	resolve_fl_derived): Ditto.
+	* gcc/fortran/symbol.c (gfc_type_compatible): Restructured.
+	* gcc/fortran/trans-array.c (structure_alloc_comps): Use macro
+	CLASS_DATA.
+	* gcc/fortran/trans-decl.c (gfc_get_symbol_decl,
+	gfc_trans_deferred_vars): Ditto.
+	* gcc/fortran/trans-stmt.c (gfc_trans_allocate): Ditto.
+
 2010-05-28  Tobias Burnus  <burnus@net-b.de>
 
 	* options.c (gfc_handle_option): Fix handling of -fno-whole-file.
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 12dcf84..9786a860 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -5755,19 +5755,16 @@ attr_decl1 (void)
   /* Update symbol table.  DIMENSION attribute is set in
      gfc_set_array_spec().  For CLASS variables, this must be applied
      to the first component, or '$data' field.  */
-  if (sym->ts.type == BT_CLASS && sym->ts.u.derived)
+  if (sym->ts.type == BT_CLASS)
     {
-      gfc_component *comp;
-      comp = gfc_find_component (sym->ts.u.derived, "$data", true, true);
-      if (comp == NULL || gfc_copy_attr (&comp->attr, &current_attr,
-					 &var_locus) == FAILURE)
+      if (gfc_copy_attr (&CLASS_DATA (sym)->attr, &current_attr,&var_locus)
+	  == FAILURE)
 	{
 	  m = MATCH_ERROR;
 	  goto cleanup;
 	}
-      sym->attr.class_ok = (sym->attr.class_ok
-			      || current_attr.allocatable
-			      || current_attr.pointer);
+      sym->attr.class_ok = (sym->attr.class_ok || current_attr.allocatable
+			    || current_attr.pointer);
     }
   else
     {
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 6884c90..b645205 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -3306,8 +3306,7 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue)
     }
 
   if (!pointer && !proc_pointer
-	&& !(lvalue->ts.type == BT_CLASS
-		&& lvalue->ts.u.derived->components->attr.pointer))
+	&& !(lvalue->ts.type == BT_CLASS && CLASS_DATA (lvalue)->attr.pointer))
     {
       gfc_error ("Pointer assignment to non-POINTER at %L", &lvalue->where);
       return FAILURE;
@@ -3544,8 +3543,7 @@ gfc_check_assign_symbol (gfc_symbol *sym, gfc_expr *rvalue)
   lvalue.where = sym->declared_at;
 
   if (sym->attr.pointer || sym->attr.proc_pointer
-      || (sym->ts.type == BT_CLASS 
-	  && sym->ts.u.derived->components->attr.pointer
+      || (sym->ts.type == BT_CLASS && CLASS_DATA (sym)->attr.pointer
 	  && rvalue->expr_type == EXPR_NULL))
     r = gfc_check_pointer_assign (&lvalue, rvalue);
   else
@@ -4039,14 +4037,14 @@ gfc_has_ultimate_allocatable (gfc_expr *e)
       last = ref;
 
   if (last && last->u.c.component->ts.type == BT_CLASS)
-    return last->u.c.component->ts.u.derived->components->attr.alloc_comp;
+    return CLASS_DATA (last->u.c.component)->attr.alloc_comp;
   else if (last && last->u.c.component->ts.type == BT_DERIVED)
     return last->u.c.component->ts.u.derived->attr.alloc_comp;
   else if (last)
     return false;
 
   if (e->ts.type == BT_CLASS)
-    return e->ts.u.derived->components->attr.alloc_comp;
+    return CLASS_DATA (e)->attr.alloc_comp;
   else if (e->ts.type == BT_DERIVED)
     return e->ts.u.derived->attr.alloc_comp;
   else
@@ -4069,14 +4067,14 @@ gfc_has_ultimate_pointer (gfc_expr *e)
       last = ref;
  
   if (last && last->u.c.component->ts.type == BT_CLASS)
-    return last->u.c.component->ts.u.derived->components->attr.pointer_comp;
+    return CLASS_DATA (last->u.c.component)->attr.pointer_comp;
   else if (last && last->u.c.component->ts.type == BT_DERIVED)
     return last->u.c.component->ts.u.derived->attr.pointer_comp;
   else if (last)
     return false;
 
   if (e->ts.type == BT_CLASS)
-    return e->ts.u.derived->components->attr.pointer_comp;
+    return CLASS_DATA (e)->attr.pointer_comp;
   else if (e->ts.type == BT_DERIVED)
     return e->ts.u.derived->attr.pointer_comp;
   else
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 0ffcfae..9762cdd 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -2789,4 +2789,6 @@ gfc_typebound_proc* gfc_find_typebound_intrinsic_op (gfc_symbol*, gfc_try*,
 						     locus*);
 gfc_symtree* gfc_get_tbp_symtree (gfc_symtree**, const char*);
 
+#define CLASS_DATA(sym) sym->ts.u.derived->components
+
 #endif /* GCC_GFORTRAN_H  */
diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index 4bcc63e..99ade9d 100644
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -2734,7 +2734,7 @@ matching_typebound_op (gfc_expr** tb_base,
 	gfc_try result;
 
 	if (base->expr->ts.type == BT_CLASS)
-	  derived = base->expr->ts.u.derived->components->ts.u.derived;
+	  derived = CLASS_DATA (base->expr)->ts.u.derived;
 	else
 	  derived = base->expr->ts.u.derived;
 
diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index a4900aa..7e13ba3 100644
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -2785,8 +2785,8 @@ gfc_match_allocate (void)
 	   && (tail->expr->ref->type == REF_COMPONENT
 		|| tail->expr->ref->type == REF_ARRAY));
       if (sym && sym->ts.type == BT_CLASS)
-	b2 = !(sym->ts.u.derived->components->attr.allocatable
-	       || sym->ts.u.derived->components->attr.pointer);
+	b2 = !(CLASS_DATA (sym)->attr.allocatable
+	       || CLASS_DATA (sym)->attr.pointer);
       else
 	b2 = sym && !(sym->attr.allocatable || sym->attr.pointer
 		      || sym->attr.proc_pointer);
@@ -3047,8 +3047,8 @@ gfc_match_deallocate (void)
 	   && (tail->expr->ref->type == REF_COMPONENT
 	       || tail->expr->ref->type == REF_ARRAY));
       if (sym && sym->ts.type == BT_CLASS)
-	b2 = !(sym->ts.u.derived->components->attr.allocatable
-	       || sym->ts.u.derived->components->attr.pointer);
+	b2 = !(CLASS_DATA (sym)->attr.allocatable
+	       || CLASS_DATA (sym)->attr.pointer);
       else
 	b2 = sym && !(sym->attr.allocatable || sym->attr.pointer
 		      || sym->attr.proc_pointer);
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index dfc5893..31ad7cf 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -2082,15 +2082,13 @@ endType:
     {
       /* Look for allocatable components.  */
       if (c->attr.allocatable
-	  || (c->ts.type == BT_CLASS
-	      && c->ts.u.derived->components->attr.allocatable)
+	  || (c->ts.type == BT_CLASS && CLASS_DATA (c)->attr.allocatable)
 	  || (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.alloc_comp))
 	sym->attr.alloc_comp = 1;
 
       /* Look for pointer components.  */
       if (c->attr.pointer
-	  || (c->ts.type == BT_CLASS
-	      && c->ts.u.derived->components->attr.pointer)
+	  || (c->ts.type == BT_CLASS && CLASS_DATA (c)->attr.pointer)
 	  || (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.pointer_comp))
 	sym->attr.pointer_comp = 1;
 
diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c
index 53da762..68b6a43 100644
--- a/gcc/fortran/primary.c
+++ b/gcc/fortran/primary.c
@@ -1754,8 +1754,7 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag,
 	  && !gfc_is_proc_ptr_comp (primary, NULL)
 	  && !(gfc_matching_procptr_assignment
 	       && sym->attr.flavor == FL_PROCEDURE))
-      || (sym->ts.type == BT_CLASS
-	  && sym->ts.u.derived->components->attr.dimension))
+      || (sym->ts.type == BT_CLASS && CLASS_DATA (sym)->attr.dimension))
     {
       /* In EQUIVALENCE, we don't know yet whether we are seeing
 	 an array, character variable or array of character
@@ -1890,16 +1889,15 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag,
 	    return m;
 	}
       else if (component->ts.type == BT_CLASS
-	       && component->ts.u.derived->components->as != NULL
+	       && CLASS_DATA (component)->as != NULL
 	       && !component->attr.proc_pointer)
 	{
 	  tail = extend_ref (primary, tail);
 	  tail->type = REF_ARRAY;
 
-	  m = gfc_match_array_ref (&tail->u.ar,
-				   component->ts.u.derived->components->as,
+	  m = gfc_match_array_ref (&tail->u.ar, CLASS_DATA (component)->as,
 				   equiv_flag,
-			   component->ts.u.derived->components->as->corank);
+				   CLASS_DATA (component)->as->corank);
 	  if (m != MATCH_YES)
 	    return m;
 	}
@@ -2000,9 +1998,9 @@ gfc_variable_attr (gfc_expr *expr, gfc_typespec *ts)
 
   if (sym->ts.type == BT_CLASS)
     {
-      dimension = sym->ts.u.derived->components->attr.dimension;
-      pointer = sym->ts.u.derived->components->attr.pointer;
-      allocatable = sym->ts.u.derived->components->attr.allocatable;
+      dimension = CLASS_DATA (sym)->attr.dimension;
+      pointer = CLASS_DATA (sym)->attr.pointer;
+      allocatable = CLASS_DATA (sym)->attr.allocatable;
     }
   else
     {
@@ -2061,8 +2059,8 @@ gfc_variable_attr (gfc_expr *expr, gfc_typespec *ts)
 
 	if (comp->ts.type == BT_CLASS)
 	  {
-	    pointer = comp->ts.u.derived->components->attr.pointer;
-	    allocatable = comp->ts.u.derived->components->attr.allocatable;
+	    pointer = CLASS_DATA (comp)->attr.pointer;
+	    allocatable = CLASS_DATA (comp)->attr.allocatable;
 	  }
 	else
 	  {
@@ -2110,9 +2108,9 @@ gfc_expr_attr (gfc_expr *e)
 	  attr = sym->attr;
 	  if (sym->ts.type == BT_CLASS)
 	    {
-	      attr.dimension = sym->ts.u.derived->components->attr.dimension;
-	      attr.pointer = sym->ts.u.derived->components->attr.pointer;
-	      attr.allocatable = sym->ts.u.derived->components->attr.allocatable;
+	      attr.dimension = CLASS_DATA (sym)->attr.dimension;
+	      attr.pointer = CLASS_DATA (sym)->attr.pointer;
+	      attr.allocatable = CLASS_DATA (sym)->attr.allocatable;
 	    }
 	}
       else
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 1538ea0..48bb618 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -905,8 +905,8 @@ resolve_structure_cons (gfc_expr *expr)
 	  && !(comp->attr.pointer || comp->attr.allocatable
 	       || comp->attr.proc_pointer
 	       || (comp->ts.type == BT_CLASS
-		   && (comp->ts.u.derived->components->attr.pointer
-		       || comp->ts.u.derived->components->attr.allocatable))))
+		   && (CLASS_DATA (comp)->attr.pointer
+		       || CLASS_DATA (comp)->attr.allocatable))))
 	{
 	  t = FAILURE;
 	  gfc_error ("The NULL in the derived type constructor at %L is "
@@ -4131,7 +4131,7 @@ find_array_spec (gfc_expr *e)
   gfc_ref *ref;
 
   if (e->symtree->n.sym->ts.type == BT_CLASS)
-    as = e->symtree->n.sym->ts.u.derived->components->as;
+    as = CLASS_DATA (e->symtree->n.sym)->as;
   else
     as = e->symtree->n.sym->as;
   derived = NULL;
@@ -6004,8 +6004,8 @@ resolve_deallocate_expr (gfc_expr *e)
 
   if (sym->ts.type == BT_CLASS)
     {
-      allocatable = sym->ts.u.derived->components->attr.allocatable;
-      pointer = sym->ts.u.derived->components->attr.pointer;
+      allocatable = CLASS_DATA (sym)->attr.allocatable;
+      pointer = CLASS_DATA (sym)->attr.pointer;
     }
   else
     {
@@ -6028,8 +6028,8 @@ resolve_deallocate_expr (gfc_expr *e)
 	  c = ref->u.c.component;
 	  if (c->ts.type == BT_CLASS)
 	    {
-	      allocatable = c->ts.u.derived->components->attr.allocatable;
-	      pointer = c->ts.u.derived->components->attr.pointer;
+	      allocatable = CLASS_DATA (c)->attr.allocatable;
+	      pointer = CLASS_DATA (c)->attr.pointer;
 	    }
 	  else
 	    {
@@ -6224,11 +6224,11 @@ resolve_allocate_expr (gfc_expr *e, gfc_code *code)
     {
       if (sym->ts.type == BT_CLASS)
 	{
-	  allocatable = sym->ts.u.derived->components->attr.allocatable;
-	  pointer = sym->ts.u.derived->components->attr.pointer;
-	  dimension = sym->ts.u.derived->components->attr.dimension;
-	  codimension = sym->ts.u.derived->components->attr.codimension;
-	  is_abstract = sym->ts.u.derived->components->attr.abstract;
+	  allocatable = CLASS_DATA (sym)->attr.allocatable;
+	  pointer = CLASS_DATA (sym)->attr.pointer;
+	  dimension = CLASS_DATA (sym)->attr.dimension;
+	  codimension = CLASS_DATA (sym)->attr.codimension;
+	  is_abstract = CLASS_DATA (sym)->attr.abstract;
 	}
       else
 	{
@@ -6262,11 +6262,11 @@ resolve_allocate_expr (gfc_expr *e, gfc_code *code)
 		c = ref->u.c.component;
 		if (c->ts.type == BT_CLASS)
 		  {
-		    allocatable = c->ts.u.derived->components->attr.allocatable;
-		    pointer = c->ts.u.derived->components->attr.pointer;
-		    dimension = c->ts.u.derived->components->attr.dimension;
-		    codimension = c->ts.u.derived->components->attr.codimension;
-		    is_abstract = c->ts.u.derived->components->attr.abstract;
+		    allocatable = CLASS_DATA (c)->attr.allocatable;
+		    pointer = CLASS_DATA (c)->attr.pointer;
+		    dimension = CLASS_DATA (c)->attr.dimension;
+		    codimension = CLASS_DATA (c)->attr.codimension;
+		    is_abstract = CLASS_DATA (c)->attr.abstract;
 		  }
 		else
 		  {
@@ -6349,7 +6349,7 @@ resolve_allocate_expr (gfc_expr *e, gfc_code *code)
 	}
       else if (e->ts.type == BT_CLASS
 	       && ((code->ext.alloc.ts.type == BT_UNKNOWN
-		    && (init_e = gfc_default_initializer (&e->ts.u.derived->components->ts)))
+		    && (init_e = gfc_default_initializer (&CLASS_DATA (e)->ts)))
 		   || (code->ext.alloc.ts.type == BT_DERIVED
 		       && (init_e = gfc_default_initializer (&code->ext.alloc.ts)))))
 	{
@@ -7153,10 +7153,10 @@ resolve_select_type (gfc_code *code)
     {
       if (code->expr1->symtree->n.sym->attr.untyped)
 	code->expr1->symtree->n.sym->ts = code->expr2->ts;
-      selector_type = code->expr2->ts.u.derived->components->ts.u.derived;
+      selector_type = CLASS_DATA (code->expr2)->ts.u.derived;
     }
   else
-    selector_type = code->expr1->ts.u.derived->components->ts.u.derived;
+    selector_type = CLASS_DATA (code->expr1)->ts.u.derived;
 
   /* Loop over TYPE IS / CLASS IS cases.  */
   for (body = code->block; body; body = body->block)
@@ -9185,11 +9185,11 @@ resolve_fl_var_and_proc (gfc_symbol *sym, int mp_flag)
   if (sym->ts.type == BT_CLASS && !(sym->result && sym->result != sym))
     {
       /* F03:C502.  */
-      if (!gfc_type_is_extensible (sym->ts.u.derived->components->ts.u.derived))
+      if (!gfc_type_is_extensible (CLASS_DATA (sym)->ts.u.derived))
 	{
 	  gfc_error ("Type '%s' of CLASS variable '%s' at %L is not extensible",
-		     sym->ts.u.derived->components->ts.u.derived->name,
-		     sym->name, &sym->declared_at);
+		     CLASS_DATA (sym)->ts.u.derived->name, sym->name,
+		     &sym->declared_at);
 	  return FAILURE;
 	}
 
@@ -10424,7 +10424,7 @@ resolve_typebound_procedure (gfc_symtree* stree)
 	  goto error;
 	}
 
-      if (me_arg->ts.u.derived->components->ts.u.derived
+      if (CLASS_DATA (me_arg)->ts.u.derived
 	  != resolve_bindings_derived)
 	{
 	  gfc_error ("Argument '%s' of '%s' with PASS(%s) at %L must be of"
@@ -10434,20 +10434,19 @@ resolve_typebound_procedure (gfc_symtree* stree)
 	}
   
       gcc_assert (me_arg->ts.type == BT_CLASS);
-      if (me_arg->ts.u.derived->components->as
-	  && me_arg->ts.u.derived->components->as->rank > 0)
+      if (CLASS_DATA (me_arg)->as && CLASS_DATA (me_arg)->as->rank > 0)
 	{
 	  gfc_error ("Passed-object dummy argument of '%s' at %L must be"
 		     " scalar", proc->name, &where);
 	  goto error;
 	}
-      if (me_arg->ts.u.derived->components->attr.allocatable)
+      if (CLASS_DATA (me_arg)->attr.allocatable)
 	{
 	  gfc_error ("Passed-object dummy argument of '%s' at %L must not"
 		     " be ALLOCATABLE", proc->name, &where);
 	  goto error;
 	}
-      if (me_arg->ts.u.derived->components->attr.class_pointer)
+      if (CLASS_DATA (me_arg)->attr.class_pointer)
 	{
 	  gfc_error ("Passed-object dummy argument of '%s' at %L must not"
 		     " be POINTER", proc->name, &where);
@@ -10633,14 +10632,11 @@ resolve_fl_derived (gfc_symbol *sym)
   if (sym->attr.is_class && sym->ts.u.derived == NULL)
     {
       /* Fix up incomplete CLASS symbols.  */
-      gfc_component *data;
-      gfc_component *vptr;
-      gfc_symbol *vtab;
-      data = gfc_find_component (sym, "$data", true, true);
-      vptr = gfc_find_component (sym, "$vptr", true, true);
+      gfc_component *data = gfc_find_component (sym, "$data", true, true);
+      gfc_component *vptr = gfc_find_component (sym, "$vptr", true, true);
       if (vptr->ts.u.derived == NULL)
 	{
-	  vtab = gfc_find_derived_vtab (data->ts.u.derived, false);
+	  gfc_symbol *vtab = gfc_find_derived_vtab (data->ts.u.derived, false);
 	  gcc_assert (vtab);
 	  vptr->ts.u.derived = vtab->ts.u.derived;
 	}
@@ -10834,7 +10830,7 @@ resolve_fl_derived (gfc_symbol *sym)
 	  if ((me_arg->ts.type != BT_DERIVED && me_arg->ts.type != BT_CLASS)
 	      || (me_arg->ts.type == BT_DERIVED && me_arg->ts.u.derived != sym)
 	      || (me_arg->ts.type == BT_CLASS
-		  && me_arg->ts.u.derived->components->ts.u.derived != sym))
+		  && CLASS_DATA (me_arg)->ts.u.derived != sym))
 	    {
 	      gfc_error ("Argument '%s' of '%s' with PASS(%s) at %L must be of"
 			 " the derived type '%s'", me_arg->name, c->name,
@@ -10947,9 +10943,9 @@ resolve_fl_derived (gfc_symbol *sym)
 	  return FAILURE;
 	}
 
-      if (c->ts.type == BT_CLASS && c->ts.u.derived->components->attr.pointer
-	  && c->ts.u.derived->components->ts.u.derived->components == NULL
-	  && !c->ts.u.derived->components->ts.u.derived->attr.zero_comp)
+      if (c->ts.type == BT_CLASS && CLASS_DATA (c)->attr.pointer
+	  && CLASS_DATA (c)->ts.u.derived->components == NULL
+	  && !CLASS_DATA (c)->ts.u.derived->attr.zero_comp)
 	{
 	  gfc_error ("The pointer component '%s' of '%s' at %L is a type "
 		     "that has not been declared", c->name, sym->name,
@@ -10959,8 +10955,7 @@ resolve_fl_derived (gfc_symbol *sym)
 
       /* C437.  */
       if (c->ts.type == BT_CLASS
-	  && !(c->ts.u.derived->components->attr.pointer
-	       || c->ts.u.derived->components->attr.allocatable))
+	  && !(CLASS_DATA (c)->attr.pointer || CLASS_DATA (c)->attr.allocatable))
 	{
 	  gfc_error ("Component '%s' with CLASS at %L must be allocatable "
 		     "or pointer", c->name, &c->loc);
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index b719de1..b436de5 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -4661,8 +4661,6 @@ gfc_type_is_extension_of (gfc_symbol *t1, gfc_symbol *t2)
 bool
 gfc_type_compatible (gfc_typespec *ts1, gfc_typespec *ts2)
 {
-  gfc_component *cmp1, *cmp2;
-
   bool is_class1 = (ts1->type == BT_CLASS);
   bool is_class2 = (ts2->type == BT_CLASS);
   bool is_derived1 = (ts1->type == BT_DERIVED);
@@ -4674,28 +4672,12 @@ 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);
 
-  cmp1 = cmp2 = NULL;
-
-  if (is_class1)
-    {
-      cmp1 = gfc_find_component (ts1->u.derived, "$data", true, false);
-      if (cmp1 == NULL)
-	return 0;
-    }
-
-  if (is_class2)
-    {
-      cmp2 = gfc_find_component (ts2->u.derived, "$data", true, false);
-      if (cmp2 == NULL)
-	return 0;
-    }
-
   if (is_class1 && is_derived2)
-    return gfc_type_is_extension_of (cmp1->ts.u.derived, ts2->u.derived);
-
+    return gfc_type_is_extension_of (ts1->u.derived->components->ts.u.derived,
+				     ts2->u.derived);
   else if (is_class1 && is_class2)
-    return gfc_type_is_extension_of (cmp1->ts.u.derived, cmp2->ts.u.derived);
-
+    return gfc_type_is_extension_of (ts1->u.derived->components->ts.u.derived,
+				     ts2->u.derived->components->ts.u.derived);
   else
     return 0;
 }
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index ddfe40f..7d7b3a3 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -6079,14 +6079,13 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
 				 build_int_cst (TREE_TYPE (comp), 0));
 	      gfc_add_expr_to_block (&fnblock, tmp);
 	    }
-	  else if (c->ts.type == BT_CLASS
-		   && c->ts.u.derived->components->attr.allocatable)
+	  else if (c->ts.type == BT_CLASS && CLASS_DATA (c)->attr.allocatable)
 	    {
 	      /* Allocatable scalar CLASS components.  */
 	      comp = fold_build3 (COMPONENT_REF, ctype, decl, cdecl, NULL_TREE);
 	      
 	      /* Add reference to '$data' component.  */
-	      tmp = c->ts.u.derived->components->backend_decl;
+	      tmp = CLASS_DATA (c)->backend_decl;
 	      comp = fold_build3 (COMPONENT_REF, TREE_TYPE (tmp),
 				  comp, tmp, NULL_TREE);
 
@@ -6116,13 +6115,12 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
 				 build_int_cst (TREE_TYPE (comp), 0));
 	      gfc_add_expr_to_block (&fnblock, tmp);
 	    }
-	  else if (c->ts.type == BT_CLASS
-		   && c->ts.u.derived->components->attr.allocatable)
+	  else if (c->ts.type == BT_CLASS && CLASS_DATA (c)->attr.allocatable)
 	    {
 	      /* Allocatable scalar CLASS components.  */
 	      comp = fold_build3 (COMPONENT_REF, ctype, decl, cdecl, NULL_TREE);
 	      /* Add reference to '$data' component.  */
-	      tmp = c->ts.u.derived->components->backend_decl;
+	      tmp = CLASS_DATA (c)->backend_decl;
 	      comp = fold_build3 (COMPONENT_REF, TREE_TYPE (tmp),
 				  comp, tmp, NULL_TREE);
 	      tmp = fold_build2 (MODIFY_EXPR, void_type_node, comp,
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index a602977..224474a 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -1074,8 +1074,7 @@ gfc_get_symbol_decl (gfc_symbol * sym)
   /* Make sure that the vtab for the declared type is completed.  */
   if (sym->ts.type == BT_CLASS)
     {
-      gfc_component *c = gfc_find_component (sym->ts.u.derived,
-					     "$data", true, true);
+      gfc_component *c = CLASS_DATA (sym);
       if (!c->ts.u.derived->backend_decl)
 	gfc_find_derived_vtab (c->ts.u.derived, true);
     }
@@ -1221,8 +1220,8 @@ gfc_get_symbol_decl (gfc_symbol * sym)
   /* Remember this variable for allocation/cleanup.  */
   if (sym->attr.dimension || sym->attr.allocatable
       || (sym->ts.type == BT_CLASS &&
-	  (sym->ts.u.derived->components->attr.dimension
-	   || sym->ts.u.derived->components->attr.allocatable))
+	  (CLASS_DATA (sym)->attr.dimension
+	   || CLASS_DATA (sym)->attr.allocatable))
       || (sym->ts.type == BT_DERIVED && sym->ts.u.derived->attr.alloc_comp)
       /* This applies a derived type default initializer.  */
       || (sym->ts.type == BT_DERIVED
@@ -3272,7 +3271,7 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody)
 	}
       else if (sym->attr.allocatable
 	       || (sym->ts.type == BT_CLASS
-		   && sym->ts.u.derived->components->attr.allocatable))
+		   && CLASS_DATA (sym)->attr.allocatable))
 	{
 	  if (!sym->attr.save)
 	    {
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 5c7d151..37b577f 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -4285,7 +4285,7 @@ gfc_trans_allocate (gfc_code * code)
 	      else if (code->ext.alloc.ts.type == BT_DERIVED)
 		ts = &code->ext.alloc.ts;
 	      else if (expr->ts.type == BT_CLASS)
-		ts = &expr->ts.u.derived->components->ts;
+		ts = &CLASS_DATA (expr)->ts;
 	      else
 		ts = &expr->ts;