diff options
author | janus <janus@138bc75d-0d04-0410-961f-82ee72b054a4> | 2010-05-30 21:56:11 +0000 |
---|---|---|
committer | janus <janus@138bc75d-0d04-0410-961f-82ee72b054a4> | 2010-05-30 21:56:11 +0000 |
commit | 50b4b37ba4128b5e02d6b8af5f872770063c1d2b (patch) | |
tree | bd664a3b4e0b3ba3499bd2892841cf41c6b4a076 /gcc/fortran | |
parent | 151000185c0403bf828986583afef0bf6b4f80b7 (diff) | |
download | gcc-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/ChangeLog | 23 | ||||
-rw-r--r-- | gcc/fortran/decl.c | 13 | ||||
-rw-r--r-- | gcc/fortran/expr.c | 14 | ||||
-rw-r--r-- | gcc/fortran/gfortran.h | 2 | ||||
-rw-r--r-- | gcc/fortran/interface.c | 2 | ||||
-rw-r--r-- | gcc/fortran/match.c | 8 | ||||
-rw-r--r-- | gcc/fortran/parse.c | 6 | ||||
-rw-r--r-- | gcc/fortran/primary.c | 26 | ||||
-rw-r--r-- | gcc/fortran/resolve.c | 75 | ||||
-rw-r--r-- | gcc/fortran/symbol.c | 26 | ||||
-rw-r--r-- | gcc/fortran/trans-array.c | 10 | ||||
-rw-r--r-- | gcc/fortran/trans-decl.c | 9 | ||||
-rw-r--r-- | gcc/fortran/trans-stmt.c | 2 |
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, ¤t_attr, - &var_locus) == FAILURE) + if (gfc_copy_attr (&CLASS_DATA (sym)->attr, ¤t_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; |