gfortran.h (gfc_component): Add field "symbol_attribute attr"...
2008-08-23 Janus Weil <janus@gcc.gnu.org> * gfortran.h (gfc_component): Add field "symbol_attribute attr", remove fields "pointer", "allocatable", "dimension", "access". Remove functions "gfc_set_component_attr" and "gfc_get_component_attr". * interface.c (gfc_compare_derived_types): Ditto. * trans-array.c (gfc_array_allocate,structure_alloc_comps): Ditto. * trans-expr.c (gfc_conv_component_ref,gfc_trans_subcomponent_assign, gfc_conv_structure): Ditto. * symbol.c (gfc_find_component,free_components,gfc_set_component_attr, gfc_get_component_attr,verify_bind_c_derived_type, generate_isocbinding_symbol): Ditto. * decl.c (build_struct): Ditto. * dump-parse-tree.c (show_components): Ditto. * trans-stmt.c (gfc_trans_deallocate): Ditto. * expr.c (gfc_check_assign,gfc_check_pointer_assign, gfc_default_initializer): Ditto. * module.c (mio_component): Ditto. * trans-types.c (copy_dt_decls_ifequal,gfc_get_derived_type): Ditto. * resolve.c (has_default_initializer,resolve_structure_cons, gfc_iso_c_func_interface,find_array_spec,resolve_ref, resolve_deallocate_expr,resolve_allocate_expr,resolve_fl_derived, resolve_equivalence_derived): Ditto. * trans-io.c (transfer_expr): Ditto. * parse.c (parse_derived): Ditto. * dependency.c (gfc_check_dependency): Ditto. * primary.c (gfc_variable_attr): Ditto. From-SVN: r139524
This commit is contained in:
parent
00fc23337d
commit
d4b7d0f052
17 changed files with 106 additions and 112 deletions
|
@ -1,3 +1,31 @@
|
|||
2008-08-23 Janus Weil <janus@gcc.gnu.org>
|
||||
|
||||
* gfortran.h (gfc_component): Add field "symbol_attribute attr", remove
|
||||
fields "pointer", "allocatable", "dimension", "access".
|
||||
Remove functions "gfc_set_component_attr" and "gfc_get_component_attr".
|
||||
* interface.c (gfc_compare_derived_types): Ditto.
|
||||
* trans-array.c (gfc_array_allocate,structure_alloc_comps): Ditto.
|
||||
* trans-expr.c (gfc_conv_component_ref,gfc_trans_subcomponent_assign,
|
||||
gfc_conv_structure): Ditto.
|
||||
* symbol.c (gfc_find_component,free_components,gfc_set_component_attr,
|
||||
gfc_get_component_attr,verify_bind_c_derived_type,
|
||||
generate_isocbinding_symbol): Ditto.
|
||||
* decl.c (build_struct): Ditto.
|
||||
* dump-parse-tree.c (show_components): Ditto.
|
||||
* trans-stmt.c (gfc_trans_deallocate): Ditto.
|
||||
* expr.c (gfc_check_assign,gfc_check_pointer_assign,
|
||||
gfc_default_initializer): Ditto.
|
||||
* module.c (mio_component): Ditto.
|
||||
* trans-types.c (copy_dt_decls_ifequal,gfc_get_derived_type): Ditto.
|
||||
* resolve.c (has_default_initializer,resolve_structure_cons,
|
||||
gfc_iso_c_func_interface,find_array_spec,resolve_ref,
|
||||
resolve_deallocate_expr,resolve_allocate_expr,resolve_fl_derived,
|
||||
resolve_equivalence_derived): Ditto.
|
||||
* trans-io.c (transfer_expr): Ditto.
|
||||
* parse.c (parse_derived): Ditto.
|
||||
* dependency.c (gfc_check_dependency): Ditto.
|
||||
* primary.c (gfc_variable_attr): Ditto.
|
||||
|
||||
2008-08-23 Tobias Burnus <burnus@net-b.de>
|
||||
|
||||
PR fortran/37076
|
||||
|
|
|
@ -1403,19 +1403,19 @@ build_struct (const char *name, gfc_charlen *cl, gfc_expr **init,
|
|||
|
||||
c->ts = current_ts;
|
||||
c->ts.cl = cl;
|
||||
gfc_set_component_attr (c, ¤t_attr);
|
||||
c->attr = current_attr;
|
||||
|
||||
c->initializer = *init;
|
||||
*init = NULL;
|
||||
|
||||
c->as = *as;
|
||||
if (c->as != NULL)
|
||||
c->dimension = 1;
|
||||
c->attr.dimension = 1;
|
||||
*as = NULL;
|
||||
|
||||
/* Should this ever get more complicated, combine with similar section
|
||||
in add_init_expr_to_sym into a separate function. */
|
||||
if (c->ts.type == BT_CHARACTER && !c->pointer && c->initializer && c->ts.cl
|
||||
if (c->ts.type == BT_CHARACTER && !c->attr.pointer && c->initializer && c->ts.cl
|
||||
&& c->ts.cl->length && c->ts.cl->length->expr_type == EXPR_CONSTANT)
|
||||
{
|
||||
int len;
|
||||
|
@ -1461,9 +1461,9 @@ build_struct (const char *name, gfc_charlen *cl, gfc_expr **init,
|
|||
}
|
||||
|
||||
/* Check array components. */
|
||||
if (!c->dimension)
|
||||
if (!c->attr.dimension)
|
||||
{
|
||||
if (c->allocatable)
|
||||
if (c->attr.allocatable)
|
||||
{
|
||||
gfc_error ("Allocatable component at %C must be an array");
|
||||
return FAILURE;
|
||||
|
@ -1472,7 +1472,7 @@ build_struct (const char *name, gfc_charlen *cl, gfc_expr **init,
|
|||
return SUCCESS;
|
||||
}
|
||||
|
||||
if (c->pointer)
|
||||
if (c->attr.pointer)
|
||||
{
|
||||
if (c->as->type != AS_DEFERRED)
|
||||
{
|
||||
|
@ -1481,7 +1481,7 @@ build_struct (const char *name, gfc_charlen *cl, gfc_expr **init,
|
|||
return FAILURE;
|
||||
}
|
||||
}
|
||||
else if (c->allocatable)
|
||||
else if (c->attr.allocatable)
|
||||
{
|
||||
if (c->as->type != AS_DEFERRED)
|
||||
{
|
||||
|
|
|
@ -639,13 +639,13 @@ gfc_check_dependency (gfc_expr *expr1, gfc_expr *expr2, bool identical)
|
|||
if (expr1->symtree->n.sym->attr.pointer)
|
||||
return 1;
|
||||
for (ref = expr1->ref; ref; ref = ref->next)
|
||||
if (ref->type == REF_COMPONENT && ref->u.c.component->pointer)
|
||||
if (ref->type == REF_COMPONENT && ref->u.c.component->attr.pointer)
|
||||
return 1;
|
||||
|
||||
if (expr2->symtree->n.sym->attr.pointer)
|
||||
return 1;
|
||||
for (ref = expr2->ref; ref; ref = ref->next)
|
||||
if (ref->type == REF_COMPONENT && ref->u.c.component->pointer)
|
||||
if (ref->type == REF_COMPONENT && ref->u.c.component->attr.pointer)
|
||||
return 1;
|
||||
|
||||
/* Otherwise distinct symbols have no dependencies. */
|
||||
|
|
|
@ -631,14 +631,14 @@ show_components (gfc_symbol *sym)
|
|||
{
|
||||
fprintf (dumpfile, "(%s ", c->name);
|
||||
show_typespec (&c->ts);
|
||||
if (c->pointer)
|
||||
if (c->attr.pointer)
|
||||
fputs (" POINTER", dumpfile);
|
||||
if (c->dimension)
|
||||
if (c->attr.dimension)
|
||||
fputs (" DIMENSION", dumpfile);
|
||||
fputc (' ', dumpfile);
|
||||
show_array_spec (c->as);
|
||||
if (c->access)
|
||||
fprintf (dumpfile, " %s", gfc_code2string (access_types, c->access));
|
||||
if (c->attr.access)
|
||||
fprintf (dumpfile, " %s", gfc_code2string (access_types, c->attr.access));
|
||||
fputc (')', dumpfile);
|
||||
if (c->next != NULL)
|
||||
fputc (' ', dumpfile);
|
||||
|
|
|
@ -2675,7 +2675,7 @@ gfc_check_assign (gfc_expr *lvalue, gfc_expr *rvalue, int conform)
|
|||
has_pointer = sym->attr.pointer;
|
||||
|
||||
for (ref = lvalue->ref; ref; ref = ref->next)
|
||||
if (ref->type == REF_COMPONENT && ref->u.c.component->pointer)
|
||||
if (ref->type == REF_COMPONENT && ref->u.c.component->attr.pointer)
|
||||
{
|
||||
has_pointer = 1;
|
||||
break;
|
||||
|
@ -2907,7 +2907,7 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue)
|
|||
if (pointer)
|
||||
check_intent_in = 0;
|
||||
|
||||
if (ref->type == REF_COMPONENT && ref->u.c.component->pointer)
|
||||
if (ref->type == REF_COMPONENT && ref->u.c.component->attr.pointer)
|
||||
pointer = 1;
|
||||
}
|
||||
|
||||
|
@ -3056,7 +3056,7 @@ gfc_default_initializer (gfc_typespec *ts)
|
|||
|
||||
/* See if we have a default initializer. */
|
||||
for (c = ts->derived->components; c; c = c->next)
|
||||
if (c->initializer || c->allocatable)
|
||||
if (c->initializer || c->attr.allocatable)
|
||||
break;
|
||||
|
||||
if (!c)
|
||||
|
@ -3082,7 +3082,7 @@ gfc_default_initializer (gfc_typespec *ts)
|
|||
if (c->initializer)
|
||||
tail->expr = gfc_copy_expr (c->initializer);
|
||||
|
||||
if (c->allocatable)
|
||||
if (c->attr.allocatable)
|
||||
{
|
||||
tail->expr = gfc_get_expr ();
|
||||
tail->expr->expr_type = EXPR_NULL;
|
||||
|
|
|
@ -834,8 +834,7 @@ typedef struct gfc_component
|
|||
const char *name;
|
||||
gfc_typespec ts;
|
||||
|
||||
int pointer, allocatable, dimension;
|
||||
gfc_access access;
|
||||
symbol_attribute attr;
|
||||
gfc_array_spec *as;
|
||||
|
||||
tree backend_decl;
|
||||
|
@ -2132,9 +2131,6 @@ bool gfc_is_intrinsic_typename (const char *);
|
|||
gfc_typespec *gfc_get_default_type (gfc_symbol *, gfc_namespace *);
|
||||
gfc_try gfc_set_default_type (gfc_symbol *, int, gfc_namespace *);
|
||||
|
||||
void gfc_set_component_attr (gfc_component *, symbol_attribute *);
|
||||
void gfc_get_component_attr (symbol_attribute *, gfc_component *);
|
||||
|
||||
void gfc_set_sym_referenced (gfc_symbol *);
|
||||
|
||||
gfc_try gfc_add_attribute (symbol_attribute *, locus *);
|
||||
|
|
|
@ -392,19 +392,19 @@ gfc_compare_derived_types (gfc_symbol *derived1, gfc_symbol *derived2)
|
|||
if (strcmp (dt1->name, dt2->name) != 0)
|
||||
return 0;
|
||||
|
||||
if (dt1->access != dt2->access)
|
||||
if (dt1->attr.access != dt2->attr.access)
|
||||
return 0;
|
||||
|
||||
if (dt1->pointer != dt2->pointer)
|
||||
if (dt1->attr.pointer != dt2->attr.pointer)
|
||||
return 0;
|
||||
|
||||
if (dt1->dimension != dt2->dimension)
|
||||
if (dt1->attr.dimension != dt2->attr.dimension)
|
||||
return 0;
|
||||
|
||||
if (dt1->allocatable != dt2->allocatable)
|
||||
if (dt1->attr.allocatable != dt2->attr.allocatable)
|
||||
return 0;
|
||||
|
||||
if (dt1->dimension && gfc_compare_array_spec (dt1->as, dt2->as) == 0)
|
||||
if (dt1->attr.dimension && gfc_compare_array_spec (dt1->as, dt2->as) == 0)
|
||||
return 0;
|
||||
|
||||
/* Make sure that link lists do not put this function into an
|
||||
|
|
|
@ -2252,10 +2252,8 @@ mio_component (gfc_component *c)
|
|||
mio_typespec (&c->ts);
|
||||
mio_array_spec (&c->as);
|
||||
|
||||
mio_integer (&c->dimension);
|
||||
mio_integer (&c->pointer);
|
||||
mio_integer (&c->allocatable);
|
||||
c->access = MIO_NAME (gfc_access) (c->access, access_types);
|
||||
mio_symbol_attribute (&c->attr);
|
||||
c->attr.access = MIO_NAME (gfc_access) (c->attr.access, access_types);
|
||||
|
||||
mio_expr (&c->initializer);
|
||||
mio_rparen ();
|
||||
|
|
|
@ -1867,7 +1867,7 @@ parse_derived (void)
|
|||
for (c = sym->components; c; c = c->next)
|
||||
{
|
||||
/* Look for allocatable components. */
|
||||
if (c->allocatable
|
||||
if (c->attr.allocatable
|
||||
|| (c->ts.type == BT_DERIVED && c->ts.derived->attr.alloc_comp))
|
||||
{
|
||||
sym->attr.alloc_comp = 1;
|
||||
|
@ -1875,7 +1875,7 @@ parse_derived (void)
|
|||
}
|
||||
|
||||
/* Look for pointer components. */
|
||||
if (c->pointer
|
||||
if (c->attr.pointer
|
||||
|| (c->ts.type == BT_DERIVED && c->ts.derived->attr.pointer_comp))
|
||||
{
|
||||
sym->attr.pointer_comp = 1;
|
||||
|
@ -1884,7 +1884,7 @@ parse_derived (void)
|
|||
|
||||
/* Look for private components. */
|
||||
if (sym->component_access == ACCESS_PRIVATE
|
||||
|| c->access == ACCESS_PRIVATE
|
||||
|| c->attr.access == ACCESS_PRIVATE
|
||||
|| (c->ts.type == BT_DERIVED && c->ts.derived->attr.private_comp))
|
||||
{
|
||||
sym->attr.private_comp = 1;
|
||||
|
|
|
@ -1898,7 +1898,7 @@ gfc_variable_attr (gfc_expr *expr, gfc_typespec *ts)
|
|||
break;
|
||||
|
||||
case REF_COMPONENT:
|
||||
gfc_get_component_attr (&attr, ref->u.c.component);
|
||||
attr = ref->u.c.component->attr;
|
||||
if (ts != NULL)
|
||||
{
|
||||
*ts = ref->u.c.component->ts;
|
||||
|
@ -1909,8 +1909,8 @@ gfc_variable_attr (gfc_expr *expr, gfc_typespec *ts)
|
|||
ts->cl = NULL;
|
||||
}
|
||||
|
||||
pointer = ref->u.c.component->pointer;
|
||||
allocatable = ref->u.c.component->allocatable;
|
||||
pointer = ref->u.c.component->attr.pointer;
|
||||
allocatable = ref->u.c.component->attr.allocatable;
|
||||
if (pointer)
|
||||
target = 1;
|
||||
|
||||
|
|
|
@ -648,7 +648,7 @@ has_default_initializer (gfc_symbol *der)
|
|||
for (c = der->components; c; c = c->next)
|
||||
if ((c->ts.type != BT_DERIVED && c->initializer)
|
||||
|| (c->ts.type == BT_DERIVED
|
||||
&& (!c->pointer && has_default_initializer (c->ts.derived))))
|
||||
&& (!c->attr.pointer && has_default_initializer (c->ts.derived))))
|
||||
break;
|
||||
|
||||
return c != NULL;
|
||||
|
@ -810,7 +810,7 @@ resolve_structure_cons (gfc_expr *expr)
|
|||
|
||||
rank = comp->as ? comp->as->rank : 0;
|
||||
if (cons->expr->expr_type != EXPR_NULL && rank != cons->expr->rank
|
||||
&& (comp->allocatable || cons->expr->rank))
|
||||
&& (comp->attr.allocatable || cons->expr->rank))
|
||||
{
|
||||
gfc_error ("The rank of the element in the derived type "
|
||||
"constructor at %L does not match that of the "
|
||||
|
@ -824,7 +824,7 @@ resolve_structure_cons (gfc_expr *expr)
|
|||
if (!gfc_compare_types (&cons->expr->ts, &comp->ts))
|
||||
{
|
||||
t = FAILURE;
|
||||
if (comp->pointer && cons->expr->ts.type != BT_UNKNOWN)
|
||||
if (comp->attr.pointer && cons->expr->ts.type != BT_UNKNOWN)
|
||||
gfc_error ("The element in the derived type constructor at %L, "
|
||||
"for pointer component '%s', is %s but should be %s",
|
||||
&cons->expr->where, comp->name,
|
||||
|
@ -835,7 +835,7 @@ resolve_structure_cons (gfc_expr *expr)
|
|||
}
|
||||
|
||||
if (cons->expr->expr_type == EXPR_NULL
|
||||
&& !(comp->pointer || comp->allocatable))
|
||||
&& !(comp->attr.pointer || comp->attr.allocatable))
|
||||
{
|
||||
t = FAILURE;
|
||||
gfc_error ("The NULL in the derived type constructor at %L is "
|
||||
|
@ -844,7 +844,7 @@ resolve_structure_cons (gfc_expr *expr)
|
|||
comp->name);
|
||||
}
|
||||
|
||||
if (!comp->pointer || cons->expr->expr_type == EXPR_NULL)
|
||||
if (!comp->attr.pointer || cons->expr->expr_type == EXPR_NULL)
|
||||
continue;
|
||||
|
||||
a = gfc_expr_attr (cons->expr);
|
||||
|
@ -1996,7 +1996,7 @@ gfc_iso_c_func_interface (gfc_symbol *sym, gfc_actual_arglist *args,
|
|||
if (!(args_sym->attr.target)
|
||||
&& !(args_sym->attr.pointer)
|
||||
&& (parent_ref == NULL ||
|
||||
!parent_ref->u.c.component->pointer))
|
||||
!parent_ref->u.c.component->attr.pointer))
|
||||
{
|
||||
gfc_error_now ("Parameter '%s' to '%s' at %L must be either "
|
||||
"a TARGET or an associated pointer",
|
||||
|
@ -2084,7 +2084,7 @@ gfc_iso_c_func_interface (gfc_symbol *sym, gfc_actual_arglist *args,
|
|||
}
|
||||
else if ((args_sym->attr.pointer == 1 ||
|
||||
(parent_ref != NULL
|
||||
&& parent_ref->u.c.component->pointer))
|
||||
&& parent_ref->u.c.component->attr.pointer))
|
||||
&& is_scalar_expr_ptr (args->expr) != SUCCESS)
|
||||
{
|
||||
/* Case 1c, section 15.1.2.5, J3/04-007: an associated
|
||||
|
@ -3624,7 +3624,7 @@ find_array_spec (gfc_expr *e)
|
|||
if (c == NULL)
|
||||
gfc_internal_error ("find_array_spec(): Component not found");
|
||||
|
||||
if (c->dimension)
|
||||
if (c->attr.dimension)
|
||||
{
|
||||
if (as != NULL)
|
||||
gfc_internal_error ("find_array_spec(): unused as(1)");
|
||||
|
@ -3897,14 +3897,14 @@ resolve_ref (gfc_expr *expr)
|
|||
case REF_COMPONENT:
|
||||
if (current_part_dimension || seen_part_dimension)
|
||||
{
|
||||
if (ref->u.c.component->pointer)
|
||||
if (ref->u.c.component->attr.pointer)
|
||||
{
|
||||
gfc_error ("Component to the right of a part reference "
|
||||
"with nonzero rank must not have the POINTER "
|
||||
"attribute at %L", &expr->where);
|
||||
return FAILURE;
|
||||
}
|
||||
else if (ref->u.c.component->allocatable)
|
||||
else if (ref->u.c.component->attr.allocatable)
|
||||
{
|
||||
gfc_error ("Component to the right of a part reference "
|
||||
"with nonzero rank must not have the ALLOCATABLE "
|
||||
|
@ -4630,7 +4630,7 @@ resolve_deallocate_expr (gfc_expr *e)
|
|||
case REF_COMPONENT:
|
||||
allocatable = (ref->u.c.component->as != NULL
|
||||
&& ref->u.c.component->as->type == AS_DEFERRED);
|
||||
pointer = ref->u.c.component->pointer;
|
||||
pointer = ref->u.c.component->attr.pointer;
|
||||
break;
|
||||
|
||||
case REF_SUBSTRING:
|
||||
|
@ -4777,8 +4777,8 @@ resolve_allocate_expr (gfc_expr *e, gfc_code *code)
|
|||
allocatable = (ref->u.c.component->as != NULL
|
||||
&& ref->u.c.component->as->type == AS_DEFERRED);
|
||||
|
||||
pointer = ref->u.c.component->pointer;
|
||||
dimension = ref->u.c.component->dimension;
|
||||
pointer = ref->u.c.component->attr.pointer;
|
||||
dimension = ref->u.c.component->attr.dimension;
|
||||
break;
|
||||
|
||||
case REF_SUBSTRING:
|
||||
|
@ -7682,7 +7682,7 @@ resolve_fl_derived (gfc_symbol *sym)
|
|||
}
|
||||
}
|
||||
|
||||
if (c->ts.type == BT_DERIVED && c->pointer
|
||||
if (c->ts.type == BT_DERIVED && c->attr.pointer
|
||||
&& c->ts.derived->components == NULL
|
||||
&& !c->ts.derived->attr.zero_comp)
|
||||
{
|
||||
|
@ -7698,11 +7698,11 @@ resolve_fl_derived (gfc_symbol *sym)
|
|||
if (c->ts.type == BT_DERIVED
|
||||
&& c->ts.derived
|
||||
&& c->ts.derived->components
|
||||
&& c->pointer
|
||||
&& c->attr.pointer
|
||||
&& sym != c->ts.derived)
|
||||
add_dt_to_dt_list (c->ts.derived);
|
||||
|
||||
if (c->pointer || c->allocatable || c->as == NULL)
|
||||
if (c->attr.pointer || c->attr.allocatable || c->as == NULL)
|
||||
continue;
|
||||
|
||||
for (i = 0; i < c->as->rank; i++)
|
||||
|
@ -8891,7 +8891,7 @@ resolve_equivalence_derived (gfc_symbol *derived, gfc_symbol *sym, gfc_expr *e)
|
|||
|
||||
/* Shall not be an object of sequence derived type containing a pointer
|
||||
in the structure. */
|
||||
if (c->pointer)
|
||||
if (c->attr.pointer)
|
||||
{
|
||||
gfc_error ("Derived type variable '%s' at %L with pointer "
|
||||
"component(s) cannot be an EQUIVALENCE object",
|
||||
|
|
|
@ -1874,7 +1874,7 @@ gfc_find_component (gfc_symbol *sym, const char *name)
|
|||
|
||||
else if (sym->attr.use_assoc)
|
||||
{
|
||||
if (p->access == ACCESS_PRIVATE)
|
||||
if (p->attr.access == ACCESS_PRIVATE)
|
||||
{
|
||||
gfc_error ("Component '%s' at %C is a PRIVATE component of '%s'",
|
||||
name, sym->name);
|
||||
|
@ -1883,7 +1883,7 @@ gfc_find_component (gfc_symbol *sym, const char *name)
|
|||
|
||||
/* If there were components given and all components are private, error
|
||||
out at this place. */
|
||||
if (p->access != ACCESS_PUBLIC && sym->component_access == ACCESS_PRIVATE)
|
||||
if (p->attr.access != ACCESS_PUBLIC && sym->component_access == ACCESS_PRIVATE)
|
||||
{
|
||||
gfc_error ("All components of '%s' are PRIVATE in structure"
|
||||
" constructor at %C", sym->name);
|
||||
|
@ -1915,34 +1915,6 @@ free_components (gfc_component *p)
|
|||
}
|
||||
|
||||
|
||||
/* Set component attributes from a standard symbol attribute structure. */
|
||||
|
||||
void
|
||||
gfc_set_component_attr (gfc_component *c, symbol_attribute *attr)
|
||||
{
|
||||
|
||||
c->dimension = attr->dimension;
|
||||
c->pointer = attr->pointer;
|
||||
c->allocatable = attr->allocatable;
|
||||
c->access = attr->access;
|
||||
}
|
||||
|
||||
|
||||
/* Get a standard symbol attribute structure given the component
|
||||
structure. */
|
||||
|
||||
void
|
||||
gfc_get_component_attr (symbol_attribute *attr, gfc_component *c)
|
||||
{
|
||||
|
||||
gfc_clear_attr (attr);
|
||||
attr->dimension = c->dimension;
|
||||
attr->pointer = c->pointer;
|
||||
attr->allocatable = c->allocatable;
|
||||
attr->access = c->access;
|
||||
}
|
||||
|
||||
|
||||
/******************** Statement label management ********************/
|
||||
|
||||
/* Comparison function for statement labels, used for managing the
|
||||
|
@ -3354,7 +3326,7 @@ verify_bind_c_derived_type (gfc_symbol *derived_sym)
|
|||
{
|
||||
/* The components cannot be pointers (fortran sense).
|
||||
J3/04-007, Section 15.2.3, C1505. */
|
||||
if (curr_comp->pointer != 0)
|
||||
if (curr_comp->attr.pointer != 0)
|
||||
{
|
||||
gfc_error ("Component '%s' at %L cannot have the "
|
||||
"POINTER attribute because it is a member "
|
||||
|
@ -3366,7 +3338,7 @@ verify_bind_c_derived_type (gfc_symbol *derived_sym)
|
|||
|
||||
/* The components cannot be allocatable.
|
||||
J3/04-007, Section 15.2.3, C1505. */
|
||||
if (curr_comp->allocatable != 0)
|
||||
if (curr_comp->attr.allocatable != 0)
|
||||
{
|
||||
gfc_error ("Component '%s' at %L cannot have the "
|
||||
"ALLOCATABLE attribute because it is a member "
|
||||
|
@ -4081,8 +4053,8 @@ generate_isocbinding_symbol (const char *mod_name, iso_c_binding_symbol s,
|
|||
index = get_c_kind ("c_ptr", c_interop_kinds_table);
|
||||
tmp_comp->ts.kind = c_interop_kinds_table[index].value;
|
||||
|
||||
tmp_comp->pointer = 0;
|
||||
tmp_comp->dimension = 0;
|
||||
tmp_comp->attr.pointer = 0;
|
||||
tmp_comp->attr.dimension = 0;
|
||||
|
||||
/* Mark the component as C interoperable. */
|
||||
tmp_comp->ts.is_c_interop = 1;
|
||||
|
|
|
@ -3760,7 +3760,7 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree pstat)
|
|||
if (!prev_ref)
|
||||
allocatable_array = expr->symtree->n.sym->attr.allocatable;
|
||||
else
|
||||
allocatable_array = prev_ref->u.c.component->allocatable;
|
||||
allocatable_array = prev_ref->u.c.component->attr.allocatable;
|
||||
|
||||
/* Figure out the size of the array. */
|
||||
switch (ref->u.ar.type)
|
||||
|
@ -5530,7 +5530,7 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
|
|||
case DEALLOCATE_ALLOC_COMP:
|
||||
/* Do not deallocate the components of ultimate pointer
|
||||
components. */
|
||||
if (cmp_has_alloc_comps && !c->pointer)
|
||||
if (cmp_has_alloc_comps && !c->attr.pointer)
|
||||
{
|
||||
comp = fold_build3 (COMPONENT_REF, ctype,
|
||||
decl, cdecl, NULL_TREE);
|
||||
|
@ -5540,7 +5540,7 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
|
|||
gfc_add_expr_to_block (&fnblock, tmp);
|
||||
}
|
||||
|
||||
if (c->allocatable)
|
||||
if (c->attr.allocatable)
|
||||
{
|
||||
comp = fold_build3 (COMPONENT_REF, ctype,
|
||||
decl, cdecl, NULL_TREE);
|
||||
|
@ -5550,9 +5550,9 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
|
|||
break;
|
||||
|
||||
case NULLIFY_ALLOC_COMP:
|
||||
if (c->pointer)
|
||||
if (c->attr.pointer)
|
||||
continue;
|
||||
else if (c->allocatable)
|
||||
else if (c->attr.allocatable)
|
||||
{
|
||||
comp = fold_build3 (COMPONENT_REF, ctype,
|
||||
decl, cdecl, NULL_TREE);
|
||||
|
@ -5570,7 +5570,7 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
|
|||
break;
|
||||
|
||||
case COPY_ALLOC_COMP:
|
||||
if (c->pointer)
|
||||
if (c->attr.pointer)
|
||||
continue;
|
||||
|
||||
/* We need source and destination components. */
|
||||
|
@ -5578,7 +5578,7 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
|
|||
dcmp = fold_build3 (COMPONENT_REF, ctype, dest, cdecl, NULL_TREE);
|
||||
dcmp = fold_convert (TREE_TYPE (comp), dcmp);
|
||||
|
||||
if (c->allocatable && !cmp_has_alloc_comps)
|
||||
if (c->attr.allocatable && !cmp_has_alloc_comps)
|
||||
{
|
||||
tmp = gfc_duplicate_allocatable(dcmp, comp, ctype, c->as->rank);
|
||||
gfc_add_expr_to_block (&fnblock, tmp);
|
||||
|
|
|
@ -390,7 +390,7 @@ gfc_conv_component_ref (gfc_se * se, gfc_ref * ref)
|
|||
se->string_length = tmp;
|
||||
}
|
||||
|
||||
if (c->pointer && c->dimension == 0 && c->ts.type != BT_CHARACTER)
|
||||
if (c->attr.pointer && c->attr.dimension == 0 && c->ts.type != BT_CHARACTER)
|
||||
se->expr = build_fold_indirect_ref (se->expr);
|
||||
}
|
||||
|
||||
|
@ -3432,11 +3432,11 @@ gfc_trans_subcomponent_assign (tree dest, gfc_component * cm, gfc_expr * expr)
|
|||
|
||||
gfc_start_block (&block);
|
||||
|
||||
if (cm->pointer)
|
||||
if (cm->attr.pointer)
|
||||
{
|
||||
gfc_init_se (&se, NULL);
|
||||
/* Pointer component. */
|
||||
if (cm->dimension)
|
||||
if (cm->attr.dimension)
|
||||
{
|
||||
/* Array pointer. */
|
||||
if (expr->expr_type == EXPR_NULL)
|
||||
|
@ -3462,11 +3462,11 @@ gfc_trans_subcomponent_assign (tree dest, gfc_component * cm, gfc_expr * expr)
|
|||
gfc_add_block_to_block (&block, &se.post);
|
||||
}
|
||||
}
|
||||
else if (cm->dimension)
|
||||
else if (cm->attr.dimension)
|
||||
{
|
||||
if (cm->allocatable && expr->expr_type == EXPR_NULL)
|
||||
if (cm->attr.allocatable && expr->expr_type == EXPR_NULL)
|
||||
gfc_conv_descriptor_data_set (&block, dest, null_pointer_node);
|
||||
else if (cm->allocatable)
|
||||
else if (cm->attr.allocatable)
|
||||
{
|
||||
tree tmp2;
|
||||
|
||||
|
@ -3637,11 +3637,11 @@ gfc_conv_structure (gfc_se * se, gfc_expr * expr, int init)
|
|||
components. Although the latter have a default initializer
|
||||
of EXPR_NULL,... by default, the static nullify is not needed
|
||||
since this is done every time we come into scope. */
|
||||
if (!c->expr || cm->allocatable)
|
||||
if (!c->expr || cm->attr.allocatable)
|
||||
continue;
|
||||
|
||||
val = gfc_conv_initializer (c->expr, &cm->ts,
|
||||
TREE_TYPE (cm->backend_decl), cm->dimension, cm->pointer);
|
||||
TREE_TYPE (cm->backend_decl), cm->attr.dimension, cm->attr.pointer);
|
||||
|
||||
/* Append it to the constructor list. */
|
||||
CONSTRUCTOR_APPEND_ELT (v, cm->backend_decl, val);
|
||||
|
|
|
@ -2087,14 +2087,14 @@ transfer_expr (gfc_se * se, gfc_typespec * ts, tree addr_expr, gfc_code * code)
|
|||
tmp = fold_build3 (COMPONENT_REF, TREE_TYPE (field),
|
||||
expr, field, NULL_TREE);
|
||||
|
||||
if (c->dimension)
|
||||
if (c->attr.dimension)
|
||||
{
|
||||
tmp = transfer_array_component (tmp, c, & code->loc);
|
||||
gfc_add_expr_to_block (&se->pre, tmp);
|
||||
}
|
||||
else
|
||||
{
|
||||
if (!c->pointer)
|
||||
if (!c->attr.pointer)
|
||||
tmp = build_fold_addr_expr (tmp);
|
||||
transfer_expr (se, &c->ts, tmp, code);
|
||||
}
|
||||
|
|
|
@ -3970,7 +3970,7 @@ gfc_trans_deallocate (gfc_code * code)
|
|||
|
||||
/* Do not deallocate the components of a derived type
|
||||
ultimate pointer component. */
|
||||
if (!(last && last->u.c.component->pointer)
|
||||
if (!(last && last->u.c.component->attr.pointer)
|
||||
&& !(!last && expr->symtree->n.sym->attr.pointer))
|
||||
{
|
||||
tmp = gfc_deallocate_alloc_comp (expr->ts.derived, se.expr,
|
||||
|
|
|
@ -1764,7 +1764,7 @@ copy_dt_decls_ifequal (gfc_symbol *from, gfc_symbol *to)
|
|||
for (; to_cm; to_cm = to_cm->next, from_cm = from_cm->next)
|
||||
{
|
||||
to_cm->backend_decl = from_cm->backend_decl;
|
||||
if (!from_cm->pointer && from_cm->ts.type == BT_DERIVED)
|
||||
if (!from_cm->attr.pointer && from_cm->ts.type == BT_DERIVED)
|
||||
gfc_get_derived_type (to_cm->ts.derived);
|
||||
|
||||
else if (from_cm->ts.type == BT_CHARACTER)
|
||||
|
@ -1848,7 +1848,7 @@ gfc_get_derived_type (gfc_symbol * derived)
|
|||
if (c->ts.type != BT_DERIVED)
|
||||
continue;
|
||||
|
||||
if (!c->pointer || c->ts.derived->backend_decl == NULL)
|
||||
if (!c->attr.pointer || c->ts.derived->backend_decl == NULL)
|
||||
c->ts.derived->backend_decl = gfc_get_derived_type (c->ts.derived);
|
||||
|
||||
if (c->ts.derived && c->ts.derived->attr.is_iso_c)
|
||||
|
@ -1893,12 +1893,12 @@ gfc_get_derived_type (gfc_symbol * derived)
|
|||
|
||||
/* This returns an array descriptor type. Initialization may be
|
||||
required. */
|
||||
if (c->dimension)
|
||||
if (c->attr.dimension)
|
||||
{
|
||||
if (c->pointer || c->allocatable)
|
||||
if (c->attr.pointer || c->attr.allocatable)
|
||||
{
|
||||
enum gfc_array_kind akind;
|
||||
if (c->pointer)
|
||||
if (c->attr.pointer)
|
||||
akind = GFC_ARRAY_POINTER;
|
||||
else
|
||||
akind = GFC_ARRAY_ALLOCATABLE;
|
||||
|
@ -1910,7 +1910,7 @@ gfc_get_derived_type (gfc_symbol * derived)
|
|||
field_type = gfc_get_nodesc_array_type (field_type, c->as,
|
||||
PACKED_STATIC);
|
||||
}
|
||||
else if (c->pointer)
|
||||
else if (c->attr.pointer)
|
||||
field_type = build_pointer_type (field_type);
|
||||
|
||||
field = gfc_add_field_to_struct (&fieldlist, typenode,
|
||||
|
|
Loading…
Add table
Reference in a new issue