This is the mail archive of the
fortran@gcc.gnu.org
mailing list for the GNU Fortran project.
[Patch, Fortran] PR 40941: gfc_typespec: put derived, cl and interface into union
- From: Janus Weil <janus at gcc dot gnu dot org>
- To: gfortran <fortran at gcc dot gnu dot org>, gcc-patches <gcc-patches at gcc dot gnu dot org>
- Date: Mon, 3 Aug 2009 11:12:18 +0200
- Subject: [Patch, Fortran] PR 40941: gfc_typespec: put derived, cl and interface into union
Hi all,
this patch cleans up a FIXME item from gfortran.h. It is rather large,
but almost completely mechanical. The central change is this one in
the gfc_typespec structure:
Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h (revision 150364)
+++ gcc/fortran/gfortran.h (working copy)
@@ -832,13 +832,19 @@ gfc_charlen;
#define gfc_get_charlen() XCNEW (gfc_charlen)
-/* Type specification structure. FIXME: derived and cl could be union??? */
+/* Type specification structure. */
typedef struct
{
bt type;
int kind;
- struct gfc_symbol *derived;
- gfc_charlen *cl; /* For character types only. */
+
+ union
+ {
+ struct gfc_symbol *derived; /* For derived types only. */
+ gfc_charlen *cl; /* For character types only. */
+ }
+ u;
+
struct gfc_symbol *interface; /* For PROCEDURE declarations. */
int is_c_interop;
int is_iso_c;
For now I have only put 'derived' and 'cl' into the union. This has
triggered a large amount of trivial mechanical changes, but also some
non-mechanical ones (which were needed to fix testsuite regressions),
most notably the ones in:
* decl.c (build_struct)
* symbol.c (gfc_get_default_type)
* resolve.v (resolve_symbol, resolve_fl_derived, resolve_equivalence,
resolve_equivalence_derived)
I'm not quite sure if it would be possible to also put 'interface'
into the union (will investigate). If yes, this could be done in a
follow-up patch.
The patch is regtested on x86_64-unknown-linux-gnu. I will write a
ChangeLog soon (although I'm not looking forward to it).
Ok for trunk?
Cheers,
Janus
Index: gcc/fortran/openmp.c
===================================================================
--- gcc/fortran/openmp.c (revision 150364)
+++ gcc/fortran/openmp.c (working copy)
@@ -873,7 +873,7 @@ resolve_omp_clauses (gfc_code *code)
if (!n->sym->attr.threadprivate)
gfc_error ("Non-THREADPRIVATE object '%s' in COPYIN clause"
" at %L", n->sym->name, &code->loc);
- if (n->sym->ts.type == BT_DERIVED && n->sym->ts.derived->attr.alloc_comp)
+ if (n->sym->ts.type == BT_DERIVED && n->sym->ts.u.derived->attr.alloc_comp)
gfc_error ("COPYIN clause object '%s' at %L has ALLOCATABLE components",
n->sym->name, &code->loc);
}
@@ -884,7 +884,7 @@ resolve_omp_clauses (gfc_code *code)
if (n->sym->as && n->sym->as->type == AS_ASSUMED_SIZE)
gfc_error ("Assumed size array '%s' in COPYPRIVATE clause "
"at %L", n->sym->name, &code->loc);
- if (n->sym->ts.type == BT_DERIVED && n->sym->ts.derived->attr.alloc_comp)
+ if (n->sym->ts.type == BT_DERIVED && n->sym->ts.u.derived->attr.alloc_comp)
gfc_error ("COPYPRIVATE clause object '%s' at %L has ALLOCATABLE components",
n->sym->name, &code->loc);
}
@@ -916,7 +916,7 @@ resolve_omp_clauses (gfc_code *code)
n->sym->name, name, &code->loc);
/* Variables in REDUCTION-clauses must be of intrinsic type (flagged below). */
if ((list < OMP_LIST_REDUCTION_FIRST || list > OMP_LIST_REDUCTION_LAST) &&
- n->sym->ts.type == BT_DERIVED && n->sym->ts.derived->attr.alloc_comp)
+ n->sym->ts.type == BT_DERIVED && n->sym->ts.u.derived->attr.alloc_comp)
gfc_error ("%s clause object '%s' has ALLOCATABLE components at %L",
name, n->sym->name, &code->loc);
if (n->sym->attr.cray_pointer)
Index: gcc/fortran/interface.c
===================================================================
--- gcc/fortran/interface.c (revision 150364)
+++ gcc/fortran/interface.c (working copy)
@@ -410,17 +410,17 @@ gfc_compare_derived_types (gfc_symbol *d
/* Make sure that link lists do not put this function into an
endless recursive loop! */
- if (!(dt1->ts.type == BT_DERIVED && derived1 == dt1->ts.derived)
- && !(dt1->ts.type == BT_DERIVED && derived1 == dt1->ts.derived)
+ if (!(dt1->ts.type == BT_DERIVED && derived1 == dt1->ts.u.derived)
+ && !(dt1->ts.type == BT_DERIVED && derived1 == dt1->ts.u.derived)
&& gfc_compare_types (&dt1->ts, &dt2->ts) == 0)
return 0;
- else if ((dt1->ts.type == BT_DERIVED && derived1 == dt1->ts.derived)
- && !(dt1->ts.type == BT_DERIVED && derived1 == dt1->ts.derived))
+ else if ((dt1->ts.type == BT_DERIVED && derived1 == dt1->ts.u.derived)
+ && !(dt1->ts.type == BT_DERIVED && derived1 == dt1->ts.u.derived))
return 0;
- else if (!(dt1->ts.type == BT_DERIVED && derived1 == dt1->ts.derived)
- && (dt1->ts.type == BT_DERIVED && derived1 == dt1->ts.derived))
+ else if (!(dt1->ts.type == BT_DERIVED && derived1 == dt1->ts.u.derived)
+ && (dt1->ts.type == BT_DERIVED && derived1 == dt1->ts.u.derived))
return 0;
dt1 = dt1->next;
@@ -454,10 +454,10 @@ gfc_compare_types (gfc_typespec *ts1, gf
return (ts1->kind == ts2->kind);
/* Compare derived types. */
- if (ts1->derived == ts2->derived)
+ if (ts1->u.derived == ts2->u.derived)
return 1;
- return gfc_compare_derived_types (ts1->derived ,ts2->derived);
+ return gfc_compare_derived_types (ts1->u.derived ,ts2->u.derived);
}
@@ -1375,9 +1375,9 @@ compare_parameter (gfc_symbol *formal, g
return 1;
if (formal->ts.type == BT_DERIVED
- && formal->ts.derived && formal->ts.derived->ts.is_iso_c
+ && formal->ts.u.derived && formal->ts.u.derived->ts.is_iso_c
&& actual->ts.type == BT_DERIVED
- && actual->ts.derived && actual->ts.derived->ts.is_iso_c)
+ && actual->ts.u.derived && actual->ts.u.derived->ts.is_iso_c)
return 1;
if (actual->ts.type == BT_PROCEDURE)
@@ -1540,9 +1540,9 @@ get_sym_storage_size (gfc_symbol *sym)
if (sym->ts.type == BT_CHARACTER)
{
- if (sym->ts.cl && sym->ts.cl->length
- && sym->ts.cl->length->expr_type == EXPR_CONSTANT)
- strlen = mpz_get_ui (sym->ts.cl->length->value.integer);
+ if (sym->ts.u.cl && sym->ts.u.cl->length
+ && sym->ts.u.cl->length->expr_type == EXPR_CONSTANT)
+ strlen = mpz_get_ui (sym->ts.u.cl->length->value.integer);
else
return 0;
}
@@ -1588,11 +1588,11 @@ get_expr_storage_size (gfc_expr *e)
if (e->ts.type == BT_CHARACTER)
{
- if (e->ts.cl && e->ts.cl->length
- && e->ts.cl->length->expr_type == EXPR_CONSTANT)
- strlen = mpz_get_si (e->ts.cl->length->value.integer);
+ if (e->ts.u.cl && e->ts.u.cl->length
+ && e->ts.u.cl->length->expr_type == EXPR_CONSTANT)
+ strlen = mpz_get_si (e->ts.u.cl->length->value.integer);
else if (e->expr_type == EXPR_CONSTANT
- && (e->ts.cl == NULL || e->ts.cl->length == NULL))
+ && (e->ts.u.cl == NULL || e->ts.u.cl->length == NULL))
strlen = e->value.character.length;
else
return 0;
@@ -1858,28 +1858,28 @@ compare_actual_formal (gfc_actual_arglis
and assumed-shape dummies, the string length needs to match
exactly. */
if (a->expr->ts.type == BT_CHARACTER
- && a->expr->ts.cl && a->expr->ts.cl->length
- && a->expr->ts.cl->length->expr_type == EXPR_CONSTANT
- && f->sym->ts.cl && f->sym->ts.cl && f->sym->ts.cl->length
- && f->sym->ts.cl->length->expr_type == EXPR_CONSTANT
+ && a->expr->ts.u.cl && a->expr->ts.u.cl->length
+ && a->expr->ts.u.cl->length->expr_type == EXPR_CONSTANT
+ && f->sym->ts.u.cl && f->sym->ts.u.cl && f->sym->ts.u.cl->length
+ && f->sym->ts.u.cl->length->expr_type == EXPR_CONSTANT
&& (f->sym->attr.pointer || f->sym->attr.allocatable
|| (f->sym->as && f->sym->as->type == AS_ASSUMED_SHAPE))
- && (mpz_cmp (a->expr->ts.cl->length->value.integer,
- f->sym->ts.cl->length->value.integer) != 0))
+ && (mpz_cmp (a->expr->ts.u.cl->length->value.integer,
+ f->sym->ts.u.cl->length->value.integer) != 0))
{
if (where && (f->sym->attr.pointer || f->sym->attr.allocatable))
gfc_warning ("Character length mismatch (%ld/%ld) between actual "
"argument and pointer or allocatable dummy argument "
"'%s' at %L",
- mpz_get_si (a->expr->ts.cl->length->value.integer),
- mpz_get_si (f->sym->ts.cl->length->value.integer),
+ mpz_get_si (a->expr->ts.u.cl->length->value.integer),
+ mpz_get_si (f->sym->ts.u.cl->length->value.integer),
f->sym->name, &a->expr->where);
else if (where)
gfc_warning ("Character length mismatch (%ld/%ld) between actual "
"argument and assumed-shape dummy argument '%s' "
"at %L",
- mpz_get_si (a->expr->ts.cl->length->value.integer),
- mpz_get_si (f->sym->ts.cl->length->value.integer),
+ mpz_get_si (a->expr->ts.u.cl->length->value.integer),
+ mpz_get_si (f->sym->ts.u.cl->length->value.integer),
f->sym->name, &a->expr->where);
return 0;
}
Index: gcc/fortran/trans-array.c
===================================================================
--- gcc/fortran/trans-array.c (revision 150364)
+++ gcc/fortran/trans-array.c (working copy)
@@ -1533,7 +1533,7 @@ get_array_ctor_var_strlen (gfc_expr * ex
}
}
- *len = ts->cl->backend_decl;
+ *len = ts->u.cl->backend_decl;
}
@@ -1549,12 +1549,12 @@ get_array_ctor_all_strlen (stmtblock_t *
if (*len && INTEGER_CST_P (*len))
return;
- if (!e->ref && e->ts.cl && e->ts.cl->length
- && e->ts.cl->length->expr_type == EXPR_CONSTANT)
+ if (!e->ref && e->ts.u.cl && e->ts.u.cl->length
+ && e->ts.u.cl->length->expr_type == EXPR_CONSTANT)
{
/* This is easy. */
- gfc_conv_const_charlen (e->ts.cl);
- *len = e->ts.cl->backend_decl;
+ gfc_conv_const_charlen (e->ts.u.cl);
+ *len = e->ts.u.cl->backend_decl;
}
else
{
@@ -1575,7 +1575,7 @@ get_array_ctor_all_strlen (stmtblock_t *
gfc_add_block_to_block (block, &se.pre);
gfc_add_block_to_block (block, &se.post);
- e->ts.cl->backend_decl = *len;
+ e->ts.u.cl->backend_decl = *len;
}
}
@@ -1825,8 +1825,8 @@ gfc_trans_array_constructor (gfc_loopinf
/* Do bounds-checking here and in gfc_trans_array_ctor_element only if no
typespec was given for the array constructor. */
- typespec_chararray_ctor = (ss->expr->ts.cl
- && ss->expr->ts.cl->length_from_typespec);
+ typespec_chararray_ctor = (ss->expr->ts.u.cl
+ && ss->expr->ts.u.cl->length_from_typespec);
if ((gfc_option.rtcheck & GFC_RTCHECK_BOUNDS)
&& ss->expr->ts.type == BT_CHARACTER && !typespec_chararray_ctor)
@@ -1845,14 +1845,14 @@ gfc_trans_array_constructor (gfc_loopinf
/* get_array_ctor_strlen walks the elements of the constructor, if a
typespec was given, we already know the string length and want the one
specified there. */
- if (typespec_chararray_ctor && ss->expr->ts.cl->length
- && ss->expr->ts.cl->length->expr_type != EXPR_CONSTANT)
+ if (typespec_chararray_ctor && ss->expr->ts.u.cl->length
+ && ss->expr->ts.u.cl->length->expr_type != EXPR_CONSTANT)
{
gfc_se length_se;
const_string = false;
gfc_init_se (&length_se, NULL);
- gfc_conv_expr_type (&length_se, ss->expr->ts.cl->length,
+ gfc_conv_expr_type (&length_se, ss->expr->ts.u.cl->length,
gfc_charlen_type_node);
ss->string_length = length_se.expr;
gfc_add_block_to_block (&loop->pre, &length_se.pre);
@@ -1866,7 +1866,7 @@ gfc_trans_array_constructor (gfc_loopinf
and not end up here. */
gcc_assert (ss->string_length);
- ss->expr->ts.cl->backend_decl = ss->string_length;
+ ss->expr->ts.u.cl->backend_decl = ss->string_length;
type = gfc_get_character_type_len (ss->expr->ts.kind, ss->string_length);
if (const_string)
@@ -2096,11 +2096,11 @@ gfc_add_loop_ss_code (gfc_loopinfo * loo
case GFC_SS_CONSTRUCTOR:
if (ss->expr->ts.type == BT_CHARACTER
&& ss->string_length == NULL
- && ss->expr->ts.cl
- && ss->expr->ts.cl->length)
+ && ss->expr->ts.u.cl
+ && ss->expr->ts.u.cl->length)
{
gfc_init_se (&se, NULL);
- gfc_conv_expr_type (&se, ss->expr->ts.cl->length,
+ gfc_conv_expr_type (&se, ss->expr->ts.u.cl->length,
gfc_charlen_type_node);
ss->string_length = se.expr;
gfc_add_block_to_block (&loop->pre, &se.pre);
@@ -4002,9 +4002,9 @@ gfc_array_allocate (gfc_se * se, gfc_exp
gfc_conv_descriptor_offset_set (&se->pre, se->expr, offset);
if (expr->ts.type == BT_DERIVED
- && expr->ts.derived->attr.alloc_comp)
+ && expr->ts.u.derived->attr.alloc_comp)
{
- tmp = gfc_nullify_alloc_comp (expr->ts.derived, se->expr,
+ tmp = gfc_nullify_alloc_comp (expr->ts.u.derived, se->expr,
ref->u.ar.as->rank);
gfc_add_expr_to_block (&se->pre, tmp);
}
@@ -4290,9 +4290,9 @@ gfc_trans_auto_array_allocation (tree de
/* Evaluate character string length. */
if (sym->ts.type == BT_CHARACTER
- && onstack && !INTEGER_CST_P (sym->ts.cl->backend_decl))
+ && onstack && !INTEGER_CST_P (sym->ts.u.cl->backend_decl))
{
- gfc_conv_string_length (sym->ts.cl, NULL, &block);
+ gfc_conv_string_length (sym->ts.u.cl, NULL, &block);
gfc_trans_vla_type_sizes (sym, &block);
@@ -4315,8 +4315,8 @@ gfc_trans_auto_array_allocation (tree de
gcc_assert (!sym->module);
if (sym->ts.type == BT_CHARACTER
- && !INTEGER_CST_P (sym->ts.cl->backend_decl))
- gfc_conv_string_length (sym->ts.cl, NULL, &block);
+ && !INTEGER_CST_P (sym->ts.u.cl->backend_decl))
+ gfc_conv_string_length (sym->ts.u.cl, NULL, &block);
size = gfc_trans_array_bounds (type, sym, &offset, &block);
@@ -4381,8 +4381,8 @@ gfc_trans_g77_array (gfc_symbol * sym, t
gfc_start_block (&block);
if (sym->ts.type == BT_CHARACTER
- && TREE_CODE (sym->ts.cl->backend_decl) == VAR_DECL)
- gfc_conv_string_length (sym->ts.cl, NULL, &block);
+ && TREE_CODE (sym->ts.u.cl->backend_decl) == VAR_DECL)
+ gfc_conv_string_length (sym->ts.u.cl, NULL, &block);
/* Evaluate the bounds of the array. */
gfc_trans_array_bounds (type, sym, &offset, &block);
@@ -4474,8 +4474,8 @@ gfc_trans_dummy_array_bias (gfc_symbol *
gfc_start_block (&block);
if (sym->ts.type == BT_CHARACTER
- && TREE_CODE (sym->ts.cl->backend_decl) == VAR_DECL)
- gfc_conv_string_length (sym->ts.cl, NULL, &block);
+ && TREE_CODE (sym->ts.u.cl->backend_decl) == VAR_DECL)
+ gfc_conv_string_length (sym->ts.u.cl, NULL, &block);
checkparm = (sym->as->type == AS_EXPLICIT
&& (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS));
@@ -4867,11 +4867,11 @@ get_array_charlen (gfc_expr *expr, gfc_s
gfc_actual_arglist *arg;
gfc_se tse;
- if (expr->ts.cl->length
- && gfc_is_constant_expr (expr->ts.cl->length))
+ if (expr->ts.u.cl->length
+ && gfc_is_constant_expr (expr->ts.u.cl->length))
{
- if (!expr->ts.cl->backend_decl)
- gfc_conv_string_length (expr->ts.cl, expr, &se->pre);
+ if (!expr->ts.u.cl->backend_decl)
+ gfc_conv_string_length (expr->ts.u.cl, expr, &se->pre);
return;
}
@@ -4880,11 +4880,11 @@ get_array_charlen (gfc_expr *expr, gfc_s
case EXPR_OP:
get_array_charlen (expr->value.op.op1, se);
- /* For parentheses the expression ts.cl is identical. */
+ /* For parentheses the expression ts.u.cl is identical. */
if (expr->value.op.op == INTRINSIC_PARENTHESES)
return;
- expr->ts.cl->backend_decl =
+ expr->ts.u.cl->backend_decl =
gfc_create_var (gfc_charlen_type_node, "sln");
if (expr->value.op.op2)
@@ -4895,21 +4895,21 @@ get_array_charlen (gfc_expr *expr, gfc_s
/* Add the string lengths and assign them to the expression
string length backend declaration. */
- gfc_add_modify (&se->pre, expr->ts.cl->backend_decl,
+ gfc_add_modify (&se->pre, expr->ts.u.cl->backend_decl,
fold_build2 (PLUS_EXPR, gfc_charlen_type_node,
- expr->value.op.op1->ts.cl->backend_decl,
- expr->value.op.op2->ts.cl->backend_decl));
+ expr->value.op.op1->ts.u.cl->backend_decl,
+ expr->value.op.op2->ts.u.cl->backend_decl));
}
else
- gfc_add_modify (&se->pre, expr->ts.cl->backend_decl,
- expr->value.op.op1->ts.cl->backend_decl);
+ gfc_add_modify (&se->pre, expr->ts.u.cl->backend_decl,
+ expr->value.op.op1->ts.u.cl->backend_decl);
break;
case EXPR_FUNCTION:
if (expr->value.function.esym == NULL
- || expr->ts.cl->length->expr_type == EXPR_CONSTANT)
+ || expr->ts.u.cl->length->expr_type == EXPR_CONSTANT)
{
- gfc_conv_string_length (expr->ts.cl, expr, &se->pre);
+ gfc_conv_string_length (expr->ts.u.cl, expr, &se->pre);
break;
}
@@ -4932,19 +4932,19 @@ get_array_charlen (gfc_expr *expr, gfc_s
gfc_init_se (&tse, NULL);
/* Build the expression for the character length and convert it. */
- gfc_apply_interface_mapping (&mapping, &tse, expr->ts.cl->length);
+ gfc_apply_interface_mapping (&mapping, &tse, expr->ts.u.cl->length);
gfc_add_block_to_block (&se->pre, &tse.pre);
gfc_add_block_to_block (&se->post, &tse.post);
tse.expr = fold_convert (gfc_charlen_type_node, tse.expr);
tse.expr = fold_build2 (MAX_EXPR, gfc_charlen_type_node, tse.expr,
build_int_cst (gfc_charlen_type_node, 0));
- expr->ts.cl->backend_decl = tse.expr;
+ expr->ts.u.cl->backend_decl = tse.expr;
gfc_free_interface_mapping (&mapping);
break;
default:
- gfc_conv_string_length (expr->ts.cl, expr, &se->pre);
+ gfc_conv_string_length (expr->ts.u.cl, expr, &se->pre);
break;
}
}
@@ -5085,7 +5085,7 @@ gfc_conv_expr_descriptor (gfc_se * se, g
/* Elemental function. */
need_tmp = 1;
if (expr->ts.type == BT_CHARACTER
- && expr->ts.cl->length->expr_type != EXPR_CONSTANT)
+ && expr->ts.u.cl->length->expr_type != EXPR_CONSTANT)
get_array_charlen (expr, se);
info = NULL;
@@ -5147,13 +5147,13 @@ gfc_conv_expr_descriptor (gfc_se * se, g
loop.temp_ss->next = gfc_ss_terminator;
if (expr->ts.type == BT_CHARACTER
- && !expr->ts.cl->backend_decl)
+ && !expr->ts.u.cl->backend_decl)
get_array_charlen (expr, se);
loop.temp_ss->data.temp.type = gfc_typenode_for_spec (&expr->ts);
if (expr->ts.type == BT_CHARACTER)
- loop.temp_ss->string_length = expr->ts.cl->backend_decl;
+ loop.temp_ss->string_length = expr->ts.u.cl->backend_decl;
else
loop.temp_ss->string_length = NULL;
@@ -5469,7 +5469,7 @@ gfc_conv_array_parameter (gfc_se * se, g
if (expr->expr_type == EXPR_ARRAY && expr->ts.type == BT_CHARACTER)
{
get_array_ctor_strlen (&se->pre, expr->value.constructor, &tmp);
- expr->ts.cl->backend_decl = tmp;
+ expr->ts.u.cl->backend_decl = tmp;
se->string_length = tmp;
}
@@ -5486,7 +5486,7 @@ gfc_conv_array_parameter (gfc_se * se, g
tmp = gfc_get_symbol_decl (sym);
if (sym->ts.type == BT_CHARACTER)
- se->string_length = sym->ts.cl->backend_decl;
+ se->string_length = sym->ts.u.cl->backend_decl;
if (!sym->attr.pointer && sym->as->type != AS_ASSUMED_SHAPE
&& !sym->attr.allocatable)
{
@@ -5543,12 +5543,12 @@ gfc_conv_array_parameter (gfc_se * se, g
/* Deallocate the allocatable components of structures that are
not variable. */
if (expr->ts.type == BT_DERIVED
- && expr->ts.derived->attr.alloc_comp
+ && expr->ts.u.derived->attr.alloc_comp
&& expr->expr_type != EXPR_VARIABLE)
{
tmp = build_fold_indirect_ref_loc (input_location,
se->expr);
- tmp = gfc_deallocate_alloc_comp (expr->ts.derived, tmp, expr->rank);
+ tmp = gfc_deallocate_alloc_comp (expr->ts.u.derived, tmp, expr->rank);
gfc_add_expr_to_block (&se->post, tmp);
}
@@ -5854,7 +5854,7 @@ structure_alloc_comps (gfc_symbol * der_
for (c = der_type->components; c; c = c->next)
{
bool cmp_has_alloc_comps = (c->ts.type == BT_DERIVED)
- && c->ts.derived->attr.alloc_comp;
+ && c->ts.u.derived->attr.alloc_comp;
cdecl = c->backend_decl;
ctype = TREE_TYPE (cdecl);
@@ -5868,7 +5868,7 @@ structure_alloc_comps (gfc_symbol * der_
comp = fold_build3 (COMPONENT_REF, ctype,
decl, cdecl, NULL_TREE);
rank = c->as ? c->as->rank : 0;
- tmp = structure_alloc_comps (c->ts.derived, comp, NULL_TREE,
+ tmp = structure_alloc_comps (c->ts.u.derived, comp, NULL_TREE,
rank, purpose);
gfc_add_expr_to_block (&fnblock, tmp);
}
@@ -5896,7 +5896,7 @@ structure_alloc_comps (gfc_symbol * der_
comp = fold_build3 (COMPONENT_REF, ctype,
decl, cdecl, NULL_TREE);
rank = c->as ? c->as->rank : 0;
- tmp = structure_alloc_comps (c->ts.derived, comp, NULL_TREE,
+ tmp = structure_alloc_comps (c->ts.u.derived, comp, NULL_TREE,
rank, purpose);
gfc_add_expr_to_block (&fnblock, tmp);
}
@@ -5922,7 +5922,7 @@ structure_alloc_comps (gfc_symbol * der_
rank = c->as ? c->as->rank : 0;
tmp = fold_convert (TREE_TYPE (dcmp), comp);
gfc_add_modify (&fnblock, dcmp, tmp);
- tmp = structure_alloc_comps (c->ts.derived, comp, dcmp,
+ tmp = structure_alloc_comps (c->ts.u.derived, comp, dcmp,
rank, purpose);
gfc_add_expr_to_block (&fnblock, tmp);
}
@@ -5985,7 +5985,7 @@ gfc_trans_deferred_array (gfc_symbol * s
bool sym_has_alloc_comp;
sym_has_alloc_comp = (sym->ts.type == BT_DERIVED)
- && sym->ts.derived->attr.alloc_comp;
+ && sym->ts.u.derived->attr.alloc_comp;
/* Make sure the frontend gets these right. */
if (!(sym->attr.pointer || sym->attr.allocatable || sym_has_alloc_comp))
@@ -5999,9 +5999,9 @@ gfc_trans_deferred_array (gfc_symbol * s
|| TREE_CODE (sym->backend_decl) == PARM_DECL);
if (sym->ts.type == BT_CHARACTER
- && !INTEGER_CST_P (sym->ts.cl->backend_decl))
+ && !INTEGER_CST_P (sym->ts.u.cl->backend_decl))
{
- gfc_conv_string_length (sym->ts.cl, NULL, &fnblock);
+ gfc_conv_string_length (sym->ts.u.cl, NULL, &fnblock);
gfc_trans_vla_type_sizes (sym, &fnblock);
}
@@ -6035,7 +6035,7 @@ gfc_trans_deferred_array (gfc_symbol * s
if (!sym->attr.save)
{
rank = sym->as ? sym->as->rank : 0;
- tmp = gfc_nullify_alloc_comp (sym->ts.derived, descriptor, rank);
+ tmp = gfc_nullify_alloc_comp (sym->ts.u.derived, descriptor, rank);
gfc_add_expr_to_block (&fnblock, tmp);
if (sym->value)
{
@@ -6068,7 +6068,7 @@ gfc_trans_deferred_array (gfc_symbol * s
{
int rank;
rank = sym->as ? sym->as->rank : 0;
- tmp = gfc_deallocate_alloc_comp (sym->ts.derived, descriptor, rank);
+ tmp = gfc_deallocate_alloc_comp (sym->ts.u.derived, descriptor, rank);
gfc_add_expr_to_block (&fnblock, tmp);
}
Index: gcc/fortran/trans-expr.c
===================================================================
--- gcc/fortran/trans-expr.c (revision 150364)
+++ gcc/fortran/trans-expr.c (working copy)
@@ -201,12 +201,12 @@ gfc_get_expr_charlen (gfc_expr *e)
length = NULL; /* To silence compiler warning. */
- if (is_subref_array (e) && e->ts.cl->length)
+ if (is_subref_array (e) && e->ts.u.cl->length)
{
gfc_se tmpse;
gfc_init_se (&tmpse, NULL);
- gfc_conv_expr_type (&tmpse, e->ts.cl->length, gfc_charlen_type_node);
- e->ts.cl->backend_decl = tmpse.expr;
+ gfc_conv_expr_type (&tmpse, e->ts.u.cl->length, gfc_charlen_type_node);
+ e->ts.u.cl->backend_decl = tmpse.expr;
return tmpse.expr;
}
@@ -214,7 +214,7 @@ gfc_get_expr_charlen (gfc_expr *e)
expression's length could be the length of the character
variable. */
if (e->symtree->n.sym->ts.type == BT_CHARACTER)
- length = e->symtree->n.sym->ts.cl->backend_decl;
+ length = e->symtree->n.sym->ts.u.cl->backend_decl;
/* Look through the reference chain for component references. */
for (r = e->ref; r; r = r->next)
@@ -223,7 +223,7 @@ gfc_get_expr_charlen (gfc_expr *e)
{
case REF_COMPONENT:
if (r->u.c.component->ts.type == BT_CHARACTER)
- length = r->u.c.component->ts.cl->backend_decl;
+ length = r->u.c.component->ts.u.cl->backend_decl;
break;
case REF_ARRAY:
@@ -243,7 +243,7 @@ gfc_get_expr_charlen (gfc_expr *e)
}
-/* For each character array constructor subexpression without a ts.cl->length,
+/* For each character array constructor subexpression without a ts.u.cl->length,
replace it by its first element (if there aren't any elements, the length
should already be set to zero). */
@@ -276,7 +276,7 @@ flatten_array_ctors_without_strlen (gfc_
case EXPR_ARRAY:
/* We've found what we're looking for. */
- if (e->ts.type == BT_CHARACTER && !e->ts.cl->length)
+ if (e->ts.type == BT_CHARACTER && !e->ts.u.cl->length)
{
gfc_expr* new_expr;
gcc_assert (e->value.constructor);
@@ -472,7 +472,7 @@ gfc_conv_component_ref (gfc_se * se, gfc
if (c->ts.type == BT_CHARACTER)
{
- tmp = c->ts.cl->backend_decl;
+ tmp = c->ts.u.cl->backend_decl;
/* Components must always be constant length. */
gcc_assert (tmp && INTEGER_CST_P (tmp));
se->string_length = tmp;
@@ -513,7 +513,7 @@ conv_parent_component_references (gfc_se
/* Otherwise build the reference and call self. */
gfc_conv_component_ref (se, &parent);
- parent.u.c.sym = dt->components->ts.derived;
+ parent.u.c.sym = dt->components->ts.u.derived;
parent.u.c.component = c;
conv_parent_component_references (se, &parent);
}
@@ -662,10 +662,10 @@ gfc_conv_variable (gfc_se * se, gfc_expr
{
/* If the character length of an entry isn't set, get the length from
the master function instead. */
- if (sym->attr.entry && !sym->ts.cl->backend_decl)
- se->string_length = sym->ns->proc_name->ts.cl->backend_decl;
+ if (sym->attr.entry && !sym->ts.u.cl->backend_decl)
+ se->string_length = sym->ns->proc_name->ts.u.cl->backend_decl;
else
- se->string_length = sym->ts.cl->backend_decl;
+ se->string_length = sym->ts.u.cl->backend_decl;
gcc_assert (se->string_length);
}
@@ -1159,7 +1159,7 @@ gfc_conv_concat_op (gfc_se * se, gfc_exp
gfc_add_block_to_block (&se->pre, &lse.pre);
gfc_add_block_to_block (&se->pre, &rse.pre);
- type = gfc_get_character_type (expr->ts.kind, expr->ts.cl);
+ type = gfc_get_character_type (expr->ts.kind, expr->ts.u.cl);
len = TYPE_MAX_VALUE (TYPE_DOMAIN (type));
if (len == NULL_TREE)
{
@@ -1723,16 +1723,16 @@ gfc_add_interface_mapping (gfc_interface
if (sym->ts.type == BT_CHARACTER)
{
/* Create a copy of the dummy argument's length. */
- new_sym->ts.cl = gfc_get_interface_mapping_charlen (mapping, sym->ts.cl);
- sm->expr->ts.cl = new_sym->ts.cl;
+ new_sym->ts.u.cl = gfc_get_interface_mapping_charlen (mapping, sym->ts.u.cl);
+ sm->expr->ts.u.cl = new_sym->ts.u.cl;
/* If the length is specified as "*", record the length that
the caller is passing. We should use the callee's length
in all other cases. */
- if (!new_sym->ts.cl->length && se)
+ if (!new_sym->ts.u.cl->length && se)
{
se->string_length = gfc_evaluate_now (se->string_length, &se->pre);
- new_sym->ts.cl->backend_decl = se->string_length;
+ new_sym->ts.u.cl->backend_decl = se->string_length;
}
}
@@ -1764,7 +1764,7 @@ gfc_add_interface_mapping (gfc_interface
se->expr);
/* For character(*), use the actual argument's descriptor. */
- else if (sym->ts.type == BT_CHARACTER && !new_sym->ts.cl->length)
+ else if (sym->ts.type == BT_CHARACTER && !new_sym->ts.u.cl->length)
value = build_fold_indirect_ref_loc (input_location,
se->expr);
@@ -1809,9 +1809,9 @@ gfc_finish_interface_mapping (gfc_interf
for (sym = mapping->syms; sym; sym = sym->next)
if (sym->new_sym->n.sym->ts.type == BT_CHARACTER
- && !sym->new_sym->n.sym->ts.cl->backend_decl)
+ && !sym->new_sym->n.sym->ts.u.cl->backend_decl)
{
- expr = sym->new_sym->n.sym->ts.cl->length;
+ expr = sym->new_sym->n.sym->ts.u.cl->length;
gfc_apply_interface_mapping_to_expr (mapping, expr);
gfc_init_se (&se, NULL);
gfc_conv_expr (&se, expr);
@@ -1820,7 +1820,7 @@ gfc_finish_interface_mapping (gfc_interf
gfc_add_block_to_block (pre, &se.pre);
gfc_add_block_to_block (post, &se.post);
- sym->new_sym->n.sym->ts.cl->backend_decl = se.expr;
+ sym->new_sym->n.sym->ts.u.cl->backend_decl = se.expr;
}
}
@@ -1907,12 +1907,12 @@ gfc_map_intrinsic_function (gfc_expr *ex
case GFC_ISYM_LEN:
/* TODO figure out why this condition is necessary. */
if (sym->attr.function
- && (arg1->ts.cl->length == NULL
- || (arg1->ts.cl->length->expr_type != EXPR_CONSTANT
- && arg1->ts.cl->length->expr_type != EXPR_VARIABLE)))
+ && (arg1->ts.u.cl->length == NULL
+ || (arg1->ts.u.cl->length->expr_type != EXPR_CONSTANT
+ && arg1->ts.u.cl->length->expr_type != EXPR_VARIABLE)))
return false;
- new_expr = gfc_copy_expr (arg1->ts.cl->length);
+ new_expr = gfc_copy_expr (arg1->ts.u.cl->length);
break;
case GFC_ISYM_SIZE:
@@ -2025,11 +2025,11 @@ gfc_map_fcn_formal_to_actual (gfc_expr *
if (map_expr->symtree->n.sym->ts.type == BT_CHARACTER)
{
- expr->value.function.esym->ts.cl->length
- = gfc_copy_expr (map_expr->symtree->n.sym->ts.cl->length);
+ expr->value.function.esym->ts.u.cl->length
+ = gfc_copy_expr (map_expr->symtree->n.sym->ts.u.cl->length);
gfc_apply_interface_mapping_to_expr (mapping,
- expr->value.function.esym->ts.cl->length);
+ expr->value.function.esym->ts.u.cl->length);
}
}
@@ -2050,10 +2050,10 @@ gfc_apply_interface_mapping_to_expr (gfc
return;
/* Copying an expression does not copy its length, so do that here. */
- if (expr->ts.type == BT_CHARACTER && expr->ts.cl)
+ if (expr->ts.type == BT_CHARACTER && expr->ts.u.cl)
{
- expr->ts.cl = gfc_get_interface_mapping_charlen (mapping, expr->ts.cl);
- gfc_apply_interface_mapping_to_expr (mapping, expr->ts.cl->length);
+ expr->ts.u.cl = gfc_get_interface_mapping_charlen (mapping, expr->ts.u.cl);
+ gfc_apply_interface_mapping_to_expr (mapping, expr->ts.u.cl->length);
}
/* Apply the mapping to any references. */
@@ -2173,8 +2173,8 @@ gfc_conv_subref_array_arg (gfc_se * parm
gfc_conv_ss_startstride (&loop);
/* Build an ss for the temporary. */
- if (expr->ts.type == BT_CHARACTER && !expr->ts.cl->backend_decl)
- gfc_conv_string_length (expr->ts.cl, expr, &parmse->pre);
+ if (expr->ts.type == BT_CHARACTER && !expr->ts.u.cl->backend_decl)
+ gfc_conv_string_length (expr->ts.u.cl, expr, &parmse->pre);
base_type = gfc_typenode_for_spec (&expr->ts);
if (GFC_ARRAY_TYPE_P (base_type)
@@ -2186,7 +2186,7 @@ gfc_conv_subref_array_arg (gfc_se * parm
loop.temp_ss->data.temp.type = base_type;
if (expr->ts.type == BT_CHARACTER)
- loop.temp_ss->string_length = expr->ts.cl->backend_decl;
+ loop.temp_ss->string_length = expr->ts.u.cl->backend_decl;
else
loop.temp_ss->string_length = NULL;
@@ -2315,7 +2315,7 @@ gfc_conv_subref_array_arg (gfc_se * parm
rse.expr = gfc_build_array_ref (tmp, tmp_index, NULL);
if (expr->ts.type == BT_CHARACTER)
- rse.string_length = expr->ts.cl->backend_decl;
+ rse.string_length = expr->ts.u.cl->backend_decl;
gfc_conv_expr (&lse, expr);
@@ -2343,7 +2343,7 @@ gfc_conv_subref_array_arg (gfc_se * parm
/* Pass the string length to the argument expression. */
if (expr->ts.type == BT_CHARACTER)
- parmse->string_length = expr->ts.cl->backend_decl;
+ parmse->string_length = expr->ts.u.cl->backend_decl;
/* We want either the address for the data or the address of the descriptor,
depending on the mode of passing array arguments. */
@@ -2457,9 +2457,9 @@ gfc_conv_procedure_call (gfc_se * se, gf
}
else if (sym->intmod_sym_id == ISOCBINDING_FUNLOC)
{
- arg->expr->ts.type = sym->ts.derived->ts.type;
- arg->expr->ts.f90_type = sym->ts.derived->ts.f90_type;
- arg->expr->ts.kind = sym->ts.derived->ts.kind;
+ arg->expr->ts.type = sym->ts.u.derived->ts.type;
+ arg->expr->ts.f90_type = sym->ts.u.derived->ts.f90_type;
+ arg->expr->ts.kind = sym->ts.u.derived->ts.kind;
gfc_conv_expr_reference (se, arg->expr);
return 0;
@@ -2572,8 +2572,8 @@ gfc_conv_procedure_call (gfc_se * se, gf
gfc_init_block (&post);
gfc_init_interface_mapping (&mapping);
need_interface_mapping = ((sym->ts.type == BT_CHARACTER
- && sym->ts.cl->length
- && sym->ts.cl->length->expr_type
+ && sym->ts.u.cl->length
+ && sym->ts.u.cl->length->expr_type
!= EXPR_CONSTANT)
|| (comp && comp->attr.dimension)
|| (!comp && sym->attr.dimension));
@@ -2752,11 +2752,11 @@ gfc_conv_procedure_call (gfc_se * se, gf
&& parmse.string_length == NULL_TREE
&& e->ts.type == BT_PROCEDURE
&& e->symtree->n.sym->ts.type == BT_CHARACTER
- && e->symtree->n.sym->ts.cl->length != NULL
- && e->symtree->n.sym->ts.cl->length->expr_type == EXPR_CONSTANT)
+ && e->symtree->n.sym->ts.u.cl->length != NULL
+ && e->symtree->n.sym->ts.u.cl->length->expr_type == EXPR_CONSTANT)
{
- gfc_conv_const_charlen (e->symtree->n.sym->ts.cl);
- parmse.string_length = e->symtree->n.sym->ts.cl->backend_decl;
+ gfc_conv_const_charlen (e->symtree->n.sym->ts.u.cl);
+ parmse.string_length = e->symtree->n.sym->ts.u.cl->backend_decl;
}
}
@@ -2770,7 +2770,7 @@ gfc_conv_procedure_call (gfc_se * se, gf
deallocated for non-variable scalars. Non-variable arrays are
dealt with in trans-array.c(gfc_conv_array_parameter). */
if (e && e->ts.type == BT_DERIVED
- && e->ts.derived->attr.alloc_comp
+ && e->ts.u.derived->attr.alloc_comp
&& !(e->symtree && e->symtree->n.sym->attr.pointer)
&& (e->expr_type != EXPR_VARIABLE && !e->rank))
{
@@ -2797,11 +2797,11 @@ gfc_conv_procedure_call (gfc_se * se, gf
{
tree local_tmp;
local_tmp = gfc_evaluate_now (tmp, &se->pre);
- local_tmp = gfc_copy_alloc_comp (e->ts.derived, local_tmp, tmp, parm_rank);
+ local_tmp = gfc_copy_alloc_comp (e->ts.u.derived, local_tmp, tmp, parm_rank);
gfc_add_expr_to_block (&se->post, local_tmp);
}
- tmp = gfc_deallocate_alloc_comp (e->ts.derived, tmp, parm_rank);
+ tmp = gfc_deallocate_alloc_comp (e->ts.u.derived, tmp, parm_rank);
gfc_add_expr_to_block (&se->post, tmp);
}
@@ -2911,7 +2911,7 @@ gfc_conv_procedure_call (gfc_se * se, gf
se->string_length = build_int_cst (gfc_charlen_type_node, 1);
else if (ts.type == BT_CHARACTER)
{
- if (sym->ts.cl->length == NULL)
+ if (sym->ts.u.cl->length == NULL)
{
/* Assumed character length results are not allowed by 5.1.1.5 of the
standard and are trapped in resolve.c; except in the case of SPREAD
@@ -2926,7 +2926,7 @@ gfc_conv_procedure_call (gfc_se * se, gf
formal = sym->ns->proc_name->formal;
for (; formal; formal = formal->next)
if (strcmp (formal->sym->name, sym->name) == 0)
- cl.backend_decl = formal->sym->ts.cl->backend_decl;
+ cl.backend_decl = formal->sym->ts.u.cl->backend_decl;
}
}
else
@@ -2936,9 +2936,9 @@ gfc_conv_procedure_call (gfc_se * se, gf
/* Calculate the length of the returned string. */
gfc_init_se (&parmse, NULL);
if (need_interface_mapping)
- gfc_apply_interface_mapping (&mapping, &parmse, sym->ts.cl->length);
+ gfc_apply_interface_mapping (&mapping, &parmse, sym->ts.u.cl->length);
else
- gfc_conv_expr (&parmse, sym->ts.cl->length);
+ gfc_conv_expr (&parmse, sym->ts.u.cl->length);
gfc_add_block_to_block (&se->pre, &parmse.pre);
gfc_add_block_to_block (&se->post, &parmse.post);
@@ -2951,7 +2951,7 @@ gfc_conv_procedure_call (gfc_se * se, gf
/* Set up a charlen structure for it. */
cl.next = NULL;
cl.length = NULL;
- ts.cl = &cl;
+ ts.u.cl = &cl;
len = cl.backend_decl;
}
@@ -3024,7 +3024,7 @@ gfc_conv_procedure_call (gfc_se * se, gf
else if (ts.type == BT_CHARACTER)
{
/* Pass the string length. */
- type = gfc_get_character_type (ts.kind, ts.cl);
+ type = gfc_get_character_type (ts.kind, ts.u.cl);
type = build_pointer_type (type);
/* Return an address to a char[0:len-1]* temporary for
@@ -3418,8 +3418,8 @@ gfc_conv_statement_function (gfc_se * se
/* Copy string arguments. */
tree arglen;
- gcc_assert (fsym->ts.cl && fsym->ts.cl->length
- && fsym->ts.cl->length->expr_type == EXPR_CONSTANT);
+ gcc_assert (fsym->ts.u.cl && fsym->ts.u.cl->length
+ && fsym->ts.u.cl->length->expr_type == EXPR_CONSTANT);
arglen = TYPE_MAX_VALUE (TYPE_DOMAIN (type));
tmp = gfc_build_addr_expr (build_pointer_type (type),
@@ -3456,22 +3456,22 @@ gfc_conv_statement_function (gfc_se * se
if (sym->ts.type == BT_CHARACTER)
{
- gfc_conv_const_charlen (sym->ts.cl);
+ gfc_conv_const_charlen (sym->ts.u.cl);
/* Force the expression to the correct length. */
if (!INTEGER_CST_P (se->string_length)
|| tree_int_cst_lt (se->string_length,
- sym->ts.cl->backend_decl))
+ sym->ts.u.cl->backend_decl))
{
- type = gfc_get_character_type (sym->ts.kind, sym->ts.cl);
+ type = gfc_get_character_type (sym->ts.kind, sym->ts.u.cl);
tmp = gfc_create_var (type, sym->name);
tmp = gfc_build_addr_expr (build_pointer_type (type), tmp);
- gfc_trans_string_copy (&se->pre, sym->ts.cl->backend_decl, tmp,
+ gfc_trans_string_copy (&se->pre, sym->ts.u.cl->backend_decl, tmp,
sym->ts.kind, se->string_length, se->expr,
sym->ts.kind);
se->expr = tmp;
}
- se->string_length = sym->ts.cl->backend_decl;
+ se->string_length = sym->ts.u.cl->backend_decl;
}
/* Restore the original variables. */
@@ -3558,9 +3558,9 @@ gfc_conv_initializer (gfc_expr * expr, g
used as initialization expressions). If so, we need to modify
the 'expr' to be that for a (void *). */
if (expr != NULL && expr->ts.type == BT_DERIVED
- && expr->ts.is_iso_c && expr->ts.derived)
+ && expr->ts.is_iso_c && expr->ts.u.derived)
{
- gfc_symbol *derived = expr->ts.derived;
+ gfc_symbol *derived = expr->ts.u.derived;
expr = gfc_int_expr (0);
@@ -3590,7 +3590,7 @@ gfc_conv_initializer (gfc_expr * expr, g
return se.expr;
case BT_CHARACTER:
- return gfc_conv_string_init (ts->cl->backend_decl,expr);
+ return gfc_conv_string_init (ts->u.cl->backend_decl,expr);
default:
gfc_init_se (&se, NULL);
@@ -3678,7 +3678,7 @@ gfc_trans_subarray_assign (tree dest, gf
gfc_conv_tmp_array_ref (&lse);
if (cm->ts.type == BT_CHARACTER)
- lse.string_length = cm->ts.cl->backend_decl;
+ lse.string_length = cm->ts.u.cl->backend_decl;
gfc_conv_expr (&rse, expr);
@@ -3765,8 +3765,8 @@ gfc_trans_subcomponent_assign (tree dest
gfc_add_block_to_block (&block, &se.pre);
gfc_add_modify (&block, dest, se.expr);
- if (cm->ts.type == BT_DERIVED && cm->ts.derived->attr.alloc_comp)
- tmp = gfc_copy_alloc_comp (cm->ts.derived, se.expr, dest,
+ if (cm->ts.type == BT_DERIVED && cm->ts.u.derived->attr.alloc_comp)
+ tmp = gfc_copy_alloc_comp (cm->ts.u.derived, se.expr, dest,
cm->as->rank);
else
tmp = gfc_duplicate_allocatable (dest, se.expr,
@@ -3871,7 +3871,7 @@ gfc_trans_subcomponent_assign (tree dest
gfc_conv_expr (&se, expr);
if (cm->ts.type == BT_CHARACTER)
- lse.string_length = cm->ts.cl->backend_decl;
+ lse.string_length = cm->ts.u.cl->backend_decl;
lse.expr = dest;
tmp = gfc_trans_scalar_assign (&lse, &se, cm->ts, true, false);
gfc_add_expr_to_block (&block, tmp);
@@ -3891,7 +3891,7 @@ gfc_trans_structure_assign (tree dest, g
tree tmp;
gfc_start_block (&block);
- cm = expr->ts.derived->components;
+ cm = expr->ts.u.derived->components;
for (c = expr->value.constructor; c; c = c->next, cm = cm->next)
{
/* Skip absent members in default initializers. */
@@ -3927,13 +3927,13 @@ gfc_conv_structure (gfc_se * se, gfc_exp
if (!init)
{
/* Create a temporary variable and fill it in. */
- se->expr = gfc_create_var (type, expr->ts.derived->name);
+ se->expr = gfc_create_var (type, expr->ts.u.derived->name);
tmp = gfc_trans_structure_assign (se->expr, expr);
gfc_add_expr_to_block (&se->pre, tmp);
return;
}
- cm = expr->ts.derived->components;
+ cm = expr->ts.u.derived->components;
for (c = expr->value.constructor; c; c = c->next, cm = cm->next)
{
@@ -4003,8 +4003,8 @@ gfc_conv_expr (gfc_se * se, gfc_expr * e
null_pointer_node. C_PTR and C_FUNPTR are converted to match the
typespec for the C_PTR and C_FUNPTR symbols, which has already been
updated to be an integer with a kind equal to the size of a (void *). */
- if (expr->ts.type == BT_DERIVED && expr->ts.derived
- && expr->ts.derived->attr.is_iso_c)
+ if (expr->ts.type == BT_DERIVED && expr->ts.u.derived
+ && expr->ts.u.derived->attr.is_iso_c)
{
if (expr->symtree->n.sym->intmod_sym_id == ISOCBINDING_NULL_PTR
|| expr->symtree->n.sym->intmod_sym_id == ISOCBINDING_NULL_FUNPTR)
@@ -4017,9 +4017,9 @@ gfc_conv_expr (gfc_se * se, gfc_expr * e
{
/* Update the type/kind of the expression to be what the new
type/kind are for the updated symbols of C_PTR/C_FUNPTR. */
- expr->ts.type = expr->ts.derived->ts.type;
- expr->ts.f90_type = expr->ts.derived->ts.f90_type;
- expr->ts.kind = expr->ts.derived->ts.kind;
+ expr->ts.type = expr->ts.u.derived->ts.type;
+ expr->ts.f90_type = expr->ts.u.derived->ts.f90_type;
+ expr->ts.kind = expr->ts.u.derived->ts.kind;
}
}
@@ -4388,7 +4388,7 @@ gfc_trans_scalar_assign (gfc_se * lse, g
gfc_trans_string_copy (&block, llen, lse->expr, ts.kind, rlen,
rse->expr, ts.kind);
}
- else if (ts.type == BT_DERIVED && ts.derived->attr.alloc_comp)
+ else if (ts.type == BT_DERIVED && ts.u.derived->attr.alloc_comp)
{
cond = NULL_TREE;
@@ -4408,7 +4408,7 @@ gfc_trans_scalar_assign (gfc_se * lse, g
if (!l_is_temp)
{
tmp = gfc_evaluate_now (lse->expr, &lse->pre);
- tmp = gfc_deallocate_alloc_comp (ts.derived, tmp, 0);
+ tmp = gfc_deallocate_alloc_comp (ts.u.derived, tmp, 0);
if (r_is_var)
tmp = build3_v (COND_EXPR, cond, build_empty_stmt (input_location),
tmp);
@@ -4425,7 +4425,7 @@ gfc_trans_scalar_assign (gfc_se * lse, g
same as the lhs. */
if (r_is_var)
{
- tmp = gfc_copy_alloc_comp (ts.derived, rse->expr, lse->expr, 0);
+ tmp = gfc_copy_alloc_comp (ts.u.derived, rse->expr, lse->expr, 0);
tmp = build3_v (COND_EXPR, cond, build_empty_stmt (input_location),
tmp);
gfc_add_expr_to_block (&block, tmp);
@@ -4503,16 +4503,16 @@ gfc_trans_arrayfunc_assign (gfc_expr * e
character lengths are the same. */
if (expr2->ts.type == BT_CHARACTER && expr2->rank > 0)
{
- if (expr1->ts.cl->length == NULL
- || expr1->ts.cl->length->expr_type != EXPR_CONSTANT)
+ if (expr1->ts.u.cl->length == NULL
+ || expr1->ts.u.cl->length->expr_type != EXPR_CONSTANT)
return NULL;
- if (expr2->ts.cl->length == NULL
- || expr2->ts.cl->length->expr_type != EXPR_CONSTANT)
+ if (expr2->ts.u.cl->length == NULL
+ || expr2->ts.u.cl->length->expr_type != EXPR_CONSTANT)
return NULL;
- if (mpz_cmp (expr1->ts.cl->length->value.integer,
- expr2->ts.cl->length->value.integer) != 0)
+ if (mpz_cmp (expr1->ts.u.cl->length->value.integer,
+ expr2->ts.u.cl->length->value.integer) != 0)
return NULL;
}
@@ -4886,13 +4886,13 @@ gfc_trans_assignment_1 (gfc_expr * expr1
to arrays must be done with a deep copy and the rhs temporary
must have its components deallocated afterwards. */
scalar_to_array = (expr2->ts.type == BT_DERIVED
- && expr2->ts.derived->attr.alloc_comp
+ && expr2->ts.u.derived->attr.alloc_comp
&& expr2->expr_type != EXPR_VARIABLE
&& !gfc_is_constant_expr (expr2)
&& expr1->rank && !expr2->rank);
if (scalar_to_array)
{
- tmp = gfc_deallocate_alloc_comp (expr2->ts.derived, rse.expr, 0);
+ tmp = gfc_deallocate_alloc_comp (expr2->ts.u.derived, rse.expr, 0);
gfc_add_expr_to_block (&loop.post, tmp);
}
@@ -4982,7 +4982,7 @@ copyable_array_p (gfc_expr * expr)
return false;
case BT_DERIVED:
- return !expr->ts.derived->attr.alloc_comp;
+ return !expr->ts.u.derived->attr.alloc_comp;
default:
break;
Index: gcc/fortran/symbol.c
===================================================================
--- gcc/fortran/symbol.c (revision 150364)
+++ gcc/fortran/symbol.c (working copy)
@@ -269,10 +269,10 @@ gfc_set_default_type (gfc_symbol *sym, i
sym->ts = *ts;
sym->attr.implicit_type = 1;
- if (ts->cl)
+ if (ts->type == BT_CHARACTER && ts->u.cl)
{
- sym->ts.cl = gfc_get_charlen ();
- *sym->ts.cl = *ts->cl;
+ sym->ts.u.cl = gfc_get_charlen ();
+ *sym->ts.u.cl = *ts->u.cl;
}
if (sym->attr.is_bind_c == 1)
@@ -1770,10 +1770,10 @@ gfc_add_component (gfc_symbol *sym, cons
}
if (sym->attr.extension
- && gfc_find_component (sym->components->ts.derived, name, true, true))
+ && gfc_find_component (sym->components->ts.u.derived, name, true, true))
{
gfc_error ("Component '%s' at %C already in the parent type "
- "at %L", name, &sym->components->ts.derived->declared_at);
+ "at %L", name, &sym->components->ts.u.derived->declared_at);
return FAILURE;
}
@@ -1806,8 +1806,8 @@ switch_types (gfc_symtree *st, gfc_symbo
return;
sym = st->n.sym;
- if (sym->ts.type == BT_DERIVED && sym->ts.derived == from)
- sym->ts.derived = to;
+ if (sym->ts.type == BT_DERIVED && sym->ts.u.derived == from)
+ sym->ts.u.derived = to;
switch_types (st->left, from, to);
switch_types (st->right, from, to);
@@ -1859,8 +1859,8 @@ gfc_use_derived (gfc_symbol *sym)
for (i = 0; i < GFC_LETTERS; i++)
{
t = &sym->ns->default_type[i];
- if (t->derived == sym)
- t->derived = s;
+ if (t->u.derived == sym)
+ t->u.derived = s;
}
st = gfc_find_symtree (sym->ns->sym_root, sym->name);
@@ -1913,7 +1913,7 @@ gfc_find_component (gfc_symbol *sym, con
&& sym->attr.extension
&& sym->components->ts.type == BT_DERIVED)
{
- p = gfc_find_component (sym->components->ts.derived, name,
+ p = gfc_find_component (sym->components->ts.u.derived, name,
noaccess, silent);
/* Do not overwrite the error. */
if (p == NULL)
@@ -3257,8 +3257,8 @@ gfc_is_var_automatic (gfc_symbol *sym)
return true;
/* Check for non-constant length character variables. */
if (sym->ts.type == BT_CHARACTER
- && sym->ts.cl
- && !gfc_is_constant_expr (sym->ts.cl->length))
+ && sym->ts.u.cl
+ && !gfc_is_constant_expr (sym->ts.u.cl->length))
return true;
return false;
}
@@ -3475,14 +3475,14 @@ verify_bind_c_derived_type (gfc_symbol *
/* BIND(C) derived types must have interoperable components. */
if (curr_comp->ts.type == BT_DERIVED
- && curr_comp->ts.derived->ts.is_iso_c != 1
- && curr_comp->ts.derived != derived_sym)
+ && curr_comp->ts.u.derived->ts.is_iso_c != 1
+ && curr_comp->ts.u.derived != derived_sym)
{
/* This should be allowed; the draft says a derived-type can not
have type parameters if it is has the BIND attribute. Type
parameters seem to be for making parameterized derived types.
There's no need to verify the type if it is c_ptr/c_funptr. */
- retval = verify_bind_c_derived_type (curr_comp->ts.derived);
+ retval = verify_bind_c_derived_type (curr_comp->ts.u.derived);
}
else
{
@@ -3581,10 +3581,10 @@ gen_special_c_interop_ptr (int ptr_id, c
/* The c_ptr and c_funptr derived types will provide the
definition for c_null_ptr and c_null_funptr, respectively. */
if (ptr_id == ISOCBINDING_NULL_PTR)
- tmp_sym->ts.derived = get_iso_c_binding_dt (ISOCBINDING_PTR);
+ tmp_sym->ts.u.derived = get_iso_c_binding_dt (ISOCBINDING_PTR);
else
- tmp_sym->ts.derived = get_iso_c_binding_dt (ISOCBINDING_FUNPTR);
- if (tmp_sym->ts.derived == NULL)
+ tmp_sym->ts.u.derived = get_iso_c_binding_dt (ISOCBINDING_FUNPTR);
+ if (tmp_sym->ts.u.derived == NULL)
{
/* This can occur if the user forgot to declare c_ptr or
c_funptr and they're trying to use one of the procedures
@@ -3597,7 +3597,7 @@ gen_special_c_interop_ptr (int ptr_id, c
? "_gfortran_iso_c_binding_c_ptr"
: "_gfortran_iso_c_binding_c_funptr"));
- tmp_sym->ts.derived =
+ tmp_sym->ts.u.derived =
get_iso_c_binding_dt (ptr_id == ISOCBINDING_NULL_PTR
? ISOCBINDING_PTR : ISOCBINDING_FUNPTR);
}
@@ -3618,7 +3618,7 @@ gen_special_c_interop_ptr (int ptr_id, c
tmp_sym->value = gfc_get_expr ();
tmp_sym->value->expr_type = EXPR_STRUCTURE;
tmp_sym->value->ts.type = BT_DERIVED;
- tmp_sym->value->ts.derived = tmp_sym->ts.derived;
+ tmp_sym->value->ts.u.derived = tmp_sym->ts.u.derived;
/* Create a constructor with no expr, that way we can recognize if the user
tries to call the structure constructor for one of the iso_c_binding
derived types during resolution (resolve_structure_cons). */
@@ -3722,7 +3722,7 @@ gen_cptr_param (gfc_formal_arglist **hea
gfc_get_ha_symbol (c_ptr_type, &(c_ptr_sym));
}
- param_sym->ts.derived = c_ptr_sym;
+ param_sym->ts.u.derived = c_ptr_sym;
param_sym->module = gfc_get_string (module_name);
/* Make new formal arg. */
@@ -3950,7 +3950,7 @@ gfc_copy_formal_args_intr (gfc_symbol *d
formal_arg->sym->attr.dummy = 1;
if (formal_arg->sym->ts.type == BT_CHARACTER)
- formal_arg->sym->ts.cl = gfc_new_charlen (gfc_current_ns);
+ formal_arg->sym->ts.u.cl = gfc_new_charlen (gfc_current_ns);
/* If this isn't the first arg, set up the next ptr. For the
last arg built, the formal_arg->next will never get set to
@@ -4213,8 +4213,8 @@ generate_isocbinding_symbol (const char
tmp_sym->value->value.character.string[0]
= (gfc_char_t) c_interop_kinds_table[s].value;
tmp_sym->value->value.character.string[1] = '\0';
- tmp_sym->ts.cl = gfc_get_charlen ();
- tmp_sym->ts.cl->length = gfc_int_expr (1);
+ tmp_sym->ts.u.cl = gfc_get_charlen ();
+ tmp_sym->ts.u.cl->length = gfc_int_expr (1);
/* May not need this in both attr and ts, but do need in
attr for writing module file. */
@@ -4258,7 +4258,7 @@ generate_isocbinding_symbol (const char
tmp_sym->attr.referenced = 1;
- tmp_sym->ts.derived = tmp_sym;
+ tmp_sym->ts.u.derived = tmp_sym;
/* Add the symbol created for the derived type to the current ns. */
dt_list_ptr = &(gfc_derived_types);
@@ -4343,13 +4343,13 @@ generate_isocbinding_symbol (const char
C address of. */
tmp_sym->ts.type = BT_DERIVED;
if (s == ISOCBINDING_LOC)
- tmp_sym->ts.derived =
+ tmp_sym->ts.u.derived =
get_iso_c_binding_dt (ISOCBINDING_PTR);
else
- tmp_sym->ts.derived =
+ tmp_sym->ts.u.derived =
get_iso_c_binding_dt (ISOCBINDING_FUNPTR);
- if (tmp_sym->ts.derived == NULL)
+ if (tmp_sym->ts.u.derived == NULL)
{
/* Create the necessary derived type so we can continue
processing the file. */
@@ -4359,7 +4359,7 @@ generate_isocbinding_symbol (const char
(const char *)(s == ISOCBINDING_FUNLOC
? "_gfortran_iso_c_binding_c_funptr"
: "_gfortran_iso_c_binding_c_ptr"));
- tmp_sym->ts.derived =
+ tmp_sym->ts.u.derived =
get_iso_c_binding_dt (s == ISOCBINDING_FUNLOC
? ISOCBINDING_FUNPTR
: ISOCBINDING_PTR);
@@ -4511,9 +4511,9 @@ gfc_get_derived_super_type (gfc_symbol*
gcc_assert (derived->components);
gcc_assert (derived->components->ts.type == BT_DERIVED);
- gcc_assert (derived->components->ts.derived);
+ gcc_assert (derived->components->ts.u.derived);
- return derived->components->ts.derived;
+ return derived->components->ts.u.derived;
}
Index: gcc/fortran/decl.c
===================================================================
--- gcc/fortran/decl.c (revision 150364)
+++ gcc/fortran/decl.c (working copy)
@@ -622,8 +622,8 @@ char_len_param_value (gfc_expr **expr)
if (e->symtree->n.sym->ts.type == BT_UNKNOWN)
goto syntax;
if (e->symtree->n.sym->ts.type == BT_CHARACTER
- && e->symtree->n.sym->ts.cl
- && e->symtree->n.sym->ts.cl->length->ts.type == BT_UNKNOWN)
+ && e->symtree->n.sym->ts.u.cl
+ && e->symtree->n.sym->ts.u.cl->length->ts.type == BT_UNKNOWN)
goto syntax;
}
}
@@ -938,7 +938,7 @@ verify_c_interop_param (gfc_symbol *sym)
"because derived type '%s' is not C interoperable",
sym->name, &(sym->declared_at),
sym->ns->proc_name->name,
- sym->ts.derived->name);
+ sym->ts.u.derived->name);
else
gfc_warning ("Variable '%s' at %L is a parameter to the "
"BIND(C) procedure '%s' but may not be C "
@@ -951,7 +951,7 @@ verify_c_interop_param (gfc_symbol *sym)
length of 1. */
if (sym->ts.type == BT_CHARACTER)
{
- gfc_charlen *cl = sym->ts.cl;
+ gfc_charlen *cl = sym->ts.u.cl;
if (!cl || !cl->length || cl->length->expr_type != EXPR_CONSTANT
|| mpz_cmp_si (cl->length->value.integer, 1) != 0)
{
@@ -1045,7 +1045,7 @@ build_sym (const char *name, gfc_charlen
return FAILURE;
if (sym->ts.type == BT_CHARACTER)
- sym->ts.cl = cl;
+ sym->ts.u.cl = cl;
/* Add dimension attribute if present. */
if (gfc_set_array_spec (sym, *as, var_locus) == FAILURE)
@@ -1253,38 +1253,38 @@ add_init_expr_to_sym (const char *name,
&& gfc_check_assign_symbol (sym, init) == FAILURE)
return FAILURE;
- if (sym->ts.type == BT_CHARACTER && sym->ts.cl)
+ if (sym->ts.type == BT_CHARACTER && sym->ts.u.cl)
{
/* Update symbol character length according initializer. */
- if (sym->ts.cl->length == NULL)
+ if (sym->ts.u.cl->length == NULL)
{
int clen;
/* If there are multiple CHARACTER variables declared on the
same line, we don't want them to share the same length. */
- sym->ts.cl = gfc_new_charlen (gfc_current_ns);
+ sym->ts.u.cl = gfc_new_charlen (gfc_current_ns);
if (sym->attr.flavor == FL_PARAMETER)
{
if (init->expr_type == EXPR_CONSTANT)
{
clen = init->value.character.length;
- sym->ts.cl->length = gfc_int_expr (clen);
+ sym->ts.u.cl->length = gfc_int_expr (clen);
}
else if (init->expr_type == EXPR_ARRAY)
{
gfc_expr *p = init->value.constructor->expr;
clen = p->value.character.length;
- sym->ts.cl->length = gfc_int_expr (clen);
+ sym->ts.u.cl->length = gfc_int_expr (clen);
}
- else if (init->ts.cl && init->ts.cl->length)
- sym->ts.cl->length =
- gfc_copy_expr (sym->value->ts.cl->length);
+ else if (init->ts.u.cl && init->ts.u.cl->length)
+ sym->ts.u.cl->length =
+ gfc_copy_expr (sym->value->ts.u.cl->length);
}
}
/* Update initializer character length according symbol. */
- else if (sym->ts.cl->length->expr_type == EXPR_CONSTANT)
+ else if (sym->ts.u.cl->length->expr_type == EXPR_CONSTANT)
{
- int len = mpz_get_si (sym->ts.cl->length->value.integer);
+ int len = mpz_get_si (sym->ts.u.cl->length->value.integer);
gfc_constructor * p;
if (init->expr_type == EXPR_CONSTANT)
@@ -1293,8 +1293,8 @@ add_init_expr_to_sym (const char *name,
{
/* Build a new charlen to prevent simplification from
deleting the length before it is resolved. */
- init->ts.cl = gfc_new_charlen (gfc_current_ns);
- init->ts.cl->length = gfc_copy_expr (sym->ts.cl->length);
+ init->ts.u.cl = gfc_new_charlen (gfc_current_ns);
+ init->ts.u.cl->length = gfc_copy_expr (sym->ts.u.cl->length);
for (p = init->value.constructor; p; p = p->next)
gfc_set_constant_character_len (len, p->expr, -1);
@@ -1385,7 +1385,7 @@ build_struct (const char *name, gfc_char
/* If the current symbol is of the same derived type that we're
constructing, it must have the pointer attribute. */
if (current_ts.type == BT_DERIVED
- && current_ts.derived == gfc_current_block ()
+ && current_ts.u.derived == gfc_current_block ()
&& current_attr.pointer == 0)
{
gfc_error ("Component at %C must have the POINTER attribute");
@@ -1406,7 +1406,8 @@ build_struct (const char *name, gfc_char
return FAILURE;
c->ts = current_ts;
- c->ts.cl = cl;
+ if (c->ts.type == BT_CHARACTER)
+ c->ts.u.cl = cl;
c->attr = current_attr;
c->initializer = *init;
@@ -1419,27 +1420,27 @@ build_struct (const char *name, gfc_char
/* 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->attr.pointer && c->initializer && c->ts.cl
- && c->ts.cl->length && c->ts.cl->length->expr_type == EXPR_CONSTANT)
+ if (c->ts.type == BT_CHARACTER && !c->attr.pointer && c->initializer && c->ts.u.cl
+ && c->ts.u.cl->length && c->ts.u.cl->length->expr_type == EXPR_CONSTANT)
{
int len;
- gcc_assert (c->ts.cl && c->ts.cl->length);
- gcc_assert (c->ts.cl->length->expr_type == EXPR_CONSTANT);
- gcc_assert (c->ts.cl->length->ts.type == BT_INTEGER);
+ gcc_assert (c->ts.u.cl && c->ts.u.cl->length);
+ gcc_assert (c->ts.u.cl->length->expr_type == EXPR_CONSTANT);
+ gcc_assert (c->ts.u.cl->length->ts.type == BT_INTEGER);
- len = mpz_get_si (c->ts.cl->length->value.integer);
+ len = mpz_get_si (c->ts.u.cl->length->value.integer);
if (c->initializer->expr_type == EXPR_CONSTANT)
gfc_set_constant_character_len (len, c->initializer, -1);
- else if (mpz_cmp (c->ts.cl->length->value.integer,
- c->initializer->ts.cl->length->value.integer))
+ else if (mpz_cmp (c->ts.u.cl->length->value.integer,
+ c->initializer->ts.u.cl->length->value.integer))
{
bool has_ts;
gfc_constructor *ctor = c->initializer->value.constructor;
- has_ts = (c->initializer->ts.cl
- && c->initializer->ts.cl->length_from_typespec);
+ has_ts = (c->initializer->ts.u.cl
+ && c->initializer->ts.u.cl->length_from_typespec);
if (ctor)
{
@@ -1605,14 +1606,14 @@ variable_decl (int elem)
element. Also copy assumed lengths. */
case MATCH_NO:
if (elem > 1
- && (current_ts.cl->length == NULL
- || current_ts.cl->length->expr_type != EXPR_CONSTANT))
+ && (current_ts.u.cl->length == NULL
+ || current_ts.u.cl->length->expr_type != EXPR_CONSTANT))
{
cl = gfc_new_charlen (gfc_current_ns);
- cl->length = gfc_copy_expr (current_ts.cl->length);
+ cl->length = gfc_copy_expr (current_ts.u.cl->length);
}
else
- cl = current_ts.cl;
+ cl = current_ts.u.cl;
break;
@@ -1630,8 +1631,8 @@ variable_decl (int elem)
{
sym->ts.type = current_ts.type;
sym->ts.kind = current_ts.kind;
- sym->ts.cl = cl;
- sym->ts.derived = current_ts.derived;
+ sym->ts.u.cl = cl;
+ sym->ts.u.derived = current_ts.u.derived;
sym->ts.is_c_interop = current_ts.is_c_interop;
sym->ts.is_iso_c = current_ts.is_iso_c;
m = MATCH_YES;
@@ -1703,13 +1704,13 @@ variable_decl (int elem)
if (current_ts.type == BT_DERIVED
&& gfc_current_ns->proc_name
&& gfc_current_ns->proc_name->attr.if_source == IFSRC_IFBODY
- && current_ts.derived->ns != gfc_current_ns)
+ && current_ts.u.derived->ns != gfc_current_ns)
{
gfc_symtree *st;
- st = gfc_find_symtree (gfc_current_ns->sym_root, current_ts.derived->name);
- if (!(current_ts.derived->attr.imported
+ st = gfc_find_symtree (gfc_current_ns->sym_root, current_ts.u.derived->name);
+ if (!(current_ts.u.derived->attr.imported
&& st != NULL
- && st->n.sym == current_ts.derived)
+ && st->n.sym == current_ts.u.derived)
&& !gfc_current_ns->has_import_set)
{
gfc_error ("the type of '%s' at %C has not been declared within the "
@@ -2237,7 +2238,7 @@ done:
else
cl->length = len;
- ts->cl = cl;
+ ts->u.cl = cl;
ts->kind = kind == 0 ? gfc_default_character_kind : kind;
/* We have to know if it was a c interoperable kind so we can
@@ -2374,10 +2375,10 @@ gfc_match_type_spec (gfc_typespec *ts, i
found, add it to the typespec. */
if (gfc_matching_function)
{
- ts->derived = NULL;
+ ts->u.derived = NULL;
if (gfc_current_state () != COMP_INTERFACE
&& !gfc_find_symbol (name, NULL, 1, &sym) && sym)
- ts->derived = sym;
+ ts->u.derived = sym;
return MATCH_YES;
}
@@ -2410,7 +2411,7 @@ gfc_match_type_spec (gfc_typespec *ts, i
return MATCH_ERROR;
gfc_set_sym_referenced (sym);
- ts->derived = sym;
+ ts->u.derived = sym;
return MATCH_YES;
@@ -2601,11 +2602,11 @@ gfc_match_implicit (void)
if ((c == '\n') || (c == ','))
{
/* Check for CHARACTER with no length parameter. */
- if (ts.type == BT_CHARACTER && !ts.cl)
+ if (ts.type == BT_CHARACTER && !ts.u.cl)
{
ts.kind = gfc_default_character_kind;
- ts.cl = gfc_new_charlen (gfc_current_ns);
- ts.cl->length = gfc_int_expr (1);
+ ts.u.cl = gfc_new_charlen (gfc_current_ns);
+ ts.u.cl->length = gfc_int_expr (1);
}
/* Record the Successful match. */
@@ -3317,8 +3318,8 @@ set_com_block_bind_c (gfc_common_head *c
gfc_try
verify_c_interop (gfc_typespec *ts)
{
- if (ts->type == BT_DERIVED && ts->derived != NULL)
- return (ts->derived->ts.is_c_interop ? SUCCESS : FAILURE);
+ if (ts->type == BT_DERIVED && ts->u.derived != NULL)
+ return (ts->u.derived->ts.is_c_interop ? SUCCESS : FAILURE);
else if (ts->is_c_interop != 1)
return FAILURE;
@@ -3460,9 +3461,9 @@ verify_bind_c_sym (gfc_symbol *tmp_sym,
/* BIND(C) functions can not return a character string. */
if (bind_c_function && tmp_sym->ts.type == BT_CHARACTER)
- if (tmp_sym->ts.cl == NULL || tmp_sym->ts.cl->length == NULL
- || tmp_sym->ts.cl->length->expr_type != EXPR_CONSTANT
- || mpz_cmp_si (tmp_sym->ts.cl->length->value.integer, 1) != 0)
+ if (tmp_sym->ts.u.cl == NULL || tmp_sym->ts.u.cl->length == NULL
+ || tmp_sym->ts.u.cl->length->expr_type != EXPR_CONSTANT
+ || mpz_cmp_si (tmp_sym->ts.u.cl->length->value.integer, 1) != 0)
gfc_error ("Return type of BIND(C) function '%s' at %L cannot "
"be a character string", tmp_sym->name,
&(tmp_sym->declared_at));
@@ -3666,7 +3667,7 @@ gfc_match_data_decl (void)
if (current_ts.type == BT_DERIVED && gfc_current_state () != COMP_DERIVED)
{
- sym = gfc_use_derived (current_ts.derived);
+ sym = gfc_use_derived (current_ts.u.derived);
if (sym == NULL)
{
@@ -3674,7 +3675,7 @@ gfc_match_data_decl (void)
goto cleanup;
}
- current_ts.derived = sym;
+ current_ts.u.derived = sym;
}
m = match_attr_spec ();
@@ -3684,21 +3685,21 @@ gfc_match_data_decl (void)
goto cleanup;
}
- if (current_ts.type == BT_DERIVED && current_ts.derived->components == NULL
- && !current_ts.derived->attr.zero_comp)
+ if (current_ts.type == BT_DERIVED && current_ts.u.derived->components == NULL
+ && !current_ts.u.derived->attr.zero_comp)
{
if (current_attr.pointer && gfc_current_state () == COMP_DERIVED)
goto ok;
- gfc_find_symbol (current_ts.derived->name,
- current_ts.derived->ns->parent, 1, &sym);
+ gfc_find_symbol (current_ts.u.derived->name,
+ current_ts.u.derived->ns->parent, 1, &sym);
/* Any symbol that we find had better be a type definition
which has its components defined. */
if (sym != NULL && sym->attr.flavor == FL_DERIVED
- && (current_ts.derived->components != NULL
- || current_ts.derived->attr.zero_comp))
+ && (current_ts.u.derived->components != NULL
+ || current_ts.u.derived->attr.zero_comp))
goto ok;
/* Now we have an error, which we signal, and then fix up
@@ -6189,30 +6190,30 @@ do_parm (void)
}
if (sym->ts.type == BT_CHARACTER
- && sym->ts.cl != NULL
- && sym->ts.cl->length != NULL
- && sym->ts.cl->length->expr_type == EXPR_CONSTANT
+ && sym->ts.u.cl != NULL
+ && sym->ts.u.cl->length != NULL
+ && sym->ts.u.cl->length->expr_type == EXPR_CONSTANT
&& init->expr_type == EXPR_CONSTANT
&& init->ts.type == BT_CHARACTER)
gfc_set_constant_character_len (
- mpz_get_si (sym->ts.cl->length->value.integer), init, -1);
- else if (sym->ts.type == BT_CHARACTER && sym->ts.cl != NULL
- && sym->ts.cl->length == NULL)
+ mpz_get_si (sym->ts.u.cl->length->value.integer), init, -1);
+ else if (sym->ts.type == BT_CHARACTER && sym->ts.u.cl != NULL
+ && sym->ts.u.cl->length == NULL)
{
int clen;
if (init->expr_type == EXPR_CONSTANT)
{
clen = init->value.character.length;
- sym->ts.cl->length = gfc_int_expr (clen);
+ sym->ts.u.cl->length = gfc_int_expr (clen);
}
else if (init->expr_type == EXPR_ARRAY)
{
gfc_expr *p = init->value.constructor->expr;
clen = p->value.character.length;
- sym->ts.cl->length = gfc_int_expr (clen);
+ sym->ts.u.cl->length = gfc_int_expr (clen);
}
- else if (init->ts.cl && init->ts.cl->length)
- sym->ts.cl->length = gfc_copy_expr (sym->value->ts.cl->length);
+ else if (init->ts.u.cl && init->ts.u.cl->length)
+ sym->ts.u.cl->length = gfc_copy_expr (sym->value->ts.u.cl->length);
}
sym->value = init;
@@ -6749,7 +6750,7 @@ gfc_match_derived_decl (void)
gfc_set_sym_referenced (extended);
p->ts.type = BT_DERIVED;
- p->ts.derived = extended;
+ p->ts.u.derived = extended;
p->initializer = gfc_default_initializer (&p->ts);
/* Provide the links between the extended type and its extension. */
Index: gcc/fortran/dump-parse-tree.c
===================================================================
--- gcc/fortran/dump-parse-tree.c (revision 150364)
+++ gcc/fortran/dump-parse-tree.c (working copy)
@@ -85,11 +85,11 @@ show_typespec (gfc_typespec *ts)
switch (ts->type)
{
case BT_DERIVED:
- fprintf (dumpfile, "%s", ts->derived->name);
+ fprintf (dumpfile, "%s", ts->u.derived->name);
break;
case BT_CHARACTER:
- show_expr (ts->cl->length);
+ show_expr (ts->u.cl->length);
break;
default:
@@ -354,7 +354,7 @@ show_expr (gfc_expr *p)
break;
case EXPR_STRUCTURE:
- fprintf (dumpfile, "%s(", p->ts.derived->name);
+ fprintf (dumpfile, "%s(", p->ts.u.derived->name);
show_constructor (p->value.constructor);
fputc (')', dumpfile);
break;
Index: gcc/fortran/trans-common.c
===================================================================
--- gcc/fortran/trans-common.c (revision 150364)
+++ gcc/fortran/trans-common.c (working copy)
@@ -132,7 +132,7 @@ get_segment_info (gfc_symbol * sym, HOST
/* Make sure we've got the character length. */
if (sym->ts.type == BT_CHARACTER)
- gfc_conv_const_charlen (sym->ts.cl);
+ gfc_conv_const_charlen (sym->ts.u.cl);
/* Create the segment_info and fill it in. */
s = (segment_info *) gfc_getmem (sizeof (segment_info));
@@ -830,7 +830,7 @@ calculate_offset (gfc_expr *e)
case AR_ELEMENT:
n = element_number (&reference->u.ar);
if (element_type->type == BT_CHARACTER)
- gfc_conv_const_charlen (element_type->cl);
+ gfc_conv_const_charlen (element_type->u.cl);
element_size =
int_size_in_bytes (gfc_typenode_for_spec (element_type));
offset += n * element_size;
Index: gcc/fortran/array.c
===================================================================
--- gcc/fortran/array.c (revision 150364)
+++ gcc/fortran/array.c (working copy)
@@ -968,8 +968,8 @@ done:
else
expr->ts.type = BT_UNKNOWN;
- if (expr->ts.cl)
- expr->ts.cl->length_from_typespec = seen_ts;
+ if (expr->ts.u.cl)
+ expr->ts.u.cl->length_from_typespec = seen_ts;
expr->where = where;
expr->rank = 1;
@@ -1588,25 +1588,25 @@ gfc_resolve_character_array_constructor
gcc_assert (expr->expr_type == EXPR_ARRAY);
gcc_assert (expr->ts.type == BT_CHARACTER);
- if (expr->ts.cl == NULL)
+ if (expr->ts.u.cl == NULL)
{
for (p = expr->value.constructor; p; p = p->next)
- if (p->expr->ts.cl != NULL)
+ if (p->expr->ts.u.cl != NULL)
{
/* Ensure that if there is a char_len around that it is
used; otherwise the middle-end confuses them! */
- expr->ts.cl = p->expr->ts.cl;
+ expr->ts.u.cl = p->expr->ts.u.cl;
goto got_charlen;
}
- expr->ts.cl = gfc_new_charlen (gfc_current_ns);
+ expr->ts.u.cl = gfc_new_charlen (gfc_current_ns);
}
got_charlen:
found_length = -1;
- if (expr->ts.cl->length == NULL)
+ if (expr->ts.u.cl->length == NULL)
{
/* Check that all constant string elements have the same length until
we reach the end or find a variable-length one. */
@@ -1630,11 +1630,11 @@ got_charlen:
- mpz_get_ui (ref->u.ss.start->value.integer) + 1;
current_length = (int) j;
}
- else if (p->expr->ts.cl && p->expr->ts.cl->length
- && p->expr->ts.cl->length->expr_type == EXPR_CONSTANT)
+ else if (p->expr->ts.u.cl && p->expr->ts.u.cl->length
+ && p->expr->ts.u.cl->length->expr_type == EXPR_CONSTANT)
{
long j;
- j = mpz_get_si (p->expr->ts.cl->length->value.integer);
+ j = mpz_get_si (p->expr->ts.u.cl->length->value.integer);
current_length = (int) j;
}
else
@@ -1658,18 +1658,18 @@ got_charlen:
gcc_assert (found_length != -1);
/* Update the character length of the array constructor. */
- expr->ts.cl->length = gfc_int_expr (found_length);
+ expr->ts.u.cl->length = gfc_int_expr (found_length);
}
else
{
/* We've got a character length specified. It should be an integer,
otherwise an error is signalled elsewhere. */
- gcc_assert (expr->ts.cl->length);
+ gcc_assert (expr->ts.u.cl->length);
/* If we've got a constant character length, pad according to this.
gfc_extract_int does check for BT_INTEGER and EXPR_CONSTANT and sets
max_length only if they pass. */
- gfc_extract_int (expr->ts.cl->length, &found_length);
+ gfc_extract_int (expr->ts.u.cl->length, &found_length);
/* Now pad/truncate the elements accordingly to the specified character
length. This is ok inside this conditional, as in the case above
@@ -1683,16 +1683,16 @@ got_charlen:
int current_length = -1;
bool has_ts;
- if (p->expr->ts.cl && p->expr->ts.cl->length)
+ if (p->expr->ts.u.cl && p->expr->ts.u.cl->length)
{
- cl = p->expr->ts.cl->length;
+ cl = p->expr->ts.u.cl->length;
gfc_extract_int (cl, ¤t_length);
}
/* If gfc_extract_int above set current_length, we implicitly
know the type is BT_INTEGER and it's EXPR_CONSTANT. */
- has_ts = (expr->ts.cl && expr->ts.cl->length_from_typespec);
+ has_ts = (expr->ts.u.cl && expr->ts.u.cl->length_from_typespec);
if (! cl
|| (current_length != -1 && current_length < found_length))
Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h (revision 150364)
+++ gcc/fortran/gfortran.h (working copy)
@@ -832,13 +832,19 @@ gfc_charlen;
#define gfc_get_charlen() XCNEW (gfc_charlen)
-/* Type specification structure. FIXME: derived and cl could be union??? */
+/* Type specification structure. */
typedef struct
{
bt type;
int kind;
- struct gfc_symbol *derived;
- gfc_charlen *cl; /* For character types only. */
+
+ union
+ {
+ struct gfc_symbol *derived; /* For derived types only. */
+ gfc_charlen *cl; /* For character types only. */
+ }
+ u;
+
struct gfc_symbol *interface; /* For PROCEDURE declarations. */
int is_c_interop;
int is_iso_c;
Index: gcc/fortran/data.c
===================================================================
--- gcc/fortran/data.c (revision 150364)
+++ gcc/fortran/data.c (working copy)
@@ -154,7 +154,7 @@ create_character_intializer (gfc_expr *i
int len, start, end;
gfc_char_t *dest;
- gfc_extract_int (ts->cl->length, &len);
+ gfc_extract_int (ts->u.cl->length, &len);
if (init == NULL)
{
@@ -379,7 +379,7 @@ gfc_assign_data_value (gfc_expr *lvalue,
/* Setup the expression to hold the constructor. */
expr->expr_type = EXPR_STRUCTURE;
expr->ts.type = BT_DERIVED;
- expr->ts.derived = ref->u.c.sym;
+ expr->ts.u.derived = ref->u.c.sym;
}
else
gcc_assert (expr->expr_type == EXPR_STRUCTURE);
@@ -417,7 +417,7 @@ gfc_assign_data_value (gfc_expr *lvalue,
if (ref || last_ts->type == BT_CHARACTER)
{
- if (lvalue->ts.cl->length == NULL && !(ref && ref->u.ss.length != NULL))
+ if (lvalue->ts.u.cl->length == NULL && !(ref && ref->u.ss.length != NULL))
return FAILURE;
expr = create_character_intializer (init, last_ts, ref, rvalue);
}
@@ -569,7 +569,7 @@ gfc_assign_data_value_range (gfc_expr *l
/* Setup the expression to hold the constructor. */
expr->expr_type = EXPR_STRUCTURE;
expr->ts.type = BT_DERIVED;
- expr->ts.derived = ref->u.c.sym;
+ expr->ts.u.derived = ref->u.c.sym;
}
else
gcc_assert (expr->expr_type == EXPR_STRUCTURE);
@@ -716,7 +716,7 @@ formalize_structure_cons (gfc_expr *expr
return;
head = tail = NULL;
- for (order = expr->ts.derived->components; order; order = order->next)
+ for (order = expr->ts.u.derived->components; order; order = order->next)
{
/* Find the next component. */
last = NULL;
Index: gcc/fortran/trans-const.c
===================================================================
--- gcc/fortran/trans-const.c (revision 150364)
+++ gcc/fortran/trans-const.c (working copy)
@@ -342,8 +342,8 @@ gfc_conv_constant (gfc_se * se, gfc_expr
/* We may be receiving an expression for C_NULL_PTR or C_NULL_FUNPTR. If
so, they expr_type will not yet be an EXPR_CONSTANT. We need to make
it so here. */
- if (expr->ts.type == BT_DERIVED && expr->ts.derived
- && expr->ts.derived->attr.is_iso_c)
+ if (expr->ts.type == BT_DERIVED && expr->ts.u.derived
+ && expr->ts.u.derived->attr.is_iso_c)
{
if (expr->symtree->n.sym->intmod_sym_id == ISOCBINDING_NULL_PTR
|| expr->symtree->n.sym->intmod_sym_id == ISOCBINDING_NULL_FUNPTR)
Index: gcc/fortran/trans-stmt.c
===================================================================
--- gcc/fortran/trans-stmt.c (revision 150364)
+++ gcc/fortran/trans-stmt.c (working copy)
@@ -1830,7 +1830,7 @@ check_forall_dependencies (gfc_code *c,
pointer components. We therefore leave these to their
own devices. */
if (lsym->ts.type == BT_DERIVED
- && lsym->ts.derived->attr.pointer_comp)
+ && lsym->ts.u.derived->attr.pointer_comp)
return need_temp;
new_symtree = NULL;
@@ -2539,17 +2539,17 @@ gfc_trans_assign_need_temp (gfc_expr * e
&lss, &rss);
/* The type of LHS. Used in function allocate_temp_for_forall_nest */
- if (expr1->ts.type == BT_CHARACTER && expr1->ts.cl->length)
+ if (expr1->ts.type == BT_CHARACTER && expr1->ts.u.cl->length)
{
- if (!expr1->ts.cl->backend_decl)
+ if (!expr1->ts.u.cl->backend_decl)
{
gfc_se tse;
gfc_init_se (&tse, NULL);
- gfc_conv_expr (&tse, expr1->ts.cl->length);
- expr1->ts.cl->backend_decl = tse.expr;
+ gfc_conv_expr (&tse, expr1->ts.u.cl->length);
+ expr1->ts.u.cl->backend_decl = tse.expr;
}
type = gfc_get_character_type_len (gfc_default_character_kind,
- expr1->ts.cl->backend_decl);
+ expr1->ts.u.cl->backend_decl);
}
else
type = gfc_typenode_for_spec (&expr1->ts);
@@ -4024,10 +4024,10 @@ gfc_trans_allocate (gfc_code * code)
gfc_add_expr_to_block (&se.pre, tmp);
}
- if (expr->ts.type == BT_DERIVED && expr->ts.derived->attr.alloc_comp)
+ if (expr->ts.type == BT_DERIVED && expr->ts.u.derived->attr.alloc_comp)
{
tmp = build_fold_indirect_ref_loc (input_location, se.expr);
- tmp = gfc_nullify_alloc_comp (expr->ts.derived, tmp, 0);
+ tmp = gfc_nullify_alloc_comp (expr->ts.u.derived, tmp, 0);
gfc_add_expr_to_block (&se.pre, tmp);
}
@@ -4130,7 +4130,7 @@ gfc_trans_deallocate (gfc_code *code)
se.descriptor_only = 1;
gfc_conv_expr (&se, expr);
- if (expr->ts.type == BT_DERIVED && expr->ts.derived->attr.alloc_comp)
+ if (expr->ts.type == BT_DERIVED && expr->ts.u.derived->attr.alloc_comp)
{
gfc_ref *ref;
gfc_ref *last = NULL;
@@ -4143,7 +4143,7 @@ gfc_trans_deallocate (gfc_code *code)
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,
+ tmp = gfc_deallocate_alloc_comp (expr->ts.u.derived, se.expr,
expr->rank);
gfc_add_expr_to_block (&se.pre, tmp);
}
Index: gcc/fortran/expr.c
===================================================================
--- gcc/fortran/expr.c (revision 150364)
+++ gcc/fortran/expr.c (working copy)
@@ -1504,14 +1504,14 @@ simplify_const_ref (gfc_expr *p)
else
string_len = 0;
- if (!p->ts.cl)
+ if (!p->ts.u.cl)
{
- p->ts.cl = gfc_get_charlen ();
- p->ts.cl->next = NULL;
- p->ts.cl->length = NULL;
+ p->ts.u.cl = gfc_get_charlen ();
+ p->ts.u.cl->next = NULL;
+ p->ts.u.cl->length = NULL;
}
- gfc_free_expr (p->ts.cl->length);
- p->ts.cl->length = gfc_int_expr (string_len);
+ gfc_free_expr (p->ts.u.cl->length);
+ p->ts.u.cl->length = gfc_int_expr (string_len);
}
}
gfc_free_ref_list (p->ref);
@@ -1681,8 +1681,8 @@ gfc_simplify_expr (gfc_expr *p, int type
gfc_free (p->value.character.string);
p->value.character.string = s;
p->value.character.length = end - start;
- p->ts.cl = gfc_new_charlen (gfc_current_ns);
- p->ts.cl->length = gfc_int_expr (p->value.character.length);
+ p->ts.u.cl = gfc_new_charlen (gfc_current_ns);
+ p->ts.u.cl->length = gfc_int_expr (p->value.character.length);
gfc_free_ref_list (p->ref);
p->ref = NULL;
p->expr_type = EXPR_CONSTANT;
@@ -2102,7 +2102,7 @@ check_inquiry (gfc_expr *e, int not_rest
with LEN, as required by the standard. */
if (i == 5 && not_restricted
&& ap->expr->symtree->n.sym->ts.type == BT_CHARACTER
- && ap->expr->symtree->n.sym->ts.cl->length == NULL)
+ && ap->expr->symtree->n.sym->ts.u.cl->length == NULL)
{
gfc_error ("Assumed character length variable '%s' in constant "
"expression at %L", e->symtree->n.sym->name, &e->where);
@@ -3338,7 +3338,7 @@ gfc_default_initializer (gfc_typespec *t
gfc_component *c;
/* See if we have a default initializer. */
- for (c = ts->derived->components; c; c = c->next)
+ for (c = ts->u.derived->components; c; c = c->next)
if (c->initializer || c->attr.allocatable)
break;
@@ -3349,10 +3349,10 @@ gfc_default_initializer (gfc_typespec *t
init = gfc_get_expr ();
init->expr_type = EXPR_STRUCTURE;
init->ts = *ts;
- init->where = ts->derived->declared_at;
+ init->where = ts->u.derived->declared_at;
tail = NULL;
- for (c = ts->derived->components; c; c = c->next)
+ for (c = ts->u.derived->components; c; c = c->next)
{
if (tail == NULL)
init->value.constructor = tail = gfc_get_constructor ();
@@ -3422,10 +3422,10 @@ gfc_traverse_expr (gfc_expr *expr, gfc_s
return true;
if (expr->ts.type == BT_CHARACTER
- && expr->ts.cl
- && expr->ts.cl->length
- && expr->ts.cl->length->expr_type != EXPR_CONSTANT
- && gfc_traverse_expr (expr->ts.cl->length, sym, func, f))
+ && expr->ts.u.cl
+ && expr->ts.u.cl->length
+ && expr->ts.u.cl->length->expr_type != EXPR_CONSTANT
+ && gfc_traverse_expr (expr->ts.u.cl->length, sym, func, f))
return true;
switch (expr->expr_type)
@@ -3503,11 +3503,11 @@ gfc_traverse_expr (gfc_expr *expr, gfc_s
case REF_COMPONENT:
if (ref->u.c.component->ts.type == BT_CHARACTER
- && ref->u.c.component->ts.cl
- && ref->u.c.component->ts.cl->length
- && ref->u.c.component->ts.cl->length->expr_type
+ && ref->u.c.component->ts.u.cl
+ && ref->u.c.component->ts.u.cl->length
+ && ref->u.c.component->ts.u.cl->length->expr_type
!= EXPR_CONSTANT
- && gfc_traverse_expr (ref->u.c.component->ts.cl->length,
+ && gfc_traverse_expr (ref->u.c.component->ts.u.cl->length,
sym, func, f))
return true;
Index: gcc/fortran/module.c
===================================================================
--- gcc/fortran/module.c (revision 150364)
+++ gcc/fortran/module.c (working copy)
@@ -2034,7 +2034,7 @@ mio_typespec (gfc_typespec *ts)
if (ts->type != BT_DERIVED)
mio_integer (&ts->kind);
else
- mio_symbol_ref (&ts->derived);
+ mio_symbol_ref (&ts->u.derived);
/* Add info for C interop and is_iso_c. */
mio_integer (&ts->is_c_interop);
@@ -2050,12 +2050,12 @@ mio_typespec (gfc_typespec *ts)
if (ts->type != BT_CHARACTER)
{
- /* ts->cl is only valid for BT_CHARACTER. */
+ /* ts->u.cl is only valid for BT_CHARACTER. */
mio_lparen ();
mio_rparen ();
}
else
- mio_charlen (&ts->cl);
+ mio_charlen (&ts->u.cl);
mio_rparen ();
}
Index: gcc/fortran/trans-types.c
===================================================================
--- gcc/fortran/trans-types.c (revision 150364)
+++ gcc/fortran/trans-types.c (working copy)
@@ -1000,8 +1000,8 @@ gfc_typenode_for_spec (gfc_typespec * sp
C_FUNPTR to simple variables that get translated to (void *). */
if (spec->f90_type == BT_VOID)
{
- if (spec->derived
- && spec->derived->intmod_sym_id == ISOCBINDING_PTR)
+ if (spec->u.derived
+ && spec->u.derived->intmod_sym_id == ISOCBINDING_PTR)
basetype = ptr_type_node;
else
basetype = pfunc_type_node;
@@ -1023,21 +1023,21 @@ gfc_typenode_for_spec (gfc_typespec * sp
break;
case BT_CHARACTER:
- basetype = gfc_get_character_type (spec->kind, spec->cl);
+ basetype = gfc_get_character_type (spec->kind, spec->u.cl);
break;
case BT_DERIVED:
- basetype = gfc_get_derived_type (spec->derived);
+ basetype = gfc_get_derived_type (spec->u.derived);
/* If we're dealing with either C_PTR or C_FUNPTR, we modified the
type and kind to fit a (void *) and the basetype returned was a
ptr_type_node. We need to pass up this new information to the
symbol that was declared of type C_PTR or C_FUNPTR. */
- if (spec->derived->attr.is_iso_c)
+ if (spec->u.derived->attr.is_iso_c)
{
- spec->type = spec->derived->ts.type;
- spec->kind = spec->derived->ts.kind;
- spec->f90_type = spec->derived->ts.f90_type;
+ spec->type = spec->u.derived->ts.type;
+ spec->kind = spec->u.derived->ts.kind;
+ spec->f90_type = spec->u.derived->ts.f90_type;
}
break;
case BT_VOID:
@@ -1046,8 +1046,8 @@ gfc_typenode_for_spec (gfc_typespec * sp
basetype = ptr_type_node;
if (spec->f90_type == BT_VOID)
{
- if (spec->derived
- && spec->derived->intmod_sym_id == ISOCBINDING_PTR)
+ if (spec->u.derived
+ && spec->u.derived->intmod_sym_id == ISOCBINDING_PTR)
basetype = ptr_type_node;
else
basetype = pfunc_type_node;
@@ -1765,7 +1765,7 @@ gfc_sym_type (gfc_symbol * sym)
base type. */
if (sym->ts.type != BT_CHARACTER
|| !(sym->attr.dummy || sym->attr.function)
- || sym->ts.cl->backend_decl)
+ || sym->ts.u.cl->backend_decl)
{
type = gfc_get_nodesc_array_type (type, sym->as,
byref ? PACKED_FULL
@@ -1879,10 +1879,10 @@ copy_dt_decls_ifequal (gfc_symbol *from,
to_cm->backend_decl = from_cm->backend_decl;
if ((!from_cm->attr.pointer || from_gsym)
&& from_cm->ts.type == BT_DERIVED)
- gfc_get_derived_type (to_cm->ts.derived);
+ gfc_get_derived_type (to_cm->ts.u.derived);
else if (from_cm->ts.type == BT_CHARACTER)
- to_cm->ts.cl->backend_decl = from_cm->ts.cl->backend_decl;
+ to_cm->ts.u.cl->backend_decl = from_cm->ts.u.cl->backend_decl;
}
return 1;
@@ -1898,7 +1898,7 @@ gfc_get_ppc_type (gfc_component* c)
if (c->attr.function && !c->attr.dimension)
{
if (c->ts.type == BT_DERIVED)
- t = c->ts.derived->backend_decl;
+ t = c->ts.u.derived->backend_decl;
else
t = gfc_typenode_for_spec (&c->ts);
}
@@ -2038,17 +2038,17 @@ gfc_get_derived_type (gfc_symbol * deriv
continue;
if ((!c->attr.pointer && !c->attr.proc_pointer)
- || c->ts.derived->backend_decl == NULL)
- c->ts.derived->backend_decl = gfc_get_derived_type (c->ts.derived);
+ || c->ts.u.derived->backend_decl == NULL)
+ c->ts.u.derived->backend_decl = gfc_get_derived_type (c->ts.u.derived);
- if (c->ts.derived && c->ts.derived->attr.is_iso_c)
+ if (c->ts.u.derived && c->ts.u.derived->attr.is_iso_c)
{
/* Need to copy the modified ts from the derived type. The
typespec was modified because C_PTR/C_FUNPTR are translated
into (void *) from derived types. */
- c->ts.type = c->ts.derived->ts.type;
- c->ts.kind = c->ts.derived->ts.kind;
- c->ts.f90_type = c->ts.derived->ts.f90_type;
+ c->ts.type = c->ts.u.derived->ts.type;
+ c->ts.kind = c->ts.u.derived->ts.kind;
+ c->ts.f90_type = c->ts.u.derived->ts.f90_type;
if (c->initializer)
{
c->initializer->ts.type = c->ts.type;
@@ -2070,14 +2070,14 @@ gfc_get_derived_type (gfc_symbol * deriv
if (c->attr.proc_pointer)
field_type = gfc_get_ppc_type (c);
else if (c->ts.type == BT_DERIVED)
- field_type = c->ts.derived->backend_decl;
+ field_type = c->ts.u.derived->backend_decl;
else
{
if (c->ts.type == BT_CHARACTER)
{
/* Evaluate the string length. */
- gfc_conv_const_charlen (c->ts.cl);
- gcc_assert (c->ts.cl->backend_decl);
+ gfc_conv_const_charlen (c->ts.u.cl);
+ gcc_assert (c->ts.u.cl->backend_decl);
}
field_type = gfc_typenode_for_spec (&c->ts);
@@ -2260,7 +2260,7 @@ gfc_get_function_type (gfc_symbol * sym)
arg = sym;
if (arg->ts.type == BT_CHARACTER)
- gfc_conv_const_charlen (arg->ts.cl);
+ gfc_conv_const_charlen (arg->ts.u.cl);
/* Some functions we use an extra parameter for the return value. */
if (gfc_return_by_reference (sym))
@@ -2285,7 +2285,7 @@ gfc_get_function_type (gfc_symbol * sym)
/* Evaluate constant character lengths here so that they can be
included in the type. */
if (arg->ts.type == BT_CHARACTER)
- gfc_conv_const_charlen (arg->ts.cl);
+ gfc_conv_const_charlen (arg->ts.u.cl);
if (arg->attr.flavor == FL_PROCEDURE)
{
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c (revision 150364)
+++ gcc/fortran/resolve.c (working copy)
@@ -103,16 +103,16 @@ is_sym_host_assoc (gfc_symbol *sym, gfc_
static gfc_try
resolve_typespec_used (gfc_typespec* ts, locus* where, const char* name)
{
- if (ts->type == BT_DERIVED && ts->derived->attr.abstract)
+ if (ts->type == BT_DERIVED && ts->u.derived->attr.abstract)
{
if (where)
{
if (name)
gfc_error ("'%s' at %L is of the ABSTRACT type '%s'",
- name, where, ts->derived->name);
+ name, where, ts->u.derived->name);
else
gfc_error ("ABSTRACT type '%s' used at %L",
- ts->derived->name, where);
+ ts->u.derived->name, where);
}
return FAILURE;
@@ -294,7 +294,7 @@ resolve_formal_arglist (gfc_symbol *proc
if (sym->ts.type == BT_CHARACTER)
{
- gfc_charlen *cl = sym->ts.cl;
+ gfc_charlen *cl = sym->ts.u.cl;
if (!cl || !cl->length || cl->length->expr_type != EXPR_CONSTANT)
{
gfc_error ("Character-valued argument '%s' of statement "
@@ -372,7 +372,7 @@ resolve_contained_fntype (gfc_symbol *sy
if (sym->result->ts.type == BT_CHARACTER)
{
- gfc_charlen *cl = sym->result->ts.cl;
+ gfc_charlen *cl = sym->result->ts.u.cl;
if (!cl || !cl->length)
gfc_error ("Character-valued internal function '%s' at %L must "
"not be assumed length", sym->name, &sym->declared_at);
@@ -552,16 +552,16 @@ resolve_entries (gfc_namespace *ns)
the same string length, i.e. both len=*, or both len=4.
Having both len=<variable> is also possible, but difficult to
check at compile time. */
- else if (ts->type == BT_CHARACTER && ts->cl && fts->cl
- && (((ts->cl->length && !fts->cl->length)
- ||(!ts->cl->length && fts->cl->length))
- || (ts->cl->length
- && ts->cl->length->expr_type
- != fts->cl->length->expr_type)
- || (ts->cl->length
- && ts->cl->length->expr_type == EXPR_CONSTANT
- && mpz_cmp (ts->cl->length->value.integer,
- fts->cl->length->value.integer) != 0)))
+ else if (ts->type == BT_CHARACTER && ts->u.cl && fts->u.cl
+ && (((ts->u.cl->length && !fts->u.cl->length)
+ ||(!ts->u.cl->length && fts->u.cl->length))
+ || (ts->u.cl->length
+ && ts->u.cl->length->expr_type
+ != fts->u.cl->length->expr_type)
+ || (ts->u.cl->length
+ && ts->u.cl->length->expr_type == EXPR_CONSTANT
+ && mpz_cmp (ts->u.cl->length->value.integer,
+ fts->u.cl->length->value.integer) != 0)))
gfc_notify_std (GFC_STD_GNU, "Extension: Function %s at %L with "
"entries returning variables of different "
"string lengths", ns->entries->sym->name,
@@ -688,7 +688,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->attr.pointer && has_default_initializer (c->ts.derived))))
+ && (!c->attr.pointer && has_default_initializer (c->ts.u.derived))))
break;
return c != NULL;
@@ -718,16 +718,16 @@ resolve_common_vars (gfc_symbol *sym, bo
if (csym->ts.type != BT_DERIVED)
continue;
- if (!(csym->ts.derived->attr.sequence
- || csym->ts.derived->attr.is_bind_c))
+ if (!(csym->ts.u.derived->attr.sequence
+ || csym->ts.u.derived->attr.is_bind_c))
gfc_error_now ("Derived type variable '%s' in COMMON at %L "
"has neither the SEQUENCE nor the BIND(C) "
"attribute", csym->name, &csym->declared_at);
- if (csym->ts.derived->attr.alloc_comp)
+ if (csym->ts.u.derived->attr.alloc_comp)
gfc_error_now ("Derived type variable '%s' in COMMON at %L "
"has an ultimate component that is "
"allocatable", csym->name, &csym->declared_at);
- if (has_default_initializer (csym->ts.derived))
+ if (has_default_initializer (csym->ts.u.derived))
gfc_error_now ("Derived type variable '%s' in COMMON at %L "
"may not have default initializer", csym->name,
&csym->declared_at);
@@ -826,15 +826,15 @@ resolve_structure_cons (gfc_expr *expr)
if (expr->ref)
comp = expr->ref->u.c.sym->components;
else
- comp = expr->ts.derived->components;
+ comp = expr->ts.u.derived->components;
/* See if the user is trying to invoke a structure constructor for one of
the iso_c_binding derived types. */
- if (expr->ts.derived && expr->ts.derived->ts.is_iso_c && cons
+ if (expr->ts.u.derived && expr->ts.u.derived->ts.is_iso_c && cons
&& cons->expr != NULL)
{
gfc_error ("Components of structure constructor '%s' at %L are PRIVATE",
- expr->ts.derived->name, &(expr->where));
+ expr->ts.u.derived->name, &(expr->where));
return FAILURE;
}
@@ -2151,9 +2151,9 @@ is_scalar_expr_ptr (gfc_expr *expr)
its length is one. */
if (expr->ts.type == BT_CHARACTER)
{
- if (expr->ts.cl == NULL
- || expr->ts.cl->length == NULL
- || mpz_cmp_si (expr->ts.cl->length->value.integer, 1)
+ if (expr->ts.u.cl == NULL
+ || expr->ts.u.cl->length == NULL
+ || mpz_cmp_si (expr->ts.u.cl->length->value.integer, 1)
!= 0)
retval = FAILURE;
}
@@ -2184,9 +2184,9 @@ is_scalar_expr_ptr (gfc_expr *expr)
else if (expr->ts.type == BT_CHARACTER && expr->rank == 0)
{
/* Character string. Make sure it's of length 1. */
- if (expr->ts.cl == NULL
- || expr->ts.cl->length == NULL
- || mpz_cmp_si (expr->ts.cl->length->value.integer, 1) != 0)
+ if (expr->ts.u.cl == NULL
+ || expr->ts.u.cl->length == NULL
+ || mpz_cmp_si (expr->ts.u.cl->length->value.integer, 1) != 0)
retval = FAILURE;
}
else if (expr->rank != 0)
@@ -2336,12 +2336,12 @@ gfc_iso_c_func_interface (gfc_symbol *sy
any type should be ok if the variable is of a C
interoperable type. */
if (arg_ts->type == BT_CHARACTER)
- if (arg_ts->cl != NULL
- && (arg_ts->cl->length == NULL
- || arg_ts->cl->length->expr_type
+ if (arg_ts->u.cl != NULL
+ && (arg_ts->u.cl->length == NULL
+ || arg_ts->u.cl->length->expr_type
!= EXPR_CONSTANT
|| mpz_cmp_si
- (arg_ts->cl->length->value.integer, 1)
+ (arg_ts->u.cl->length->value.integer, 1)
!= 0)
&& is_scalar_expr_ptr (args->expr) != SUCCESS)
{
@@ -2496,8 +2496,8 @@ resolve_function (gfc_expr *expr)
&expr->value.function.actual, 0);
if (sym && sym->ts.type == BT_CHARACTER
- && sym->ts.cl
- && sym->ts.cl->length == NULL
+ && sym->ts.u.cl
+ && sym->ts.u.cl->length == NULL
&& !sym->attr.dummy
&& expr->value.function.esym == NULL
&& !sym->attr.contained)
@@ -2647,7 +2647,7 @@ resolve_function (gfc_expr *expr)
if (expr->ts.type == BT_CHARACTER && expr->value.function.esym
&& expr->value.function.esym->attr.use_assoc)
{
- gfc_expr_set_symbols_referenced (expr->ts.cl->length);
+ gfc_expr_set_symbols_referenced (expr->ts.u.cl->length);
}
if (t == SUCCESS
@@ -3356,7 +3356,7 @@ resolve_operator (gfc_expr *e)
case INTRINSIC_PARENTHESES:
e->ts = op1->ts;
if (e->ts.type == BT_CHARACTER)
- e->ts.cl = op1->ts.cl;
+ e->ts.u.cl = op1->ts.u.cl;
break;
default:
@@ -3884,7 +3884,7 @@ find_array_spec (gfc_expr *e)
case REF_COMPONENT:
if (derived == NULL)
- derived = e->symtree->n.sym->ts.derived;
+ derived = e->symtree->n.sym->ts.u.derived;
c = derived->components;
@@ -3893,7 +3893,7 @@ find_array_spec (gfc_expr *e)
{
/* Track the sequence of component references. */
if (c->ts.type == BT_DERIVED)
- derived = c->ts.derived;
+ derived = c->ts.u.derived;
break;
}
@@ -4076,10 +4076,10 @@ gfc_resolve_substring_charlen (gfc_expr
gcc_assert (char_ref->next == NULL);
- if (e->ts.cl)
+ if (e->ts.u.cl)
{
- if (e->ts.cl->length)
- gfc_free_expr (e->ts.cl->length);
+ if (e->ts.u.cl->length)
+ gfc_free_expr (e->ts.u.cl->length);
else if (e->expr_type == EXPR_VARIABLE
&& e->symtree->n.sym->attr.dummy)
return;
@@ -4088,8 +4088,8 @@ gfc_resolve_substring_charlen (gfc_expr
e->ts.type = BT_CHARACTER;
e->ts.kind = gfc_default_character_kind;
- if (!e->ts.cl)
- e->ts.cl = gfc_new_charlen (gfc_current_ns);
+ if (!e->ts.u.cl)
+ e->ts.u.cl = gfc_new_charlen (gfc_current_ns);
if (char_ref->u.ss.start)
start = gfc_copy_expr (char_ref->u.ss.start);
@@ -4099,7 +4099,7 @@ gfc_resolve_substring_charlen (gfc_expr
if (char_ref->u.ss.end)
end = gfc_copy_expr (char_ref->u.ss.end);
else if (e->expr_type == EXPR_VARIABLE)
- end = gfc_copy_expr (e->symtree->n.sym->ts.cl->length);
+ end = gfc_copy_expr (e->symtree->n.sym->ts.u.cl->length);
else
end = NULL;
@@ -4107,15 +4107,15 @@ gfc_resolve_substring_charlen (gfc_expr
return;
/* Length = (end - start +1). */
- e->ts.cl->length = gfc_subtract (end, start);
- e->ts.cl->length = gfc_add (e->ts.cl->length, gfc_int_expr (1));
+ e->ts.u.cl->length = gfc_subtract (end, start);
+ e->ts.u.cl->length = gfc_add (e->ts.u.cl->length, gfc_int_expr (1));
- e->ts.cl->length->ts.type = BT_INTEGER;
- e->ts.cl->length->ts.kind = gfc_charlen_int_kind;
+ e->ts.u.cl->length->ts.type = BT_INTEGER;
+ e->ts.u.cl->length->ts.kind = gfc_charlen_int_kind;
/* Make sure that the length is simplified. */
- gfc_simplify_expr (e->ts.cl->length, 1);
- gfc_resolve_expr (e->ts.cl->length);
+ gfc_simplify_expr (e->ts.u.cl->length, 1);
+ gfc_resolve_expr (e->ts.u.cl->length);
}
@@ -4407,7 +4407,7 @@ resolve_variable (gfc_expr *e)
/* Now do the same check on the specification expressions. */
specification_expr = 1;
if (sym->ts.type == BT_CHARACTER
- && gfc_resolve_expr (sym->ts.cl->length) == FAILURE)
+ && gfc_resolve_expr (sym->ts.u.cl->length) == FAILURE)
t = FAILURE;
if (sym->as)
@@ -4552,26 +4552,26 @@ gfc_resolve_character_operator (gfc_expr
gcc_assert (e->value.op.op == INTRINSIC_CONCAT);
- if (op1->ts.cl && op1->ts.cl->length)
- e1 = gfc_copy_expr (op1->ts.cl->length);
+ if (op1->ts.u.cl && op1->ts.u.cl->length)
+ e1 = gfc_copy_expr (op1->ts.u.cl->length);
else if (op1->expr_type == EXPR_CONSTANT)
e1 = gfc_int_expr (op1->value.character.length);
- if (op2->ts.cl && op2->ts.cl->length)
- e2 = gfc_copy_expr (op2->ts.cl->length);
+ if (op2->ts.u.cl && op2->ts.u.cl->length)
+ e2 = gfc_copy_expr (op2->ts.u.cl->length);
else if (op2->expr_type == EXPR_CONSTANT)
e2 = gfc_int_expr (op2->value.character.length);
- e->ts.cl = gfc_new_charlen (gfc_current_ns);
+ e->ts.u.cl = gfc_new_charlen (gfc_current_ns);
if (!e1 || !e2)
return;
- e->ts.cl->length = gfc_add (e1, e2);
- e->ts.cl->length->ts.type = BT_INTEGER;
- e->ts.cl->length->ts.kind = gfc_charlen_int_kind;
- gfc_simplify_expr (e->ts.cl->length, 0);
- gfc_resolve_expr (e->ts.cl->length);
+ e->ts.u.cl->length = gfc_add (e1, e2);
+ e->ts.u.cl->length->ts.type = BT_INTEGER;
+ e->ts.u.cl->length->ts.kind = gfc_charlen_int_kind;
+ gfc_simplify_expr (e->ts.u.cl->length, 0);
+ gfc_resolve_expr (e->ts.u.cl->length);
return;
}
@@ -4596,12 +4596,12 @@ fixup_charlen (gfc_expr *e)
gfc_resolve_character_array_constructor (e);
case EXPR_SUBSTRING:
- if (!e->ts.cl && e->ref)
+ if (!e->ts.u.cl && e->ref)
gfc_resolve_substring_charlen (e);
default:
- if (!e->ts.cl)
- e->ts.cl = gfc_new_charlen (gfc_current_ns);
+ if (!e->ts.u.cl)
+ e->ts.u.cl = gfc_new_charlen (gfc_current_ns);
break;
}
@@ -4777,10 +4777,10 @@ check_typebound_baseobject (gfc_expr* e)
return FAILURE;
gcc_assert (base->ts.type == BT_DERIVED);
- if (base->ts.derived->attr.abstract)
+ if (base->ts.u.derived->attr.abstract)
{
gfc_error ("Base object for type-bound procedure call at %L is of"
- " ABSTRACT type '%s'", &e->where, base->ts.derived->name);
+ " ABSTRACT type '%s'", &e->where, base->ts.u.derived->name);
return FAILURE;
}
@@ -5071,7 +5071,7 @@ gfc_resolve_expr (gfc_expr *e)
expression_rank (e);
}
- if (e->ts.type == BT_CHARACTER && e->ts.cl == NULL && e->ref
+ if (e->ts.type == BT_CHARACTER && e->ts.u.cl == NULL && e->ref
&& e->ref->type != REF_SUBSTRING)
gfc_resolve_substring_charlen (e);
@@ -5131,7 +5131,7 @@ gfc_resolve_expr (gfc_expr *e)
gfc_internal_error ("gfc_resolve_expr(): Bad expression type");
}
- if (e->ts.type == BT_CHARACTER && t == SUCCESS && !e->ts.cl)
+ if (e->ts.type == BT_CHARACTER && t == SUCCESS && !e->ts.u.cl)
fixup_charlen (e);
return t;
@@ -5374,7 +5374,7 @@ derived_inaccessible (gfc_symbol *sym)
for (c = sym->components; c; c = c->next)
{
- if (c->ts.type == BT_DERIVED && derived_inaccessible (c->ts.derived))
+ if (c->ts.type == BT_DERIVED && derived_inaccessible (c->ts.u.derived))
return 1;
}
@@ -6304,21 +6304,21 @@ resolve_transfer (gfc_code *code)
{
/* Check that transferred derived type doesn't contain POINTER
components. */
- if (ts->derived->attr.pointer_comp)
+ if (ts->u.derived->attr.pointer_comp)
{
gfc_error ("Data transfer element at %L cannot have "
"POINTER components", &code->loc);
return;
}
- if (ts->derived->attr.alloc_comp)
+ if (ts->u.derived->attr.alloc_comp)
{
gfc_error ("Data transfer element at %L cannot have "
"ALLOCATABLE components", &code->loc);
return;
}
- if (derived_inaccessible (ts->derived))
+ if (derived_inaccessible (ts->u.derived))
{
gfc_error ("Data transfer element at %L cannot have "
"PRIVATE components",&code->loc);
@@ -6885,7 +6885,7 @@ resolve_ordinary_assign (gfc_code *code,
and rhs is the same symbol as the lhs. */
if (rhs->expr_type == EXPR_VARIABLE
&& rhs->symtree->n.sym->ts.type == BT_DERIVED
- && has_default_initializer (rhs->symtree->n.sym->ts.derived)
+ && has_default_initializer (rhs->symtree->n.sym->ts.u.derived)
&& (lhs->symtree->n.sym == rhs->symtree->n.sym))
code->ext.actual->next->expr = gfc_get_parentheses (rhs);
@@ -6934,18 +6934,18 @@ resolve_ordinary_assign (gfc_code *code,
if (lhs->ts.type == BT_CHARACTER
&& gfc_option.warn_character_truncation)
{
- if (lhs->ts.cl != NULL
- && lhs->ts.cl->length != NULL
- && lhs->ts.cl->length->expr_type == EXPR_CONSTANT)
- llen = mpz_get_si (lhs->ts.cl->length->value.integer);
+ if (lhs->ts.u.cl != NULL
+ && lhs->ts.u.cl->length != NULL
+ && lhs->ts.u.cl->length->expr_type == EXPR_CONSTANT)
+ llen = mpz_get_si (lhs->ts.u.cl->length->value.integer);
if (rhs->expr_type == EXPR_CONSTANT)
rlen = rhs->value.character.length;
- else if (rhs->ts.cl != NULL
- && rhs->ts.cl->length != NULL
- && rhs->ts.cl->length->expr_type == EXPR_CONSTANT)
- rlen = mpz_get_si (rhs->ts.cl->length->value.integer);
+ else if (rhs->ts.u.cl != NULL
+ && rhs->ts.u.cl->length != NULL
+ && rhs->ts.u.cl->length->expr_type == EXPR_CONSTANT)
+ rlen = mpz_get_si (rhs->ts.u.cl->length->value.integer);
if (rlen && llen && rlen > llen)
gfc_warning_now ("CHARACTER expression will be truncated "
@@ -6982,7 +6982,7 @@ resolve_ordinary_assign (gfc_code *code,
if (lhs->ts.type == BT_DERIVED
&& lhs->expr_type == EXPR_VARIABLE
- && lhs->ts.derived->attr.pointer_comp
+ && lhs->ts.u.derived->attr.pointer_comp
&& gfc_impure_variable (rhs->symtree->n.sym))
{
gfc_error ("The impure variable at %L is assigned to "
@@ -7676,7 +7676,7 @@ apply_default_init (gfc_symbol *sym)
if (sym->attr.flavor != FL_VARIABLE && !sym->attr.function)
return;
- if (sym->ts.type == BT_DERIVED && sym->ts.derived)
+ if (sym->ts.type == BT_DERIVED && sym->ts.u.derived)
init = gfc_default_initializer (&sym->ts);
if (init == NULL)
@@ -7821,10 +7821,10 @@ build_default_init_expr (gfc_symbol *sym
/* For characters, the length must be constant in order to
create a default initializer. */
if (gfc_option.flag_init_character == GFC_INIT_CHARACTER_ON
- && sym->ts.cl->length
- && sym->ts.cl->length->expr_type == EXPR_CONSTANT)
+ && sym->ts.u.cl->length
+ && sym->ts.u.cl->length->expr_type == EXPR_CONSTANT)
{
- char_len = mpz_get_si (sym->ts.cl->length->value.integer);
+ char_len = mpz_get_si (sym->ts.u.cl->length->value.integer);
init_expr->value.character.length = char_len;
init_expr->value.character.string = gfc_get_wide_string (char_len+1);
for (i = 0; i < char_len; i++)
@@ -7928,17 +7928,17 @@ resolve_fl_variable_derived (gfc_symbol
associated by the presence of another class I symbol in the same
namespace. 14.6.1.3 of the standard and the discussion on
comp.lang.fortran. */
- if (sym->ns != sym->ts.derived->ns
+ if (sym->ns != sym->ts.u.derived->ns
&& sym->ns->proc_name->attr.if_source != IFSRC_IFBODY)
{
gfc_symbol *s;
- gfc_find_symbol (sym->ts.derived->name, sym->ns, 0, &s);
+ gfc_find_symbol (sym->ts.u.derived->name, sym->ns, 0, &s);
if (s && s->attr.flavor != FL_DERIVED)
{
gfc_error ("The type '%s' cannot be host associated at %L "
"because it is blocked by an incompatible object "
"of the same name declared at %L",
- sym->ts.derived->name, &sym->declared_at,
+ sym->ts.u.derived->name, &sym->declared_at,
&s->declared_at);
return FAILURE;
}
@@ -7956,7 +7956,7 @@ resolve_fl_variable_derived (gfc_symbol
&& sym->ns->proc_name->attr.flavor == FL_MODULE
&& !sym->ns->save_all && !sym->attr.save
&& !sym->attr.pointer && !sym->attr.allocatable
- && has_default_initializer (sym->ts.derived))
+ && has_default_initializer (sym->ts.u.derived))
{
gfc_error("Object '%s' at %L must have the SAVE attribute for "
"default initialization of a component",
@@ -8015,7 +8015,7 @@ resolve_fl_variable (gfc_symbol *sym, in
{
/* Make sure that character string variables with assumed length are
dummy arguments. */
- e = sym->ts.cl->length;
+ e = sym->ts.u.cl->length;
if (e == NULL && !sym->attr.dummy && !sym->attr.result)
{
gfc_error ("Entity with assumed character length at %L must be a "
@@ -8121,7 +8121,7 @@ resolve_fl_procedure (gfc_symbol *sym, i
if (sym->ts.type == BT_CHARACTER)
{
- gfc_charlen *cl = sym->ts.cl;
+ gfc_charlen *cl = sym->ts.u.cl;
if (cl && cl->length && gfc_is_constant_expr (cl->length)
&& resolve_charlen (cl) == FAILURE)
@@ -8161,9 +8161,9 @@ resolve_fl_procedure (gfc_symbol *sym, i
{
if (arg->sym
&& arg->sym->ts.type == BT_DERIVED
- && !arg->sym->ts.derived->attr.use_assoc
- && !gfc_check_access (arg->sym->ts.derived->attr.access,
- arg->sym->ts.derived->ns->default_access)
+ && !arg->sym->ts.u.derived->attr.use_assoc
+ && !gfc_check_access (arg->sym->ts.u.derived->attr.access,
+ arg->sym->ts.u.derived->ns->default_access)
&& gfc_notify_std (GFC_STD_F2003, "Fortran 2003: '%s' is of a "
"PRIVATE type and cannot be a dummy argument"
" of '%s', which is PUBLIC at %L",
@@ -8171,7 +8171,7 @@ resolve_fl_procedure (gfc_symbol *sym, i
== FAILURE)
{
/* Stop this message from recurring. */
- arg->sym->ts.derived->attr.access = ACCESS_PUBLIC;
+ arg->sym->ts.u.derived->attr.access = ACCESS_PUBLIC;
return FAILURE;
}
}
@@ -8184,9 +8184,9 @@ resolve_fl_procedure (gfc_symbol *sym, i
{
if (arg->sym
&& arg->sym->ts.type == BT_DERIVED
- && !arg->sym->ts.derived->attr.use_assoc
- && !gfc_check_access (arg->sym->ts.derived->attr.access,
- arg->sym->ts.derived->ns->default_access)
+ && !arg->sym->ts.u.derived->attr.use_assoc
+ && !gfc_check_access (arg->sym->ts.u.derived->attr.access,
+ arg->sym->ts.u.derived->ns->default_access)
&& gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Procedure "
"'%s' in PUBLIC interface '%s' at %L "
"takes dummy arguments of '%s' which is "
@@ -8195,7 +8195,7 @@ resolve_fl_procedure (gfc_symbol *sym, i
gfc_typename (&arg->sym->ts)) == FAILURE)
{
/* Stop this message from recurring. */
- arg->sym->ts.derived->attr.access = ACCESS_PUBLIC;
+ arg->sym->ts.u.derived->attr.access = ACCESS_PUBLIC;
return FAILURE;
}
}
@@ -8209,9 +8209,9 @@ resolve_fl_procedure (gfc_symbol *sym, i
{
if (arg->sym
&& arg->sym->ts.type == BT_DERIVED
- && !arg->sym->ts.derived->attr.use_assoc
- && !gfc_check_access (arg->sym->ts.derived->attr.access,
- arg->sym->ts.derived->ns->default_access)
+ && !arg->sym->ts.u.derived->attr.use_assoc
+ && !gfc_check_access (arg->sym->ts.u.derived->attr.access,
+ arg->sym->ts.u.derived->ns->default_access)
&& gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Procedure "
"'%s' in PUBLIC interface '%s' at %L "
"takes dummy arguments of '%s' which is "
@@ -8220,7 +8220,7 @@ resolve_fl_procedure (gfc_symbol *sym, i
gfc_typename (&arg->sym->ts)) == FAILURE)
{
/* Stop this message from recurring. */
- arg->sym->ts.derived->attr.access = ACCESS_PUBLIC;
+ arg->sym->ts.u.derived->attr.access = ACCESS_PUBLIC;
return FAILURE;
}
}
@@ -8262,7 +8262,7 @@ resolve_fl_procedure (gfc_symbol *sym, i
function - but length must be declared in calling scoping unit. */
if (sym->attr.function
&& sym->ts.type == BT_CHARACTER
- && sym->ts.cl && sym->ts.cl->length == NULL)
+ && sym->ts.u.cl && sym->ts.u.cl->length == NULL)
{
if ((sym->as && sym->as->rank) || (sym->attr.pointer)
|| (sym->attr.recursive) || (sym->attr.pure))
@@ -8431,7 +8431,7 @@ gfc_resolve_finalizers (gfc_symbol* deri
arg = list->proc_sym->formal->sym;
/* This argument must be of our type. */
- if (arg->ts.type != BT_DERIVED || arg->ts.derived != derived)
+ if (arg->ts.type != BT_DERIVED || arg->ts.u.derived != derived)
{
gfc_error ("Argument of FINAL procedure at %L must be of type '%s'",
&arg->declared_at, derived->name);
@@ -8992,7 +8992,7 @@ resolve_typebound_procedure (gfc_symtree
/* Now check that the argument-type matches. */
gcc_assert (me_arg);
if (me_arg->ts.type != BT_DERIVED
- || me_arg->ts.derived != resolve_bindings_derived)
+ || me_arg->ts.u.derived != resolve_bindings_derived)
{
gfc_error ("Argument '%s' of '%s' with PASS(%s) at %L must be of"
" the derived-type '%s'", me_arg->name, proc->name,
@@ -9228,12 +9228,12 @@ resolve_fl_derived (gfc_symbol *sym)
}
}
/* Copy char length. */
- if (ifc->ts.cl)
+ if (ifc->ts.type == BT_CHARACTER && ifc->ts.u.cl)
{
- c->ts.cl = gfc_new_charlen (sym->ns);
- c->ts.cl->resolved = ifc->ts.cl->resolved;
- c->ts.cl->length = gfc_copy_expr (ifc->ts.cl->length);
- /* TODO: gfc_expr_replace_symbols (c->ts.cl->length, c);*/
+ c->ts.u.cl = gfc_new_charlen (sym->ns);
+ c->ts.u.cl->resolved = ifc->ts.u.cl->resolved;
+ c->ts.u.cl->length = gfc_copy_expr (ifc->ts.u.cl->length);
+ /* TODO: gfc_expr_replace_symbols (c->ts.u.cl->length, c);*/
}
}
else if (c->ts.interface->name[0] != '\0')
@@ -9302,7 +9302,7 @@ resolve_fl_derived (gfc_symbol *sym)
/* Now check that the argument-type matches. */
gcc_assert (me_arg);
if (me_arg->ts.type != BT_DERIVED
- || me_arg->ts.derived != sym)
+ || 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,
@@ -9365,14 +9365,14 @@ resolve_fl_derived (gfc_symbol *sym)
if (c->ts.type == BT_CHARACTER)
{
- if (c->ts.cl->length == NULL
- || (resolve_charlen (c->ts.cl) == FAILURE)
- || !gfc_is_constant_expr (c->ts.cl->length))
+ if (c->ts.u.cl->length == NULL
+ || (resolve_charlen (c->ts.u.cl) == FAILURE)
+ || !gfc_is_constant_expr (c->ts.u.cl->length))
{
gfc_error ("Character length of component '%s' needs to "
"be a constant specification expression at %L",
c->name,
- c->ts.cl->length ? &c->ts.cl->length->where : &c->loc);
+ c->ts.u.cl->length ? &c->ts.u.cl->length->where : &c->loc);
return FAILURE;
}
}
@@ -9380,10 +9380,10 @@ resolve_fl_derived (gfc_symbol *sym)
if (c->ts.type == BT_DERIVED
&& sym->component_access != ACCESS_PRIVATE
&& gfc_check_access (sym->attr.access, sym->ns->default_access)
- && !is_sym_host_assoc (c->ts.derived, sym->ns)
- && !c->ts.derived->attr.use_assoc
- && !gfc_check_access (c->ts.derived->attr.access,
- c->ts.derived->ns->default_access)
+ && !is_sym_host_assoc (c->ts.u.derived, sym->ns)
+ && !c->ts.u.derived->attr.use_assoc
+ && !gfc_check_access (c->ts.u.derived->attr.access,
+ c->ts.u.derived->ns->default_access)
&& gfc_notify_std (GFC_STD_F2003, "Fortran 2003: the component '%s' "
"is a PRIVATE type and cannot be a component of "
"'%s', which is PUBLIC at %L", c->name,
@@ -9392,18 +9392,18 @@ resolve_fl_derived (gfc_symbol *sym)
if (sym->attr.sequence)
{
- if (c->ts.type == BT_DERIVED && c->ts.derived->attr.sequence == 0)
+ if (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.sequence == 0)
{
gfc_error ("Component %s of SEQUENCE type declared at %L does "
"not have the SEQUENCE attribute",
- c->ts.derived->name, &sym->declared_at);
+ c->ts.u.derived->name, &sym->declared_at);
return FAILURE;
}
}
if (c->ts.type == BT_DERIVED && c->attr.pointer
- && c->ts.derived->components == NULL
- && !c->ts.derived->attr.zero_comp)
+ && c->ts.u.derived->components == NULL
+ && !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,
@@ -9415,11 +9415,11 @@ resolve_fl_derived (gfc_symbol *sym)
derived type list; even in formal namespaces, where derived type
pointer components might not have been declared. */
if (c->ts.type == BT_DERIVED
- && c->ts.derived
- && c->ts.derived->components
+ && c->ts.u.derived
+ && c->ts.u.derived->components
&& c->attr.pointer
- && sym != c->ts.derived)
- add_dt_to_dt_list (c->ts.derived);
+ && sym != c->ts.u.derived)
+ add_dt_to_dt_list (c->ts.u.derived);
if (c->attr.pointer || c->attr.proc_pointer || c->attr.allocatable
|| c->as == NULL)
@@ -9487,7 +9487,7 @@ resolve_fl_namelist (gfc_symbol *sym)
/* Types with private components that came here by USE-association. */
if (nl->sym->ts.type == BT_DERIVED
- && derived_inaccessible (nl->sym->ts.derived))
+ && derived_inaccessible (nl->sym->ts.u.derived))
{
gfc_error ("NAMELIST object '%s' has use-associated PRIVATE "
"components and cannot be member of namelist '%s' at %L",
@@ -9497,8 +9497,8 @@ resolve_fl_namelist (gfc_symbol *sym)
/* Types with private components that are defined in the same module. */
if (nl->sym->ts.type == BT_DERIVED
- && !is_sym_host_assoc (nl->sym->ts.derived, sym->ns)
- && !gfc_check_access (nl->sym->ts.derived->attr.private_comp
+ && !is_sym_host_assoc (nl->sym->ts.u.derived, sym->ns)
+ && !gfc_check_access (nl->sym->ts.u.derived->attr.private_comp
? ACCESS_PRIVATE : ACCESS_UNKNOWN,
nl->sym->ns->default_access))
{
@@ -9533,7 +9533,7 @@ resolve_fl_namelist (gfc_symbol *sym)
if (nl->sym->ts.type != BT_DERIVED)
continue;
- if (nl->sym->ts.derived->attr.alloc_comp)
+ if (nl->sym->ts.u.derived->attr.alloc_comp)
{
gfc_error ("NAMELIST object '%s' in namelist '%s' at %L cannot "
"have ALLOCATABLE components",
@@ -9541,7 +9541,7 @@ resolve_fl_namelist (gfc_symbol *sym)
return FAILURE;
}
- if (nl->sym->ts.derived->attr.pointer_comp)
+ if (nl->sym->ts.u.derived->attr.pointer_comp)
{
gfc_error ("NAMELIST object '%s' in namelist '%s' at %L cannot "
"have POINTER components",
@@ -9724,12 +9724,12 @@ resolve_symbol (gfc_symbol *sym)
}
}
/* Copy char length. */
- if (ifc->ts.cl)
+ if (ifc->ts.type == BT_CHARACTER && ifc->ts.u.cl)
{
- sym->ts.cl = gfc_new_charlen (sym->ns);
- sym->ts.cl->resolved = ifc->ts.cl->resolved;
- sym->ts.cl->length = gfc_copy_expr (ifc->ts.cl->length);
- gfc_expr_replace_symbols (sym->ts.cl->length, sym);
+ sym->ts.u.cl = gfc_new_charlen (sym->ns);
+ sym->ts.u.cl->resolved = ifc->ts.u.cl->resolved;
+ sym->ts.u.cl->length = gfc_copy_expr (ifc->ts.u.cl->length);
+ gfc_expr_replace_symbols (sym->ts.u.cl->length, sym);
}
}
else if (sym->ts.interface->name[0] != '\0')
@@ -9871,7 +9871,7 @@ resolve_symbol (gfc_symbol *sym)
if (sym->attr.value && sym->ts.type == BT_CHARACTER)
{
- gfc_charlen *cl = sym->ts.cl;
+ gfc_charlen *cl = sym->ts.u.cl;
if (!cl || !cl->length || cl->length->expr_type != EXPR_CONSTANT)
{
gfc_error ("Character dummy variable '%s' at %L with VALUE "
@@ -9923,14 +9923,14 @@ resolve_symbol (gfc_symbol *sym)
/* If type() declaration, we need to verify that the components
of the given type are all C interoperable, etc. */
if (sym->ts.type == BT_DERIVED &&
- sym->ts.derived->attr.is_c_interop != 1)
+ sym->ts.u.derived->attr.is_c_interop != 1)
{
/* Make sure the user marked the derived type as BIND(C). If
not, call the verify routine. This could print an error
for the derived type more than once if multiple variables
of that type are declared. */
- if (sym->ts.derived->attr.is_bind_c != 1)
- verify_bind_c_derived_type (sym->ts.derived);
+ if (sym->ts.u.derived->attr.is_bind_c != 1)
+ verify_bind_c_derived_type (sym->ts.u.derived);
t = FAILURE;
}
@@ -9959,12 +9959,12 @@ resolve_symbol (gfc_symbol *sym)
the type is not declared in the scope of the implicit
statement. Change the type to BT_UNKNOWN, both because it is so
and to prevent an ICE. */
- if (sym->ts.type == BT_DERIVED && sym->ts.derived->components == NULL
- && !sym->ts.derived->attr.zero_comp)
+ if (sym->ts.type == BT_DERIVED && sym->ts.u.derived->components == NULL
+ && !sym->ts.u.derived->attr.zero_comp)
{
gfc_error ("The derived type '%s' at %L is of type '%s', "
"which has not been defined", sym->name,
- &sym->declared_at, sym->ts.derived->name);
+ &sym->declared_at, sym->ts.u.derived->name);
sym->ts.type = BT_UNKNOWN;
return;
}
@@ -9973,23 +9973,23 @@ resolve_symbol (gfc_symbol *sym)
derived type is visible in the symbol's namespace, if it is a
module function and is not PRIVATE. */
if (sym->ts.type == BT_DERIVED
- && sym->ts.derived->attr.use_assoc
+ && sym->ts.u.derived->attr.use_assoc
&& sym->ns->proc_name
&& sym->ns->proc_name->attr.flavor == FL_MODULE)
{
gfc_symbol *ds;
- if (resolve_fl_derived (sym->ts.derived) == FAILURE)
+ if (resolve_fl_derived (sym->ts.u.derived) == FAILURE)
return;
- gfc_find_symbol (sym->ts.derived->name, sym->ns, 1, &ds);
+ gfc_find_symbol (sym->ts.u.derived->name, sym->ns, 1, &ds);
if (!ds && sym->attr.function
&& gfc_check_access (sym->attr.access, sym->ns->default_access))
{
symtree = gfc_new_symtree (&sym->ns->sym_root,
- sym->ts.derived->name);
- symtree->n.sym = sym->ts.derived;
- sym->ts.derived->refs++;
+ sym->ts.u.derived->name);
+ symtree->n.sym = sym->ts.u.derived;
+ sym->ts.u.derived->refs++;
}
}
@@ -9999,15 +9999,15 @@ resolve_symbol (gfc_symbol *sym)
161 in 95-006r3. */
if (sym->ts.type == BT_DERIVED
&& sym->ns->proc_name && sym->ns->proc_name->attr.flavor == FL_MODULE
- && !sym->ts.derived->attr.use_assoc
+ && !sym->ts.u.derived->attr.use_assoc
&& gfc_check_access (sym->attr.access, sym->ns->default_access)
- && !gfc_check_access (sym->ts.derived->attr.access,
- sym->ts.derived->ns->default_access)
+ && !gfc_check_access (sym->ts.u.derived->attr.access,
+ sym->ts.u.derived->ns->default_access)
&& gfc_notify_std (GFC_STD_F2003, "Fortran 2003: PUBLIC %s '%s' at %L "
"of PRIVATE derived type '%s'",
(sym->attr.flavor == FL_PARAMETER) ? "parameter"
: "variable", sym->name, &sym->declared_at,
- sym->ts.derived->name) == FAILURE)
+ sym->ts.u.derived->name) == FAILURE)
return;
/* An assumed-size array with INTENT(OUT) shall not be of a type for which
@@ -10018,7 +10018,7 @@ resolve_symbol (gfc_symbol *sym)
&& sym->as
&& sym->as->type == AS_ASSUMED_SIZE)
{
- for (c = sym->ts.derived->components; c; c = c->next)
+ for (c = sym->ts.u.derived->components; c; c = c->next)
{
if (c->initializer)
{
@@ -10622,11 +10622,11 @@ sequence_type (gfc_typespec ts)
{
case BT_DERIVED:
- if (ts.derived->components == NULL)
+ if (ts.u.derived->components == NULL)
return SEQ_NONDEFAULT;
- result = sequence_type (ts.derived->components->ts);
- for (c = ts.derived->components->next; c; c = c->next)
+ result = sequence_type (ts.u.derived->components->ts);
+ for (c = ts.u.derived->components->next; c; c = c->next)
if (sequence_type (c->ts) != result)
return SEQ_MIXED;
@@ -10674,7 +10674,6 @@ sequence_type (gfc_typespec ts)
static gfc_try
resolve_equivalence_derived (gfc_symbol *derived, gfc_symbol *sym, gfc_expr *e)
{
- gfc_symbol *d;
gfc_component *c = derived->components;
if (!derived)
@@ -10698,7 +10697,7 @@ resolve_equivalence_derived (gfc_symbol
return FAILURE;
}
- if (sym->attr.in_common && has_default_initializer (sym->ts.derived))
+ if (sym->attr.in_common && has_default_initializer (sym->ts.u.derived))
{
gfc_error ("Derived type variable '%s' at %L with default "
"initialization cannot be in EQUIVALENCE with a variable "
@@ -10708,9 +10707,8 @@ resolve_equivalence_derived (gfc_symbol
for (; c ; c = c->next)
{
- d = c->ts.derived;
- if (d
- && (resolve_equivalence_derived (c->ts.derived, sym, e) == FAILURE))
+ if (c->ts.type == BT_DERIVED
+ && (resolve_equivalence_derived (c->ts.u.derived, sym, e) == FAILURE))
return FAILURE;
/* Shall not be an object of sequence derived type containing a pointer
@@ -10744,7 +10742,6 @@ static void
resolve_equivalence (gfc_equiv *eq)
{
gfc_symbol *sym;
- gfc_symbol *derived;
gfc_symbol *first_sym;
gfc_expr *e;
gfc_ref *r;
@@ -10808,11 +10805,11 @@ resolve_equivalence (gfc_equiv *eq)
if (start == NULL)
start = gfc_int_expr (1);
ref->u.ss.start = start;
- if (end == NULL && e->ts.cl)
- end = gfc_copy_expr (e->ts.cl->length);
+ if (end == NULL && e->ts.u.cl)
+ end = gfc_copy_expr (e->ts.u.cl->length);
ref->u.ss.end = end;
- ref->u.ss.length = e->ts.cl;
- e->ts.cl = NULL;
+ ref->u.ss.length = e->ts.u.cl;
+ e->ts.u.cl = NULL;
}
ref = ref->next;
gfc_free (mem);
@@ -10863,8 +10860,8 @@ resolve_equivalence (gfc_equiv *eq)
continue;
}
- derived = e->ts.derived;
- if (derived && resolve_equivalence_derived (derived, sym, e) == FAILURE)
+ if (e->ts.type == BT_DERIVED
+ && resolve_equivalence_derived (e->ts.u.derived, sym, e) == FAILURE)
continue;
/* Check that the types correspond correctly:
@@ -10997,15 +10994,15 @@ resolve_fntype (gfc_namespace *ns)
sym->attr.untyped = 1;
}
- if (sym->ts.type == BT_DERIVED && !sym->ts.derived->attr.use_assoc
+ if (sym->ts.type == BT_DERIVED && !sym->ts.u.derived->attr.use_assoc
&& !sym->attr.contained
- && !gfc_check_access (sym->ts.derived->attr.access,
- sym->ts.derived->ns->default_access)
+ && !gfc_check_access (sym->ts.u.derived->attr.access,
+ sym->ts.u.derived->ns->default_access)
&& gfc_check_access (sym->attr.access, sym->ns->default_access))
{
gfc_notify_std (GFC_STD_F2003, "Fortran 2003: PUBLIC function '%s' at "
"%L of PRIVATE type '%s'", sym->name,
- &sym->declared_at, sym->ts.derived->name);
+ &sym->declared_at, sym->ts.u.derived->name);
}
if (ns->entries)
@@ -11046,9 +11043,9 @@ gfc_resolve_uops (gfc_symtree *symtree)
sym->name, &sym->declared_at);
if (sym->ts.type == BT_CHARACTER
- && !(sym->ts.cl && sym->ts.cl->length)
- && !(sym->result && sym->result->ts.cl
- && sym->result->ts.cl->length))
+ && !(sym->ts.u.cl && sym->ts.u.cl->length)
+ && !(sym->result && sym->result->ts.u.cl
+ && sym->result->ts.u.cl->length))
gfc_error ("User operator procedure '%s' at %L cannot be assumed "
"character length", sym->name, &sym->declared_at);
Index: gcc/fortran/iresolve.c
===================================================================
--- gcc/fortran/iresolve.c (revision 150364)
+++ gcc/fortran/iresolve.c (working copy)
@@ -62,16 +62,16 @@ gfc_get_string (const char *format, ...)
static void
check_charlen_present (gfc_expr *source)
{
- if (source->ts.cl == NULL)
- source->ts.cl = gfc_new_charlen (gfc_current_ns);
+ if (source->ts.u.cl == NULL)
+ source->ts.u.cl = gfc_new_charlen (gfc_current_ns);
if (source->expr_type == EXPR_CONSTANT)
{
- source->ts.cl->length = gfc_int_expr (source->value.character.length);
+ source->ts.u.cl->length = gfc_int_expr (source->value.character.length);
source->rank = 0;
}
else if (source->expr_type == EXPR_ARRAY)
- source->ts.cl->length =
+ source->ts.u.cl->length =
gfc_int_expr (source->value.constructor->expr->value.character.length);
}
@@ -161,8 +161,8 @@ gfc_resolve_char_achar (gfc_expr *f, gfc
f->ts.type = BT_CHARACTER;
f->ts.kind = (kind == NULL)
? gfc_default_character_kind : mpz_get_si (kind->value.integer);
- f->ts.cl = gfc_new_charlen (gfc_current_ns);
- f->ts.cl->length = gfc_int_expr (1);
+ f->ts.u.cl = gfc_new_charlen (gfc_current_ns);
+ f->ts.u.cl->length = gfc_int_expr (1);
f->value.function.name = gfc_get_string (name, f->ts.kind,
gfc_type_letter (x->ts.type),
@@ -651,8 +651,8 @@ gfc_resolve_ctime (gfc_expr *f, gfc_expr
{
ts.type = BT_INTEGER;
ts.kind = 8;
- ts.derived = NULL;
- ts.cl = NULL;
+ ts.u.derived = NULL;
+ ts.u.cl = NULL;
gfc_convert_type (time, &ts, 2);
}
@@ -1058,8 +1058,8 @@ gfc_resolve_index_func (gfc_expr *f, gfc
{
ts.type = BT_LOGICAL;
ts.kind = gfc_default_integer_kind;
- ts.derived = NULL;
- ts.cl = NULL;
+ ts.u.derived = NULL;
+ ts.u.cl = NULL;
gfc_convert_type (back, &ts, 2);
}
@@ -1125,8 +1125,8 @@ gfc_resolve_isatty (gfc_expr *f, gfc_exp
{
ts.type = BT_INTEGER;
ts.kind = gfc_c_int_kind;
- ts.derived = NULL;
- ts.cl = NULL;
+ ts.u.derived = NULL;
+ ts.u.cl = NULL;
gfc_convert_type (u, &ts, 2);
}
@@ -2175,8 +2175,8 @@ gfc_resolve_fgetc (gfc_expr *f, gfc_expr
{
ts.type = BT_INTEGER;
ts.kind = gfc_c_int_kind;
- ts.derived = NULL;
- ts.cl = NULL;
+ ts.u.derived = NULL;
+ ts.u.cl = NULL;
gfc_convert_type (u, &ts, 2);
}
@@ -2205,8 +2205,8 @@ gfc_resolve_fputc (gfc_expr *f, gfc_expr
{
ts.type = BT_INTEGER;
ts.kind = gfc_c_int_kind;
- ts.derived = NULL;
- ts.cl = NULL;
+ ts.u.derived = NULL;
+ ts.u.cl = NULL;
gfc_convert_type (u, &ts, 2);
}
@@ -2235,8 +2235,8 @@ gfc_resolve_ftell (gfc_expr *f, gfc_expr
{
ts.type = BT_INTEGER;
ts.kind = gfc_c_int_kind;
- ts.derived = NULL;
- ts.cl = NULL;
+ ts.u.derived = NULL;
+ ts.u.cl = NULL;
gfc_convert_type (u, &ts, 2);
}
@@ -2340,9 +2340,9 @@ gfc_resolve_transfer (gfc_expr *f, gfc_e
/* TODO: Make this do something meaningful. */
static char transfer0[] = "__transfer0", transfer1[] = "__transfer1";
- if (mold->ts.type == BT_CHARACTER && !mold->ts.cl->length
+ if (mold->ts.type == BT_CHARACTER && !mold->ts.u.cl->length
&& !(mold->expr_type == EXPR_VARIABLE && mold->symtree->n.sym->attr.dummy))
- mold->ts.cl->length = gfc_int_expr (mold->value.character.length);
+ mold->ts.u.cl->length = gfc_int_expr (mold->value.character.length);
f->ts = mold->ts;
@@ -2488,8 +2488,8 @@ gfc_resolve_ttynam (gfc_expr *f, gfc_exp
{
ts.type = BT_INTEGER;
ts.kind = gfc_c_int_kind;
- ts.derived = NULL;
- ts.cl = NULL;
+ ts.u.derived = NULL;
+ ts.u.cl = NULL;
gfc_convert_type (unit, &ts, 2);
}
@@ -3067,8 +3067,8 @@ gfc_resolve_ctime_sub (gfc_code *c)
{
ts.type = BT_INTEGER;
ts.kind = 8;
- ts.derived = NULL;
- ts.cl = NULL;
+ ts.u.derived = NULL;
+ ts.u.cl = NULL;
gfc_convert_type (c->ext.actual->expr, &ts, 2);
}
@@ -3170,8 +3170,8 @@ gfc_resolve_fgetc_sub (gfc_code *c)
{
ts.type = BT_INTEGER;
ts.kind = gfc_c_int_kind;
- ts.derived = NULL;
- ts.cl = NULL;
+ ts.u.derived = NULL;
+ ts.u.cl = NULL;
gfc_convert_type (u, &ts, 2);
}
@@ -3215,8 +3215,8 @@ gfc_resolve_fputc_sub (gfc_code *c)
{
ts.type = BT_INTEGER;
ts.kind = gfc_c_int_kind;
- ts.derived = NULL;
- ts.cl = NULL;
+ ts.u.derived = NULL;
+ ts.u.cl = NULL;
gfc_convert_type (u, &ts, 2);
}
@@ -3264,8 +3264,8 @@ gfc_resolve_fseek_sub (gfc_code *c)
{
ts.type = BT_INTEGER;
ts.kind = gfc_c_int_kind;
- ts.derived = NULL;
- ts.cl = NULL;
+ ts.u.derived = NULL;
+ ts.u.cl = NULL;
gfc_convert_type (unit, &ts, 2);
}
@@ -3273,8 +3273,8 @@ gfc_resolve_fseek_sub (gfc_code *c)
{
ts.type = BT_INTEGER;
ts.kind = gfc_intio_kind;
- ts.derived = NULL;
- ts.cl = NULL;
+ ts.u.derived = NULL;
+ ts.u.cl = NULL;
gfc_convert_type (offset, &ts, 2);
}
@@ -3282,8 +3282,8 @@ gfc_resolve_fseek_sub (gfc_code *c)
{
ts.type = BT_INTEGER;
ts.kind = gfc_c_int_kind;
- ts.derived = NULL;
- ts.cl = NULL;
+ ts.u.derived = NULL;
+ ts.u.cl = NULL;
gfc_convert_type (whence, &ts, 2);
}
@@ -3306,8 +3306,8 @@ gfc_resolve_ftell_sub (gfc_code *c)
{
ts.type = BT_INTEGER;
ts.kind = gfc_c_int_kind;
- ts.derived = NULL;
- ts.cl = NULL;
+ ts.u.derived = NULL;
+ ts.u.cl = NULL;
gfc_convert_type (unit, &ts, 2);
}
@@ -3326,8 +3326,8 @@ gfc_resolve_ttynam_sub (gfc_code *c)
{
ts.type = BT_INTEGER;
ts.kind = gfc_c_int_kind;
- ts.derived = NULL;
- ts.cl = NULL;
+ ts.u.derived = NULL;
+ ts.u.cl = NULL;
gfc_convert_type (c->ext.actual->expr, &ts, 2);
}
Index: gcc/fortran/target-memory.c
===================================================================
--- gcc/fortran/target-memory.c (revision 150364)
+++ gcc/fortran/target-memory.c (working copy)
@@ -229,7 +229,7 @@ encode_derived (gfc_expr *source, unsign
type = gfc_typenode_for_spec (&source->ts);
ctr = source->value.constructor;
- cmp = source->ts.derived->components;
+ cmp = source->ts.u.derived->components;
for (;ctr; ctr = ctr->next, cmp = cmp->next)
{
gcc_assert (cmp);
@@ -435,9 +435,9 @@ gfc_interpret_character (unsigned char *
{
int i;
- if (result->ts.cl && result->ts.cl->length)
+ if (result->ts.u.cl && result->ts.u.cl->length)
result->value.character.length =
- (int) mpz_get_ui (result->ts.cl->length->value.integer);
+ (int) mpz_get_ui (result->ts.u.cl->length->value.integer);
gcc_assert (buffer_size >= size_character (result->value.character.length,
result->ts.kind));
@@ -484,7 +484,7 @@ gfc_interpret_derived (unsigned char *bu
result->expr_type = EXPR_STRUCTURE;
type = gfc_typenode_for_spec (&result->ts);
- cmp = result->ts.derived->components;
+ cmp = result->ts.u.derived->components;
/* Run through the derived type components. */
for (;cmp; cmp = cmp->next)
@@ -633,7 +633,7 @@ expr_to_char (gfc_expr *e, unsigned char
if (e->ts.type == BT_DERIVED)
{
ctr = e->value.constructor;
- cmp = e->ts.derived->components;
+ cmp = e->ts.u.derived->components;
for (;ctr; ctr = ctr->next, cmp = cmp->next)
{
gcc_assert (cmp && cmp->backend_decl);
Index: gcc/fortran/match.c
===================================================================
--- gcc/fortran/match.c (revision 150364)
+++ gcc/fortran/match.c (working copy)
@@ -2264,7 +2264,7 @@ gfc_match_allocate (void)
}
if (tail->expr->ts.type == BT_DERIVED)
- tail->expr->ts.derived = gfc_use_derived (tail->expr->ts.derived);
+ tail->expr->ts.u.derived = gfc_use_derived (tail->expr->ts.u.derived);
/* FIXME: disable the checking on derived types and arrays. */
if (!(tail->expr->ref
@@ -3214,7 +3214,7 @@ gfc_match_namelist (void)
gfc_error_check ();
}
- if (sym->ts.type == BT_CHARACTER && sym->ts.cl->length == NULL)
+ if (sym->ts.type == BT_CHARACTER && sym->ts.u.cl->length == NULL)
{
gfc_error ("Assumed character length '%s' in namelist '%s' at "
"%C is not allowed", sym->name, group_name->name);
Index: gcc/fortran/trans-decl.c
===================================================================
--- gcc/fortran/trans-decl.c (revision 150364)
+++ gcc/fortran/trans-decl.c (working copy)
@@ -796,7 +796,7 @@ gfc_build_dummy_array_decl (gfc_symbol *
/* Do we know the element size? */
known_size = sym->ts.type != BT_CHARACTER
- || INTEGER_CST_P (sym->ts.cl->backend_decl);
+ || INTEGER_CST_P (sym->ts.u.cl->backend_decl);
if (known_size && !GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (type)))
{
@@ -928,10 +928,10 @@ gfc_nonlocal_dummy_array_decl (gfc_symbo
static tree
gfc_create_string_length (gfc_symbol * sym)
{
- gcc_assert (sym->ts.cl);
- gfc_conv_const_charlen (sym->ts.cl);
+ gcc_assert (sym->ts.u.cl);
+ gfc_conv_const_charlen (sym->ts.u.cl);
- if (sym->ts.cl->backend_decl == NULL_TREE)
+ if (sym->ts.u.cl->backend_decl == NULL_TREE)
{
tree length;
char name[GFC_MAX_MANGLED_SYMBOL_LEN + 2];
@@ -947,11 +947,11 @@ gfc_create_string_length (gfc_symbol * s
if (sym->ns->proc_name->tlink != NULL)
gfc_defer_symbol_init (sym);
- sym->ts.cl->backend_decl = length;
+ sym->ts.u.cl->backend_decl = length;
}
- gcc_assert (sym->ts.cl->backend_decl != NULL_TREE);
- return sym->ts.cl->backend_decl;
+ gcc_assert (sym->ts.u.cl->backend_decl != NULL_TREE);
+ return sym->ts.u.cl->backend_decl;
}
/* If a variable is assigned a label, we add another two auxiliary
@@ -1050,10 +1050,10 @@ gfc_get_symbol_decl (gfc_symbol * sym)
/* Create a character length variable. */
if (sym->ts.type == BT_CHARACTER)
{
- if (sym->ts.cl->backend_decl == NULL_TREE)
+ if (sym->ts.u.cl->backend_decl == NULL_TREE)
length = gfc_create_string_length (sym);
else
- length = sym->ts.cl->backend_decl;
+ length = sym->ts.u.cl->backend_decl;
if (TREE_CODE (length) == VAR_DECL
&& DECL_CONTEXT (length) == NULL_TREE)
{
@@ -1118,7 +1118,7 @@ gfc_get_symbol_decl (gfc_symbol * sym)
if (s && s->backend_decl)
{
if (sym->ts.type == BT_CHARACTER)
- sym->ts.cl->backend_decl = s->ts.cl->backend_decl;
+ sym->ts.u.cl->backend_decl = s->ts.u.cl->backend_decl;
return s->backend_decl;
}
}
@@ -1171,7 +1171,7 @@ gfc_get_symbol_decl (gfc_symbol * sym)
GFC_DECL_PACKED_ARRAY (decl) = 1;
}
- if (sym->ts.type == BT_DERIVED && sym->ts.derived->attr.alloc_comp)
+ if (sym->ts.type == BT_DERIVED && sym->ts.u.derived->attr.alloc_comp)
gfc_defer_symbol_init (sym);
/* This applies a derived type default initializer. */
else if (sym->ts.type == BT_DERIVED
@@ -1696,9 +1696,9 @@ create_function_arglist (gfc_symbol * sy
PARM_DECL,
get_identifier (".__result"),
len_type);
- if (!sym->ts.cl->length)
+ if (!sym->ts.u.cl->length)
{
- sym->ts.cl->backend_decl = length;
+ sym->ts.u.cl->backend_decl = length;
TREE_USED (length) = 1;
}
gcc_assert (TREE_CODE (length) == PARM_DECL);
@@ -1707,13 +1707,13 @@ create_function_arglist (gfc_symbol * sy
TREE_READONLY (length) = 1;
DECL_ARTIFICIAL (length) = 1;
gfc_finish_decl (length);
- if (sym->ts.cl->backend_decl == NULL
- || sym->ts.cl->backend_decl == length)
+ if (sym->ts.u.cl->backend_decl == NULL
+ || sym->ts.u.cl->backend_decl == length)
{
gfc_symbol *arg;
tree backend_decl;
- if (sym->ts.cl->backend_decl == NULL)
+ if (sym->ts.u.cl->backend_decl == NULL)
{
tree len = build_decl (input_location,
VAR_DECL,
@@ -1721,7 +1721,7 @@ create_function_arglist (gfc_symbol * sy
gfc_charlen_type_node);
DECL_ARTIFICIAL (len) = 1;
TREE_USED (len) = 1;
- sym->ts.cl->backend_decl = len;
+ sym->ts.u.cl->backend_decl = len;
}
/* Make sure PARM_DECL type doesn't point to incomplete type. */
@@ -1791,38 +1791,38 @@ create_function_arglist (gfc_symbol * sy
gfc_finish_decl (length);
/* Remember the passed value. */
- if (f->sym->ts.cl->passed_length != NULL)
+ if (f->sym->ts.u.cl->passed_length != NULL)
{
/* This can happen if the same type is used for multiple
arguments. We need to copy cl as otherwise
cl->passed_length gets overwritten. */
gfc_charlen *cl, *cl2;
- cl = f->sym->ts.cl;
- f->sym->ts.cl = gfc_get_charlen();
- f->sym->ts.cl->length = cl->length;
- f->sym->ts.cl->backend_decl = cl->backend_decl;
- f->sym->ts.cl->length_from_typespec = cl->length_from_typespec;
- f->sym->ts.cl->resolved = cl->resolved;
- cl2 = f->sym->ts.cl->next;
- f->sym->ts.cl->next = cl;
+ cl = f->sym->ts.u.cl;
+ f->sym->ts.u.cl = gfc_get_charlen();
+ f->sym->ts.u.cl->length = cl->length;
+ f->sym->ts.u.cl->backend_decl = cl->backend_decl;
+ f->sym->ts.u.cl->length_from_typespec = cl->length_from_typespec;
+ f->sym->ts.u.cl->resolved = cl->resolved;
+ cl2 = f->sym->ts.u.cl->next;
+ f->sym->ts.u.cl->next = cl;
cl->next = cl2;
}
- f->sym->ts.cl->passed_length = length;
+ f->sym->ts.u.cl->passed_length = length;
/* Use the passed value for assumed length variables. */
- if (!f->sym->ts.cl->length)
+ if (!f->sym->ts.u.cl->length)
{
TREE_USED (length) = 1;
- gcc_assert (!f->sym->ts.cl->backend_decl);
- f->sym->ts.cl->backend_decl = length;
+ gcc_assert (!f->sym->ts.u.cl->backend_decl);
+ f->sym->ts.u.cl->backend_decl = length;
}
hidden_typelist = TREE_CHAIN (hidden_typelist);
- if (f->sym->ts.cl->backend_decl == NULL
- || f->sym->ts.cl->backend_decl == length)
+ if (f->sym->ts.u.cl->backend_decl == NULL
+ || f->sym->ts.u.cl->backend_decl == length)
{
- if (f->sym->ts.cl->backend_decl == NULL)
+ if (f->sym->ts.u.cl->backend_decl == NULL)
gfc_create_string_length (f->sym);
/* Make sure PARM_DECL type doesn't point to incomplete type. */
@@ -1993,7 +1993,7 @@ build_entry_thunks (gfc_namespace * ns)
args);
if (formal->sym->ts.type == BT_CHARACTER)
{
- tmp = thunk_formal->sym->ts.cl->backend_decl;
+ tmp = thunk_formal->sym->ts.u.cl->backend_decl;
string_args = tree_cons (NULL_TREE, tmp, string_args);
}
}
@@ -2090,15 +2090,15 @@ build_entry_thunks (gfc_namespace * ns)
{
formal->sym->backend_decl = NULL_TREE;
if (formal->sym->ts.type == BT_CHARACTER)
- formal->sym->ts.cl->backend_decl = NULL_TREE;
+ formal->sym->ts.u.cl->backend_decl = NULL_TREE;
}
if (thunk_sym->attr.function)
{
if (thunk_sym->ts.type == BT_CHARACTER)
- thunk_sym->ts.cl->backend_decl = NULL_TREE;
+ thunk_sym->ts.u.cl->backend_decl = NULL_TREE;
if (thunk_sym->result->ts.type == BT_CHARACTER)
- thunk_sym->result->ts.cl->backend_decl = NULL_TREE;
+ thunk_sym->result->ts.u.cl->backend_decl = NULL_TREE;
}
}
@@ -2207,10 +2207,10 @@ gfc_get_fake_result_decl (gfc_symbol * s
if (sym->ts.type == BT_CHARACTER)
{
- if (sym->ts.cl->backend_decl == NULL_TREE)
+ if (sym->ts.u.cl->backend_decl == NULL_TREE)
length = gfc_create_string_length (sym);
else
- length = sym->ts.cl->backend_decl;
+ length = sym->ts.u.cl->backend_decl;
if (TREE_CODE (length) == VAR_DECL
&& DECL_CONTEXT (length) == NULL_TREE)
gfc_add_decl_to_function (length);
@@ -2816,12 +2816,12 @@ gfc_trans_auto_character_variable (gfc_s
tree tmp;
gcc_assert (sym->backend_decl);
- gcc_assert (sym->ts.cl && sym->ts.cl->length);
+ gcc_assert (sym->ts.u.cl && sym->ts.u.cl->length);
gfc_start_block (&body);
/* Evaluate the string length expression. */
- gfc_conv_string_length (sym->ts.cl, NULL, &body);
+ gfc_conv_string_length (sym->ts.u.cl, NULL, &body);
gfc_trans_vla_type_sizes (sym, &body);
@@ -3009,9 +3009,9 @@ init_intent_out_dt (gfc_symbol * proc_sy
&& !f->sym->attr.pointer
&& f->sym->ts.type == BT_DERIVED)
{
- if (f->sym->ts.derived->attr.alloc_comp)
+ if (f->sym->ts.u.derived->attr.alloc_comp)
{
- tmp = gfc_deallocate_alloc_comp (f->sym->ts.derived,
+ tmp = gfc_deallocate_alloc_comp (f->sym->ts.u.derived,
f->sym->backend_decl,
f->sym->as ? f->sym->as->rank : 0);
@@ -3022,7 +3022,7 @@ init_intent_out_dt (gfc_symbol * proc_sy
gfc_add_expr_to_block (&fnblock, tmp);
}
- if (!f->sym->ts.derived->attr.alloc_comp
+ if (!f->sym->ts.u.derived->attr.alloc_comp
&& f->sym->value)
body = gfc_init_default_dt (f->sym, body);
}
@@ -3073,14 +3073,14 @@ gfc_trans_deferred_vars (gfc_symbol * pr
/* An automatic character length, pointer array result. */
if (proc_sym->ts.type == BT_CHARACTER
- && TREE_CODE (proc_sym->ts.cl->backend_decl) == VAR_DECL)
- fnbody = gfc_trans_dummy_character (proc_sym, proc_sym->ts.cl,
+ && TREE_CODE (proc_sym->ts.u.cl->backend_decl) == VAR_DECL)
+ fnbody = gfc_trans_dummy_character (proc_sym, proc_sym->ts.u.cl,
fnbody);
}
else if (proc_sym->ts.type == BT_CHARACTER)
{
- if (TREE_CODE (proc_sym->ts.cl->backend_decl) == VAR_DECL)
- fnbody = gfc_trans_dummy_character (proc_sym, proc_sym->ts.cl,
+ if (TREE_CODE (proc_sym->ts.u.cl->backend_decl) == VAR_DECL)
+ fnbody = gfc_trans_dummy_character (proc_sym, proc_sym->ts.u.cl,
fnbody);
}
else
@@ -3096,7 +3096,7 @@ gfc_trans_deferred_vars (gfc_symbol * pr
for (sym = proc_sym->tlink; sym != proc_sym; sym = sym->tlink)
{
bool sym_has_alloc_comp = (sym->ts.type == BT_DERIVED)
- && sym->ts.derived->attr.alloc_comp;
+ && sym->ts.u.derived->attr.alloc_comp;
if (sym->attr.dimension)
{
switch (sym->as->type)
@@ -3170,7 +3170,7 @@ gfc_trans_deferred_vars (gfc_symbol * pr
gfc_get_backend_locus (&loc);
gfc_set_backend_locus (&sym->declared_at);
if (sym->attr.dummy || sym->attr.result)
- fnbody = gfc_trans_dummy_character (sym, sym->ts.cl, fnbody);
+ fnbody = gfc_trans_dummy_character (sym, sym->ts.u.cl, fnbody);
else
fnbody = gfc_trans_auto_character_variable (sym, fnbody);
gfc_set_backend_locus (&loc);
@@ -3197,8 +3197,8 @@ gfc_trans_deferred_vars (gfc_symbol * pr
{
if (f->sym && f->sym->tlink == NULL && f->sym->ts.type == BT_CHARACTER)
{
- gcc_assert (f->sym->ts.cl->backend_decl != NULL);
- if (TREE_CODE (f->sym->ts.cl->backend_decl) == PARM_DECL)
+ gcc_assert (f->sym->ts.u.cl->backend_decl != NULL);
+ if (TREE_CODE (f->sym->ts.u.cl->backend_decl) == PARM_DECL)
gfc_trans_vla_type_sizes (f->sym, &body);
}
}
@@ -3206,8 +3206,8 @@ gfc_trans_deferred_vars (gfc_symbol * pr
if (gfc_return_by_reference (proc_sym) && proc_sym->ts.type == BT_CHARACTER
&& current_fake_result_decl != NULL)
{
- gcc_assert (proc_sym->ts.cl->backend_decl != NULL);
- if (TREE_CODE (proc_sym->ts.cl->backend_decl) == PARM_DECL)
+ gcc_assert (proc_sym->ts.u.cl->backend_decl != NULL);
+ if (TREE_CODE (proc_sym->ts.u.cl->backend_decl) == PARM_DECL)
gfc_trans_vla_type_sizes (proc_sym, &body);
}
@@ -3381,7 +3381,7 @@ gfc_create_module_variable (gfc_symbol *
{
tree length;
- length = sym->ts.cl->backend_decl;
+ length = sym->ts.u.cl->backend_decl;
if (!INTEGER_CST_P (length))
{
pushdecl (length);
@@ -3511,7 +3511,7 @@ check_constant_initializer (gfc_expr *ex
case BT_DERIVED:
if (expr->expr_type != EXPR_STRUCTURE)
return false;
- cm = expr->ts.derived->components;
+ cm = expr->ts.u.derived->components;
for (c = expr->value.constructor; c; c = c->next, cm = cm->next)
{
if (!c->expr || cm->attr.allocatable)
@@ -3557,12 +3557,12 @@ gfc_emit_parameter_debug_info (gfc_symbo
if (sym->ts.type == BT_CHARACTER)
{
- gfc_conv_const_charlen (sym->ts.cl);
- if (sym->ts.cl->backend_decl == NULL
- || TREE_CODE (sym->ts.cl->backend_decl) != INTEGER_CST)
+ gfc_conv_const_charlen (sym->ts.u.cl);
+ if (sym->ts.u.cl->backend_decl == NULL
+ || TREE_CODE (sym->ts.u.cl->backend_decl) != INTEGER_CST)
return;
}
- else if (sym->ts.type == BT_DERIVED && sym->ts.derived->attr.alloc_comp)
+ else if (sym->ts.type == BT_DERIVED && sym->ts.u.derived->attr.alloc_comp)
return;
if (sym->as)
@@ -3690,10 +3690,10 @@ generate_dependency_declarations (gfc_sy
int i;
if (sym->ts.type == BT_CHARACTER
- && sym->ts.cl
- && sym->ts.cl->length
- && sym->ts.cl->length->expr_type != EXPR_CONSTANT)
- generate_expr_decls (sym, sym->ts.cl->length);
+ && sym->ts.u.cl
+ && sym->ts.u.cl->length
+ && sym->ts.u.cl->length->expr_type != EXPR_CONSTANT)
+ generate_expr_decls (sym, sym->ts.u.cl->length);
if (sym->as && sym->as->rank)
{
@@ -3744,8 +3744,8 @@ generate_local_decl (gfc_symbol * sym)
warning if requested. */
if (sym->attr.dummy && !sym->attr.referenced
&& sym->ts.type == BT_CHARACTER
- && sym->ts.cl->backend_decl != NULL
- && TREE_CODE (sym->ts.cl->backend_decl) == VAR_DECL)
+ && sym->ts.u.cl->backend_decl != NULL
+ && TREE_CODE (sym->ts.u.cl->backend_decl) == VAR_DECL)
{
sym->attr.referenced = 1;
gfc_get_symbol_decl (sym);
@@ -3756,7 +3756,7 @@ generate_local_decl (gfc_symbol * sym)
generate the code for nullification and automatic lengths. */
if (!sym->attr.referenced
&& sym->ts.type == BT_DERIVED
- && sym->ts.derived->attr.alloc_comp
+ && sym->ts.u.derived->attr.alloc_comp
&& !sym->attr.pointer
&& ((sym->attr.dummy && sym->attr.intent == INTENT_OUT)
||
@@ -3887,7 +3887,7 @@ add_argument_checking (stmtblock_t *bloc
const char *message;
fsym = formal->sym;
- cl = fsym->ts.cl;
+ cl = fsym->ts.u.cl;
gcc_assert (cl);
gcc_assert (cl->passed_length != NULL_TREE);
@@ -4224,10 +4224,10 @@ gfc_generate_function_code (gfc_namespac
gfc_entry_list *el;
tree backend_decl;
- gfc_conv_const_charlen (ns->proc_name->ts.cl);
- backend_decl = ns->proc_name->result->ts.cl->backend_decl;
+ gfc_conv_const_charlen (ns->proc_name->ts.u.cl);
+ backend_decl = ns->proc_name->result->ts.u.cl->backend_decl;
for (el = ns->entries; el; el = el->next)
- el->sym->result->ts.cl->backend_decl = backend_decl;
+ el->sym->result->ts.u.cl->backend_decl = backend_decl;
}
/* Translate COMMON blocks. */
@@ -4328,11 +4328,11 @@ gfc_generate_function_code (gfc_namespac
if (result != NULL_TREE && sym->attr.function
&& sym->ts.type == BT_DERIVED
- && sym->ts.derived->attr.alloc_comp
+ && sym->ts.u.derived->attr.alloc_comp
&& !sym->attr.pointer)
{
rank = sym->as ? sym->as->rank : 0;
- tmp2 = gfc_nullify_alloc_comp (sym->ts.derived, result, rank);
+ tmp2 = gfc_nullify_alloc_comp (sym->ts.u.derived, result, rank);
gfc_add_expr_to_block (&block, tmp2);
}
Index: gcc/fortran/trans-io.c
===================================================================
--- gcc/fortran/trans-io.c (revision 150364)
+++ gcc/fortran/trans-io.c (working copy)
@@ -1591,7 +1591,7 @@ transfer_namelist_element (stmtblock_t *
dt_parm_addr = gfc_build_addr_expr (NULL_TREE, dt_parm);
if (ts->type == BT_CHARACTER)
- tmp = ts->cl->backend_decl;
+ tmp = ts->u.cl->backend_decl;
else
tmp = build_int_cst (gfc_charlen_type_node, 0);
tmp = build_call_expr_loc (input_location,
@@ -1624,7 +1624,7 @@ transfer_namelist_element (stmtblock_t *
tree expr = build_fold_indirect_ref_loc (input_location,
addr_expr);
- for (cmp = ts->derived->components; cmp; cmp = cmp->next)
+ for (cmp = ts->u.derived->components; cmp; cmp = cmp->next)
{
char *full_name = nml_full_name (var_name, cmp->name);
transfer_namelist_element (block,
@@ -2005,8 +2005,8 @@ transfer_expr (gfc_se * se, gfc_typespec
C_NULL_PTR or C_NULL_FUNPTR. We could also get a user variable of
type C_PTR or C_FUNPTR, in which case the ts->type may no longer be
BT_DERIVED (could have been changed by gfc_conv_expr). */
- if ((ts->type == BT_DERIVED && ts->is_iso_c == 1 && ts->derived != NULL)
- || (ts->derived != NULL && ts->derived->ts.is_iso_c == 1))
+ if ((ts->type == BT_DERIVED && ts->is_iso_c == 1 && ts->u.derived != NULL)
+ || (ts->u.derived != NULL && ts->u.derived->ts.is_iso_c == 1))
{
/* C_PTR and C_FUNPTR have private components which means they can not
be printed. However, if -std=gnu and not -pedantic, allow
@@ -2014,14 +2014,14 @@ transfer_expr (gfc_se * se, gfc_typespec
if (gfc_notification_std (GFC_STD_GNU) != SILENT)
{
gfc_error_now ("Derived type '%s' at %L has PRIVATE components",
- ts->derived->name, code != NULL ? &(code->loc) :
+ ts->u.derived->name, code != NULL ? &(code->loc) :
&gfc_current_locus);
return;
}
- ts->type = ts->derived->ts.type;
- ts->kind = ts->derived->ts.kind;
- ts->f90_type = ts->derived->ts.f90_type;
+ ts->type = ts->u.derived->ts.type;
+ ts->kind = ts->u.derived->ts.kind;
+ ts->f90_type = ts->u.derived->ts.f90_type;
}
kind = ts->kind;
@@ -2093,7 +2093,7 @@ transfer_expr (gfc_se * se, gfc_typespec
expr = build_fold_indirect_ref_loc (input_location,
expr);
- for (c = ts->derived->components; c; c = c->next)
+ for (c = ts->u.derived->components; c; c = c->next)
{
field = c->backend_decl;
gcc_assert (field && TREE_CODE (field) == FIELD_DECL);
Index: gcc/fortran/parse.c
===================================================================
--- gcc/fortran/parse.c (revision 150364)
+++ gcc/fortran/parse.c (working copy)
@@ -2049,24 +2049,24 @@ endType:
{
/* Look for allocatable components. */
if (c->attr.allocatable
- || (c->ts.type == BT_DERIVED && c->ts.derived->attr.alloc_comp))
+ || (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_DERIVED && c->ts.derived->attr.pointer_comp))
+ || (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.pointer_comp))
sym->attr.pointer_comp = 1;
/* Look for procedure pointer components. */
if (c->attr.proc_pointer
|| (c->ts.type == BT_DERIVED
- && c->ts.derived->attr.proc_pointer_comp))
+ && c->ts.u.derived->attr.proc_pointer_comp))
sym->attr.proc_pointer_comp = 1;
/* Look for private components. */
if (sym->component_access == ACCESS_PRIVATE
|| c->attr.access == ACCESS_PRIVATE
- || (c->ts.type == BT_DERIVED && c->ts.derived->attr.private_comp))
+ || (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.private_comp))
sym->attr.private_comp = 1;
}
@@ -2320,7 +2320,7 @@ match_deferred_characteristics (gfc_type
{
ts->kind = 0;
- if (!ts->derived || !ts->derived->components)
+ if (!ts->u.derived || !ts->u.derived->components)
m = MATCH_ERROR;
}
@@ -2360,8 +2360,8 @@ check_function_result_typed (void)
/* Check type-parameters, at the moment only CHARACTER lengths possible. */
/* TODO: Extend when KIND type parameters are implemented. */
- if (ts->type == BT_CHARACTER && ts->cl && ts->cl->length)
- gfc_expr_check_typed (ts->cl->length, gfc_current_ns, true);
+ if (ts->type == BT_CHARACTER && ts->u.cl && ts->u.cl->length)
+ gfc_expr_check_typed (ts->u.cl->length, gfc_current_ns, true);
}
@@ -2540,7 +2540,7 @@ declSt:
gfc_current_block ()->ts.kind = 0;
/* Keep the derived type; if it's bad, it will be discovered later. */
- if (!(ts->type == BT_DERIVED && ts->derived))
+ if (!(ts->type == BT_DERIVED && ts->u.derived))
ts->type = BT_UNKNOWN;
}
Index: gcc/fortran/check.c
===================================================================
--- gcc/fortran/check.c (revision 150364)
+++ gcc/fortran/check.c (working copy)
@@ -410,20 +410,20 @@ gfc_check_same_strlen (const gfc_expr *a
long len_a, len_b;
len_a = len_b = -1;
- if (a->ts.cl && a->ts.cl->length
- && a->ts.cl->length->expr_type == EXPR_CONSTANT)
- len_a = mpz_get_si (a->ts.cl->length->value.integer);
+ if (a->ts.u.cl && a->ts.u.cl->length
+ && a->ts.u.cl->length->expr_type == EXPR_CONSTANT)
+ len_a = mpz_get_si (a->ts.u.cl->length->value.integer);
else if (a->expr_type == EXPR_CONSTANT
- && (a->ts.cl == NULL || a->ts.cl->length == NULL))
+ && (a->ts.u.cl == NULL || a->ts.u.cl->length == NULL))
len_a = a->value.character.length;
else
return SUCCESS;
- if (b->ts.cl && b->ts.cl->length
- && b->ts.cl->length->expr_type == EXPR_CONSTANT)
- len_b = mpz_get_si (b->ts.cl->length->value.integer);
+ if (b->ts.u.cl && b->ts.u.cl->length
+ && b->ts.u.cl->length->expr_type == EXPR_CONSTANT)
+ len_b = mpz_get_si (b->ts.u.cl->length->value.integer);
else if (b->expr_type == EXPR_CONSTANT
- && (b->ts.cl == NULL || b->ts.cl->length == NULL))
+ && (b->ts.u.cl == NULL || b->ts.u.cl->length == NULL))
len_b = b->value.character.length;
else
return SUCCESS;
@@ -1400,12 +1400,12 @@ gfc_check_ichar_iachar (gfc_expr *c, gfc
{
/* Check that the argument is length one. Non-constant lengths
can't be checked here, so assume they are ok. */
- if (c->ts.cl && c->ts.cl->length)
+ if (c->ts.u.cl && c->ts.u.cl->length)
{
/* If we already have a length for this expression then use it. */
- if (c->ts.cl->length->expr_type != EXPR_CONSTANT)
+ if (c->ts.u.cl->length->expr_type != EXPR_CONSTANT)
return SUCCESS;
- i = mpz_get_si (c->ts.cl->length->value.integer);
+ i = mpz_get_si (c->ts.u.cl->length->value.integer);
}
else
return SUCCESS;
Index: gcc/fortran/primary.c
===================================================================
--- gcc/fortran/primary.c (revision 150364)
+++ gcc/fortran/primary.c (working copy)
@@ -1770,7 +1770,7 @@ gfc_match_varspec (gfc_expr *primary, in
if (sym->ts.type != BT_DERIVED || gfc_match_char ('%') != MATCH_YES)
goto check_substring;
- sym = sym->ts.derived;
+ sym = sym->ts.u.derived;
for (;;)
{
@@ -1864,7 +1864,7 @@ gfc_match_varspec (gfc_expr *primary, in
|| gfc_match_char ('%') != MATCH_YES)
break;
- sym = component->ts.derived;
+ sym = component->ts.u.derived;
}
check_substring:
@@ -1881,7 +1881,7 @@ check_substring:
if (primary->ts.type == BT_CHARACTER)
{
- switch (match_substring (primary->ts.cl, equiv_flag, &substring))
+ switch (match_substring (primary->ts.u.cl, equiv_flag, &substring))
{
case MATCH_YES:
if (tail == NULL)
@@ -1893,7 +1893,7 @@ check_substring:
primary->expr_type = EXPR_SUBSTRING;
if (substring)
- primary->ts.cl = NULL;
+ primary->ts.u.cl = NULL;
break;
@@ -1990,7 +1990,7 @@ gfc_variable_attr (gfc_expr *expr, gfc_t
follows. */
if (ts->type == BT_CHARACTER
&& ref->next && ref->next->type == REF_SUBSTRING)
- ts->cl = NULL;
+ ts->u.cl = NULL;
}
pointer = ref->u.c.component->attr.pointer;
@@ -2106,7 +2106,7 @@ build_actual_constructor (gfc_structure_
value->where = gfc_current_locus;
if (build_actual_constructor (comp_head, &value->value.constructor,
- comp->ts.derived) == FAILURE)
+ comp->ts.u.derived) == FAILURE)
{
gfc_free_expr (value);
return FAILURE;
@@ -2284,13 +2284,13 @@ gfc_match_structure_constructor (gfc_sym
&& sym->attr.extension
&& (comp_tail->val->ts.type != BT_DERIVED
||
- comp_tail->val->ts.derived != this_comp->ts.derived))
+ comp_tail->val->ts.u.derived != this_comp->ts.u.derived))
{
gfc_current_locus = where;
gfc_free_expr (comp_tail->val);
comp_tail->val = NULL;
- m = gfc_match_structure_constructor (comp->ts.derived,
+ m = gfc_match_structure_constructor (comp->ts.u.derived,
&comp_tail->val, true);
if (m == MATCH_NO)
goto syntax;
@@ -2335,7 +2335,7 @@ gfc_match_structure_constructor (gfc_sym
e->expr_type = EXPR_STRUCTURE;
e->ts.type = BT_DERIVED;
- e->ts.derived = sym;
+ e->ts.u.derived = sym;
e->where = where;
e->value.constructor = ctor_head;
@@ -2758,7 +2758,7 @@ gfc_match_rvalue (gfc_expr **result)
that we're not sure is a variable yet. */
if ((implicit_char || sym->ts.type == BT_CHARACTER)
- && match_substring (sym->ts.cl, 0, &e->ref) == MATCH_YES)
+ && match_substring (sym->ts.u.cl, 0, &e->ref) == MATCH_YES)
{
e->expr_type = EXPR_VARIABLE;
@@ -2780,7 +2780,7 @@ gfc_match_rvalue (gfc_expr **result)
e->ts = sym->ts;
if (e->ref)
- e->ts.cl = NULL;
+ e->ts.u.cl = NULL;
m = MATCH_YES;
break;
}
@@ -2957,7 +2957,7 @@ match_variable (gfc_expr **result, int e
type may still have to be resolved. */
if (sym->ts.type == BT_DERIVED
- && gfc_use_derived (sym->ts.derived) == NULL)
+ && gfc_use_derived (sym->ts.u.derived) == NULL)
return MATCH_ERROR;
break;
}
Index: gcc/fortran/trans-intrinsic.c
===================================================================
--- gcc/fortran/trans-intrinsic.c (revision 150364)
+++ gcc/fortran/trans-intrinsic.c (working copy)
@@ -3479,7 +3479,7 @@ gfc_conv_intrinsic_len (gfc_se * se, gfc
&& (sym->result == sym))
decl = gfc_get_fake_result_decl (sym, 0);
- len = sym->ts.cl->backend_decl;
+ len = sym->ts.u.cl->backend_decl;
gcc_assert (len);
break;
}
@@ -4629,7 +4629,7 @@ gfc_conv_associated (gfc_se *se, gfc_exp
nonzero_charlen = NULL_TREE;
if (arg1->expr->ts.type == BT_CHARACTER)
nonzero_charlen = fold_build2 (NE_EXPR, boolean_type_node,
- arg1->expr->ts.cl->backend_decl,
+ arg1->expr->ts.u.cl->backend_decl,
integer_zero_node);
if (ss1 == gfc_ss_terminator)
@@ -4883,7 +4883,7 @@ gfc_conv_intrinsic_repeat (gfc_se * se,
dlen = fold_build2 (MULT_EXPR, gfc_charlen_type_node,
fold_convert (gfc_charlen_type_node, slen),
fold_convert (gfc_charlen_type_node, ncopies));
- type = gfc_get_character_type (expr->ts.kind, expr->ts.cl);
+ type = gfc_get_character_type (expr->ts.kind, expr->ts.u.cl);
dest = gfc_conv_string_tmp (se, build_pointer_type (type), dlen);
/* Generate the code to do the repeat operation:
Index: gcc/fortran/misc.c
===================================================================
--- gcc/fortran/misc.c (revision 150364)
+++ gcc/fortran/misc.c (working copy)
@@ -67,9 +67,9 @@ void
gfc_clear_ts (gfc_typespec *ts)
{
ts->type = BT_UNKNOWN;
- ts->derived = NULL;
+ ts->u.derived = NULL;
ts->kind = 0;
- ts->cl = NULL;
+ ts->u.cl = NULL;
ts->interface = NULL;
/* flag that says if the type is C interoperable */
ts->is_c_interop = 0;
@@ -183,7 +183,7 @@ gfc_typename (gfc_typespec *ts)
sprintf (buffer, "HOLLERITH");
break;
case BT_DERIVED:
- sprintf (buffer, "TYPE(%s)", ts->derived->name);
+ sprintf (buffer, "TYPE(%s)", ts->u.derived->name);
break;
case BT_PROCEDURE:
strcpy (buffer, "PROCEDURE");
Index: gcc/fortran/simplify.c
===================================================================
--- gcc/fortran/simplify.c (revision 150364)
+++ gcc/fortran/simplify.c (working copy)
@@ -3217,12 +3217,12 @@ gfc_simplify_len (gfc_expr *e, gfc_expr
}
}
- if (e->ts.cl != NULL && e->ts.cl->length != NULL
- && e->ts.cl->length->expr_type == EXPR_CONSTANT
- && e->ts.cl->length->ts.type == BT_INTEGER)
+ if (e->ts.u.cl != NULL && e->ts.u.cl->length != NULL
+ && e->ts.u.cl->length->expr_type == EXPR_CONSTANT
+ && e->ts.u.cl->length->ts.type == BT_INTEGER)
{
result = gfc_constant_result (BT_INTEGER, k, &e->where);
- mpz_set (result->value.integer, e->ts.cl->length->value.integer);
+ mpz_set (result->value.integer, e->ts.u.cl->length->value.integer);
if (gfc_range_check (result) == ARITH_OK)
return result;
else
@@ -4102,7 +4102,7 @@ gfc_simplify_pack (gfc_expr *array, gfc_
gfc_array_size (result, &result->shape[0]);
if (array->ts.type == BT_CHARACTER)
- result->ts.cl = array->ts.cl;
+ result->ts.u.cl = array->ts.u.cl;
return result;
}
@@ -4300,14 +4300,14 @@ gfc_simplify_repeat (gfc_expr *e, gfc_ex
}
/* If we don't know the character length, we can do no more. */
- if (e->ts.cl && e->ts.cl->length
- && e->ts.cl->length->expr_type == EXPR_CONSTANT)
+ if (e->ts.u.cl && e->ts.u.cl->length
+ && e->ts.u.cl->length->expr_type == EXPR_CONSTANT)
{
- len = mpz_get_si (e->ts.cl->length->value.integer);
+ len = mpz_get_si (e->ts.u.cl->length->value.integer);
have_length = true;
}
else if (e->expr_type == EXPR_CONSTANT
- && (e->ts.cl == NULL || e->ts.cl->length == NULL))
+ && (e->ts.u.cl == NULL || e->ts.u.cl->length == NULL))
{
len = e->value.character.length;
}
@@ -4335,7 +4335,7 @@ gfc_simplify_repeat (gfc_expr *e, gfc_ex
if (have_length)
{
mpz_tdiv_q (max, gfc_integer_kinds[i].huge,
- e->ts.cl->length->value.integer);
+ e->ts.u.cl->length->value.integer);
}
else
{
@@ -4364,8 +4364,8 @@ gfc_simplify_repeat (gfc_expr *e, gfc_ex
return NULL;
if (len ||
- (e->ts.cl->length &&
- mpz_sgn (e->ts.cl->length->value.integer)) != 0)
+ (e->ts.u.cl->length &&
+ mpz_sgn (e->ts.u.cl->length->value.integer)) != 0)
{
const char *res = gfc_extract_int (n, &ncop);
gcc_assert (res == NULL);
@@ -5267,7 +5267,7 @@ gfc_simplify_spread (gfc_expr *source, g
return NULL;
if (source->ts.type == BT_CHARACTER)
- result->ts.cl = source->ts.cl;
+ result->ts.u.cl = source->ts.u.cl;
return result;
}
@@ -5623,7 +5623,7 @@ gfc_simplify_transpose (gfc_expr *matrix
mpz_set (result->shape[1], matrix->shape[0]);
if (matrix->ts.type == BT_CHARACTER)
- result->ts.cl = matrix->ts.cl;
+ result->ts.u.cl = matrix->ts.u.cl;
matrix_rows = mpz_get_si (matrix->shape[0]);
matrix_ctor = matrix->value.constructor;
@@ -5706,7 +5706,7 @@ gfc_simplify_unpack (gfc_expr *vector, g
result->shape = gfc_copy_shape (mask->shape, mask->rank);
if (vector->ts.type == BT_CHARACTER)
- result->ts.cl = vector->ts.cl;
+ result->ts.u.cl = vector->ts.u.cl;
vector_ctor = vector->value.constructor;
mask_ctor = mask->value.constructor;
@@ -6087,7 +6087,7 @@ gfc_convert_char_constant (gfc_expr *e,
result->shape = gfc_copy_shape (e->shape, e->rank);
result->where = e->where;
result->rank = e->rank;
- result->ts.cl = e->ts.cl;
+ result->ts.u.cl = e->ts.u.cl;
return result;
}