summaryrefslogtreecommitdiff
path: root/gcc/fortran
diff options
context:
space:
mode:
authorjanus <janus@138bc75d-0d04-0410-961f-82ee72b054a4>2010-05-30 21:56:11 +0000
committerjanus <janus@138bc75d-0d04-0410-961f-82ee72b054a4>2010-05-30 21:56:11 +0000
commit50b4b37ba4128b5e02d6b8af5f872770063c1d2b (patch)
treebd664a3b4e0b3ba3499bd2892841cf41c6b4a076 /gcc/fortran
parent151000185c0403bf828986583afef0bf6b4f80b7 (diff)
downloadgcc-50b4b37ba4128b5e02d6b8af5f872770063c1d2b.tar.gz
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
Diffstat (limited to 'gcc/fortran')
-rw-r--r--gcc/fortran/ChangeLog23
-rw-r--r--gcc/fortran/decl.c13
-rw-r--r--gcc/fortran/expr.c14
-rw-r--r--gcc/fortran/gfortran.h2
-rw-r--r--gcc/fortran/interface.c2
-rw-r--r--gcc/fortran/match.c8
-rw-r--r--gcc/fortran/parse.c6
-rw-r--r--gcc/fortran/primary.c26
-rw-r--r--gcc/fortran/resolve.c75
-rw-r--r--gcc/fortran/symbol.c26
-rw-r--r--gcc/fortran/trans-array.c10
-rw-r--r--gcc/fortran/trans-decl.c9
-rw-r--r--gcc/fortran/trans-stmt.c2
13 files changed, 103 insertions, 113 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 267cdd56149..b156f77ac1e 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 12dcf84d8b0..9786a860bae 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 6884c900186..b6452054b11 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 0ffcfae9a55..9762cddfaa8 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 4bcc63e1963..99ade9d273d 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 a4900aa7eec..7e13ba3b96a 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 dfc589310a4..31ad7cf385c 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 53da762e2ef..68b6a437360 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 1538ea0c9ab..48bb6187c17 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 b719de11044..b436de5e2af 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 ddfe40f7a54..7d7b3a36839 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 a6029770810..224474aeff2 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 5c7d1512eee..37b577f2cc4 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;