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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@160060 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 267cdd561497078bd5f25558bd34c7a4b9eba7bf..b156f77ac1e8c6de593a2e8946bea2de649f0434 100644 (file)
--- 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 12dcf84d8b064c1793da8ad263ebcb1a6d928e85..9786a860baec50749df94af9c2d9f8114b1a96e9 100644 (file)
--- 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 6884c9001867b4af5164bb944faedd04c9ba320e..b6452054b112e4ffcd153f5cf02fba5697af99aa 100644 (file)
--- 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 0ffcfae9a5562e9891f961d830ee4c15cfd3bae9..9762cddfaa888aa593b576bc2dc8e908c79cdfab 100644 (file)
--- 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 4bcc63e1963cd9d5293b201de6ba63c356de61a1..99ade9d273d5f7075c4879437bcf1487ac0575f1 100644 (file)
--- 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 a4900aa7eecb1762758761187b442826cfab394a..7e13ba3b96abab1261089b4d826e4994bbade0dc 100644 (file)
--- 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 dfc589310a401accabe956eb89afdd5303c73a87..31ad7cf385ce7decc41fc32ec8965b98484913a4 100644 (file)
--- 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 53da762e2efa59a83eab3f512518e7b61e0e11c6..68b6a437360cbea4a153063b9ff8f23cdb37e002 100644 (file)
--- 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 1538ea0c9ab705fa42f38c8e528fdfe34e5ee9d8..48bb6187c1712cbc7324ff2400d663328c9cac42 100644 (file)
--- 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 b719de110448c06eeedc8a63b095942d6cc4fe51..b436de5e2af822c65fb865c737b24ef3a06e6ad2 100644 (file)
--- 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 ddfe40f7a548d4771f5270e5dd1c891d93a8e888..7d7b3a36839390e5933c0f8f5ade98a6d6b13904 100644 (file)
--- 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 a602977081032750a6bf2c05cf8433608f93ad4c..224474aeff211553993265bad0341e20e999d789 100644 (file)
--- 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 5c7d1512eee3a8f0f7af14287f495fc984ff5043..37b577f2cc4472c77dc955bc52437609c366cb3d 100644 (file)
--- 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;