From bc21d3152f7644fcbd2acf98adbba270c0408c91 Mon Sep 17 00:00:00 2001 From: Janus Weil Date: Thu, 13 Aug 2009 21:46:46 +0200 Subject: [PATCH] re PR fortran/40941 (gfc_typespec: put derived and cl into union) 2009-08-13 Janus Weil PR fortran/40941 * gfortran.h (gfc_typespec): Put 'derived' and 'cl' into union. * decl.c (build_struct): Make sure 'cl' is only used if type is BT_CHARACTER. * symbol.c (gfc_set_default_type): Ditto. * resolve.c (resolve_symbol, resolve_fl_derived): Ditto. (resolve_equivalence,resolve_equivalence_derived): Make sure 'derived' is only used if type is BT_DERIVED. * trans-io.c (transfer_expr): Make sure 'derived' is only used if type is BT_DERIVED or BT_INTEGER (special case: C_PTR/C_FUNPTR). * array.c: Mechanical replacements to accomodate union in gfc_typespec. * check.c: Ditto. * data.c: Ditto. * decl.c: Ditto. * dump-parse-tree.c: Ditto. * expr.c: Ditto. * interface.c: Ditto. * iresolve.c: Ditto. * match.c: Ditto. * misc.c: Ditto. * module.c: Ditto. * openmp.c: Ditto. * parse.c: Ditto. * primary.c: Ditto. * resolve.c: Ditto. * simplify.c: Ditto. * symbol.c: Ditto. * target-memory.c: Ditto. * trans-array.c: Ditto. * trans-common.c: Ditto. * trans-const.c: Ditto. * trans-decl.c: Ditto. * trans-expr.c: Ditto. * trans-intrinsic.c: Ditto. * trans-io.c: Ditto. * trans-stmt.c: Ditto. * trans-types.c: Ditto. From-SVN: r150725 --- gcc/fortran/ChangeLog | 40 ++++ gcc/fortran/array.c | 32 +-- gcc/fortran/check.c | 22 +-- gcc/fortran/data.c | 10 +- gcc/fortran/decl.c | 141 ++++++------- gcc/fortran/dump-parse-tree.c | 6 +- gcc/fortran/expr.c | 40 ++-- gcc/fortran/gfortran.h | 12 +- gcc/fortran/interface.c | 54 ++--- gcc/fortran/iresolve.c | 78 ++++---- gcc/fortran/match.c | 4 +- gcc/fortran/misc.c | 6 +- gcc/fortran/module.c | 6 +- gcc/fortran/openmp.c | 6 +- gcc/fortran/parse.c | 16 +- gcc/fortran/primary.c | 24 +-- gcc/fortran/resolve.c | 361 +++++++++++++++++----------------- gcc/fortran/simplify.c | 32 +-- gcc/fortran/symbol.c | 62 +++--- gcc/fortran/target-memory.c | 10 +- gcc/fortran/trans-array.c | 114 +++++------ gcc/fortran/trans-common.c | 4 +- gcc/fortran/trans-const.c | 4 +- gcc/fortran/trans-decl.c | 146 +++++++------- gcc/fortran/trans-expr.c | 176 ++++++++--------- gcc/fortran/trans-intrinsic.c | 6 +- gcc/fortran/trans-io.c | 19 +- gcc/fortran/trans-stmt.c | 20 +- gcc/fortran/trans-types.c | 50 ++--- 29 files changed, 773 insertions(+), 728 deletions(-) diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index a07ee12aef3..f48729e34b2 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,43 @@ +2009-08-13 Janus Weil + + PR fortran/40941 + * gfortran.h (gfc_typespec): Put 'derived' and 'cl' into union. + * decl.c (build_struct): Make sure 'cl' is only used + if type is BT_CHARACTER. + * symbol.c (gfc_set_default_type): Ditto. + * resolve.c (resolve_symbol, resolve_fl_derived): Ditto. + (resolve_equivalence,resolve_equivalence_derived): Make sure 'derived' + is only used if type is BT_DERIVED. + * trans-io.c (transfer_expr): Make sure 'derived' is only used if type + is BT_DERIVED or BT_INTEGER (special case: C_PTR/C_FUNPTR). + * array.c: Mechanical replacements to accomodate union in gfc_typespec. + * check.c: Ditto. + * data.c: Ditto. + * decl.c: Ditto. + * dump-parse-tree.c: Ditto. + * expr.c: Ditto. + * interface.c: Ditto. + * iresolve.c: Ditto. + * match.c: Ditto. + * misc.c: Ditto. + * module.c: Ditto. + * openmp.c: Ditto. + * parse.c: Ditto. + * primary.c: Ditto. + * resolve.c: Ditto. + * simplify.c: Ditto. + * symbol.c: Ditto. + * target-memory.c: Ditto. + * trans-array.c: Ditto. + * trans-common.c: Ditto. + * trans-const.c: Ditto. + * trans-decl.c: Ditto. + * trans-expr.c: Ditto. + * trans-intrinsic.c: Ditto. + * trans-io.c: Ditto. + * trans-stmt.c: Ditto. + * trans-types.c: Ditto. + 2009-08-13 Janus Weil PR fortran/40995 diff --git a/gcc/fortran/array.c b/gcc/fortran/array.c index 2fee4658a0d..2e12a146ae0 100644 --- a/gcc/fortran/array.c +++ b/gcc/fortran/array.c @@ -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 (gfc_expr *expr) 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)) diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c index 779af2038e9..6e2ce410225 100644 --- a/gcc/fortran/check.c +++ b/gcc/fortran/check.c @@ -410,20 +410,20 @@ gfc_check_same_strlen (const gfc_expr *a, const gfc_expr *b, const char *name) 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_expr *kind) { /* 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; diff --git a/gcc/fortran/data.c b/gcc/fortran/data.c index 5829c7f9c67..6cddb3c7b71 100644 --- a/gcc/fortran/data.c +++ b/gcc/fortran/data.c @@ -154,7 +154,7 @@ create_character_intializer (gfc_expr *init, gfc_typespec *ts, 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, gfc_expr *rvalue, mpz_t index) /* 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, gfc_expr *rvalue, mpz_t index) 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 *lvalue, gfc_expr *rvalue, /* 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; diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index abe2147b7a2..b1c15176108 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -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 *cl, 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,42 +1253,42 @@ add_init_expr_to_sym (const char *name, gfc_expr **initp, locus *var_locus) && 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 && init->ts.type == BT_CHARACTER) { /* Update symbol character length according initializer. */ if (gfc_check_assign_symbol (sym, init) == FAILURE) return FAILURE; - 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) @@ -1297,8 +1297,8 @@ add_init_expr_to_sym (const char *name, gfc_expr **initp, locus *var_locus) { /* 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); @@ -1389,7 +1389,7 @@ build_struct (const char *name, gfc_charlen *cl, gfc_expr **init, /* 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"); @@ -1410,7 +1410,8 @@ build_struct (const char *name, gfc_charlen *cl, gfc_expr **init, 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; @@ -1423,27 +1424,27 @@ build_struct (const char *name, gfc_charlen *cl, gfc_expr **init, /* 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) { @@ -1609,14 +1610,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; @@ -1634,8 +1635,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; @@ -1707,13 +1708,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 " @@ -2241,7 +2242,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 @@ -2387,10 +2388,10 @@ gfc_match_type_spec (gfc_typespec *ts, int implicit_flag) 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; } @@ -2423,7 +2424,7 @@ gfc_match_type_spec (gfc_typespec *ts, int implicit_flag) return MATCH_ERROR; gfc_set_sym_referenced (sym); - ts->derived = sym; + ts->u.derived = sym; return MATCH_YES; @@ -2614,11 +2615,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. */ @@ -3330,8 +3331,8 @@ set_com_block_bind_c (gfc_common_head *com_block, int is_bind_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; @@ -3473,9 +3474,9 @@ verify_bind_c_sym (gfc_symbol *tmp_sym, gfc_typespec *ts, /* 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)); @@ -3679,7 +3680,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) { @@ -3687,7 +3688,7 @@ gfc_match_data_decl (void) goto cleanup; } - current_ts.derived = sym; + current_ts.u.derived = sym; } m = match_attr_spec (); @@ -3697,21 +3698,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 @@ -6202,30 +6203,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; @@ -6762,7 +6763,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. */ diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c index 2a411d48ad7..5802cdc8a7c 100644 --- a/gcc/fortran/dump-parse-tree.c +++ b/gcc/fortran/dump-parse-tree.c @@ -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; diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index b8d54e7dea1..85c0cea644c 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -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_restricted) 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); @@ -3337,7 +3337,7 @@ gfc_default_initializer (gfc_typespec *ts) 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; @@ -3348,10 +3348,10 @@ gfc_default_initializer (gfc_typespec *ts) 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 (); @@ -3421,10 +3421,10 @@ gfc_traverse_expr (gfc_expr *expr, gfc_symbol *sym, 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) @@ -3502,11 +3502,11 @@ gfc_traverse_expr (gfc_expr *expr, gfc_symbol *sym, 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; diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index cb456bc5976..17a0a532072 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -833,13 +833,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. */ unsigned int is_class:1; int is_c_interop; diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index daa46d88619..60096e20828 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -410,17 +410,17 @@ gfc_compare_derived_types (gfc_symbol *derived1, gfc_symbol *derived2) /* 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, gfc_typespec *ts2) 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); } @@ -1386,9 +1386,9 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual, 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) @@ -1551,9 +1551,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; } @@ -1599,11 +1599,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; @@ -1869,28 +1869,28 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, 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; } diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c index 5bb24a42a21..1c180eb27b8 100644 --- a/gcc/fortran/iresolve.c +++ b/gcc/fortran/iresolve.c @@ -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_expr *x, gfc_expr *kind, 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 *time) { 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_expr *str, { 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_expr *u) { 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 *u, gfc_expr *c ATTRIBUTE_UNUSED) { 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 *u, gfc_expr *c ATTRIBUTE_UNUSED) { 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 *u) { 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); } @@ -2341,16 +2341,16 @@ gfc_resolve_transfer (gfc_expr *f, gfc_expr *source ATTRIBUTE_UNUSED, static char transfer0[] = "__transfer0", transfer1[] = "__transfer1"; if (mold->ts.type == BT_CHARACTER - && !mold->ts.cl->length + && !mold->ts.u.cl->length && gfc_is_constant_expr (mold)) { int len; if (mold->expr_type == EXPR_CONSTANT) - mold->ts.cl->length = gfc_int_expr (mold->value.character.length); + mold->ts.u.cl->length = gfc_int_expr (mold->value.character.length); else { len = mold->value.constructor->expr->value.character.length; - mold->ts.cl->length = gfc_int_expr (len); + mold->ts.u.cl->length = gfc_int_expr (len); } } @@ -2498,8 +2498,8 @@ gfc_resolve_ttynam (gfc_expr *f, gfc_expr *unit) { 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); } @@ -3077,8 +3077,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); } @@ -3180,8 +3180,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); } @@ -3225,8 +3225,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); } @@ -3274,8 +3274,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); } @@ -3283,8 +3283,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); } @@ -3292,8 +3292,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); } @@ -3316,8 +3316,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); } @@ -3336,8 +3336,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); } diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c index b9b9d54d44e..3c6ef49ed2b 100644 --- a/gcc/fortran/match.c +++ b/gcc/fortran/match.c @@ -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); diff --git a/gcc/fortran/misc.c b/gcc/fortran/misc.c index 7e4b481e59f..f80c9fa6af7 100644 --- a/gcc/fortran/misc.c +++ b/gcc/fortran/misc.c @@ -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; ts->is_class = 0; /* flag that says if the type is C interoperable */ @@ -184,7 +184,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"); diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c index 5d64fd1e980..fe05dff8299 100644 --- a/gcc/fortran/module.c +++ b/gcc/fortran/module.c @@ -2038,7 +2038,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); @@ -2054,12 +2054,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 (); } diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index 320fb65c97c..d60121c5929 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -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) diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index e4463bd7edf..2552fcd6788 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -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_typespec * ts) { 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; } diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c index 0d52c6c0940..e0021c54b18 100644 --- a/gcc/fortran/primary.c +++ b/gcc/fortran/primary.c @@ -1770,7 +1770,7 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag, 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, int equiv_flag, bool sub_flag, || 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_typespec *ts) 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_ctor_component **comp_head, 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_symbol *sym, gfc_expr **result, && 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_symbol *sym, gfc_expr **result, 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 equiv_flag, int host_flag) 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; } diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index bc71af185df..9baef621eac 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -103,16 +103,16 @@ is_sym_host_assoc (gfc_symbol *sym, gfc_namespace *ns) 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 *sym, gfc_namespace *ns) 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= 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, bool named_common) 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; } @@ -2191,9 +2191,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; } @@ -2224,9 +2224,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) @@ -2376,12 +2376,12 @@ gfc_iso_c_func_interface (gfc_symbol *sym, gfc_actual_arglist *args, 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) { @@ -2536,8 +2536,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) @@ -2687,7 +2687,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 @@ -3396,7 +3396,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: @@ -3924,7 +3924,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; @@ -3933,7 +3933,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; } @@ -4116,10 +4116,10 @@ gfc_resolve_substring_charlen (gfc_expr *e) 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; @@ -4128,8 +4128,8 @@ gfc_resolve_substring_charlen (gfc_expr *e) 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); @@ -4139,7 +4139,7 @@ gfc_resolve_substring_charlen (gfc_expr *e) 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; @@ -4147,15 +4147,15 @@ gfc_resolve_substring_charlen (gfc_expr *e) 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); } @@ -4447,7 +4447,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) @@ -4592,26 +4592,26 @@ gfc_resolve_character_operator (gfc_expr *e) 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; } @@ -4636,12 +4636,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; } @@ -4817,10 +4817,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; } @@ -5111,7 +5111,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); @@ -5171,7 +5171,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; @@ -5414,7 +5414,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; } @@ -6344,21 +6344,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); @@ -6925,7 +6925,7 @@ resolve_ordinary_assign (gfc_code *code, gfc_namespace *ns) 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); @@ -6974,18 +6974,18 @@ resolve_ordinary_assign (gfc_code *code, gfc_namespace *ns) 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 " @@ -7022,7 +7022,7 @@ resolve_ordinary_assign (gfc_code *code, gfc_namespace *ns) 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 " @@ -7716,7 +7716,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) @@ -7861,10 +7861,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++) @@ -7977,17 +7977,17 @@ resolve_fl_variable_derived (gfc_symbol *sym, int no_init_flag) 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; } @@ -8005,7 +8005,7 @@ resolve_fl_variable_derived (gfc_symbol *sym, int no_init_flag) && 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", @@ -8016,10 +8016,10 @@ resolve_fl_variable_derived (gfc_symbol *sym, int no_init_flag) if (sym->ts.is_class) { /* C502. */ - if (!type_is_extensible (sym->ts.derived)) + if (!type_is_extensible (sym->ts.u.derived)) { gfc_error ("Type '%s' of CLASS variable '%s' at %L is not extensible", - sym->ts.derived->name, sym->name, &sym->declared_at); + sym->ts.u.derived->name, sym->name, &sym->declared_at); return FAILURE; } @@ -8083,7 +8083,7 @@ resolve_fl_variable (gfc_symbol *sym, int mp_flag) { /* 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 " @@ -8189,7 +8189,7 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag) 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) @@ -8229,9 +8229,9 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag) { 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", @@ -8239,7 +8239,7 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag) == 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; } } @@ -8252,9 +8252,9 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag) { 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 " @@ -8263,7 +8263,7 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag) 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; } } @@ -8277,9 +8277,9 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag) { 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 " @@ -8288,7 +8288,7 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag) 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; } } @@ -8330,7 +8330,7 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag) 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)) @@ -8499,7 +8499,7 @@ gfc_resolve_finalizers (gfc_symbol* derived) 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); @@ -9181,7 +9181,7 @@ resolve_typebound_procedure (gfc_symtree* stree) /* 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, @@ -9450,12 +9450,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') @@ -9524,7 +9524,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, @@ -9585,14 +9585,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; } } @@ -9600,10 +9600,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, @@ -9612,18 +9612,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, @@ -9644,11 +9644,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) @@ -9716,7 +9716,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", @@ -9726,8 +9726,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)) { @@ -9762,7 +9762,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", @@ -9770,7 +9770,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", @@ -9954,12 +9954,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') @@ -10059,7 +10059,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 " @@ -10111,14 +10111,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; } @@ -10147,12 +10147,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; } @@ -10161,23 +10161,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++; } } @@ -10187,15 +10187,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 @@ -10206,7 +10206,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) { @@ -10810,11 +10810,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; @@ -10862,7 +10862,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) @@ -10886,7 +10885,7 @@ resolve_equivalence_derived (gfc_symbol *derived, gfc_symbol *sym, gfc_expr *e) 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 " @@ -10896,9 +10895,8 @@ resolve_equivalence_derived (gfc_symbol *derived, gfc_symbol *sym, gfc_expr *e) 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 @@ -10932,7 +10930,6 @@ static void resolve_equivalence (gfc_equiv *eq) { gfc_symbol *sym; - gfc_symbol *derived; gfc_symbol *first_sym; gfc_expr *e; gfc_ref *r; @@ -10996,11 +10993,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); @@ -11051,8 +11048,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: @@ -11185,15 +11182,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) @@ -11227,9 +11224,9 @@ check_uop_procedure (gfc_symbol *sym, locus where) } 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, &where); diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c index fa8a32a2431..fbb88a411af 100644 --- a/gcc/fortran/simplify.c +++ b/gcc/fortran/simplify.c @@ -3217,12 +3217,12 @@ gfc_simplify_len (gfc_expr *e, gfc_expr *kind) } } - 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_expr *mask, gfc_expr *vector) 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_expr *n) } /* 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_expr *n) 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_expr *n) 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, gfc_expr *dim_expr, gfc_expr *ncopies_exp 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, gfc_expr *mask, gfc_expr *field) 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, bt type ATTRIBUTE_UNUSED, int kind) 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; } diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c index 27f378c1b18..dc10bc69e48 100644 --- a/gcc/fortran/symbol.c +++ b/gcc/fortran/symbol.c @@ -269,10 +269,10 @@ gfc_set_default_type (gfc_symbol *sym, int error_flag, gfc_namespace *ns) 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) @@ -1774,10 +1774,10 @@ gfc_add_component (gfc_symbol *sym, const char *name, } 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; } @@ -1810,8 +1810,8 @@ switch_types (gfc_symtree *st, gfc_symbol *from, gfc_symbol *to) 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); @@ -1863,8 +1863,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); @@ -1917,7 +1917,7 @@ gfc_find_component (gfc_symbol *sym, const char *name, && 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) @@ -3263,8 +3263,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; } @@ -3481,14 +3481,14 @@ verify_bind_c_derived_type (gfc_symbol *derived_sym) /* 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 { @@ -3587,10 +3587,10 @@ gen_special_c_interop_ptr (int ptr_id, const char *ptr_name, /* 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 @@ -3603,7 +3603,7 @@ gen_special_c_interop_ptr (int ptr_id, const char *ptr_name, ? "_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); } @@ -3624,7 +3624,7 @@ gen_special_c_interop_ptr (int ptr_id, const char *ptr_name, 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). */ @@ -3728,7 +3728,7 @@ gen_cptr_param (gfc_formal_arglist **head, 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. */ @@ -3956,7 +3956,7 @@ gfc_copy_formal_args_intr (gfc_symbol *dest, gfc_intrinsic_sym *src) 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 @@ -4219,8 +4219,8 @@ generate_isocbinding_symbol (const char *mod_name, iso_c_binding_symbol s, 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. */ @@ -4264,7 +4264,7 @@ generate_isocbinding_symbol (const char *mod_name, iso_c_binding_symbol s, 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); @@ -4349,13 +4349,13 @@ generate_isocbinding_symbol (const char *mod_name, iso_c_binding_symbol s, 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. */ @@ -4365,7 +4365,7 @@ generate_isocbinding_symbol (const char *mod_name, iso_c_binding_symbol s, (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); @@ -4517,9 +4517,9 @@ gfc_get_derived_super_type (gfc_symbol* derived) 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; } diff --git a/gcc/fortran/target-memory.c b/gcc/fortran/target-memory.c index 4fe41d58ffb..e19a7d34e0a 100644 --- a/gcc/fortran/target-memory.c +++ b/gcc/fortran/target-memory.c @@ -229,7 +229,7 @@ encode_derived (gfc_expr *source, unsigned char *buffer, size_t buffer_size) 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 *buffer, size_t buffer_size, { 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 *buffer, size_t buffer_size, gfc_expr *resu 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 *data, unsigned char *chk, size_t len) 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); diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index c625bc4bf60..529a6b10495 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -1533,7 +1533,7 @@ get_array_ctor_var_strlen (gfc_expr * expr, tree * len) } } - *len = ts->cl->backend_decl; + *len = ts->u.cl->backend_decl; } @@ -1549,12 +1549,12 @@ get_array_ctor_all_strlen (stmtblock_t *block, gfc_expr *e, tree *len) 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 *block, gfc_expr *e, tree *len) 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_loopinfo * loop, gfc_ss * ss, locus * where) /* 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_loopinfo * loop, gfc_ss * ss, locus * where) /* 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_loopinfo * loop, gfc_ss * ss, locus * where) 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 * loop, gfc_ss * ss, bool subscript, 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_expr * expr, tree pstat) 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 decl, gfc_symbol * sym, tree fnbody) /* 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 decl, gfc_symbol * sym, tree fnbody) 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, tree body) 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 * sym, tree tmpdesc, tree body) 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_se *se) 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_se *se) 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_se *se) /* 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_se *se) 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, gfc_expr * expr, gfc_ss * ss) /* 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, gfc_expr * expr, gfc_ss * ss) 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, gfc_expr * expr, gfc_ss * ss, int g77, 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, gfc_expr * expr, gfc_ss * ss, int g77, 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, gfc_expr * expr, gfc_ss * ss, int g77, /* 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_type, tree decl, 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_type, tree decl, 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_type, tree decl, 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_type, tree decl, 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 * sym, tree body) 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 * sym, tree body) || 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 * sym, tree body) 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 * sym, tree body) { 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); } diff --git a/gcc/fortran/trans-common.c b/gcc/fortran/trans-common.c index ca94567d633..5b1952aee4a 100644 --- a/gcc/fortran/trans-common.c +++ b/gcc/fortran/trans-common.c @@ -132,7 +132,7 @@ get_segment_info (gfc_symbol * sym, HOST_WIDE_INT offset) /* 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; diff --git a/gcc/fortran/trans-const.c b/gcc/fortran/trans-const.c index 4b7b2c027ee..035f40b125c 100644 --- a/gcc/fortran/trans-const.c +++ b/gcc/fortran/trans-const.c @@ -342,8 +342,8 @@ gfc_conv_constant (gfc_se * se, gfc_expr * 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) diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 70b78ed9705..ceabbbe0b98 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -796,7 +796,7 @@ gfc_build_dummy_array_decl (gfc_symbol * sym, tree dummy) /* 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_symbol *sym) 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 * sym) 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 * sym) 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 * sym) 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 * sym) 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 * sym) 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 * sym, int parent_flag) 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_symbol * sym, tree fnbody) 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_sym, tree body) && !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_sym, tree body) 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 * proc_sym, tree fnbody) /* 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 * proc_sym, tree fnbody) 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 * proc_sym, tree fnbody) 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 * proc_sym, tree fnbody) { 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 * proc_sym, tree fnbody) 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 * sym) { 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 *expr, gfc_typespec *ts, bool array, 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_symbol *sym) 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_symbol *sym) 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 *block, gfc_symbol *sym) 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_namespace * ns) 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_namespace * ns) 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); } diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index a6e129b1406..51593e7ae19 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -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_expr* e) 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_ref * ref) 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 * se, gfc_ref * ref) /* 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 * 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_expr * expr) 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_mapping * mapping, 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_mapping * mapping, 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_interface_mapping * mapping, 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_interface_mapping * mapping, 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 *expr, gfc_interface_mapping *mapping) 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 *expr, gfc_expr *map_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_interface_mapping * mapping, 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 * parmse, gfc_expr * expr, 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 * parmse, gfc_expr * expr, 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 * parmse, gfc_expr * expr, 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 * parmse, gfc_expr * expr, /* 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, gfc_symbol * sym, } 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, gfc_symbol * sym, 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)); @@ -2753,11 +2753,11 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, && 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; } } @@ -2771,7 +2771,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, 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)) { @@ -2798,11 +2798,11 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, { 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); } @@ -2912,7 +2912,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, 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 @@ -2927,7 +2927,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, 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 @@ -2937,9 +2937,9 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, /* 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); @@ -2952,7 +2952,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, /* Set up a charlen structure for it. */ cl.next = NULL; cl.length = NULL; - ts.cl = &cl; + ts.u.cl = &cl; len = cl.backend_decl; } @@ -3025,7 +3025,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, 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 @@ -3419,8 +3419,8 @@ gfc_conv_statement_function (gfc_se * se, gfc_expr * expr) /* 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), @@ -3457,22 +3457,22 @@ gfc_conv_statement_function (gfc_se * se, gfc_expr * expr) 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. */ @@ -3559,9 +3559,9 @@ gfc_conv_initializer (gfc_expr * expr, gfc_typespec * ts, tree type, 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); @@ -3591,7 +3591,7 @@ gfc_conv_initializer (gfc_expr * expr, gfc_typespec * ts, tree type, 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); @@ -3679,7 +3679,7 @@ gfc_trans_subarray_assign (tree dest, gfc_component * cm, gfc_expr * expr) 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); @@ -3766,8 +3766,8 @@ gfc_trans_subcomponent_assign (tree dest, gfc_component * cm, gfc_expr * expr) 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, @@ -3872,7 +3872,7 @@ gfc_trans_subcomponent_assign (tree dest, gfc_component * cm, gfc_expr * expr) 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); @@ -3892,7 +3892,7 @@ gfc_trans_structure_assign (tree dest, gfc_expr * expr) 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. */ @@ -3928,13 +3928,13 @@ gfc_conv_structure (gfc_se * se, gfc_expr * expr, int init) 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) { @@ -4004,8 +4004,8 @@ gfc_conv_expr (gfc_se * se, gfc_expr * expr) 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) @@ -4018,9 +4018,9 @@ gfc_conv_expr (gfc_se * se, gfc_expr * expr) { /* 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; } } @@ -4389,7 +4389,7 @@ gfc_trans_scalar_assign (gfc_se * lse, gfc_se * rse, gfc_typespec ts, 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; @@ -4409,7 +4409,7 @@ gfc_trans_scalar_assign (gfc_se * lse, gfc_se * rse, gfc_typespec ts, 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); @@ -4426,7 +4426,7 @@ gfc_trans_scalar_assign (gfc_se * lse, gfc_se * rse, gfc_typespec ts, 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); @@ -4504,16 +4504,16 @@ gfc_trans_arrayfunc_assign (gfc_expr * expr1, gfc_expr * expr2) 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; } @@ -4887,13 +4887,13 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag) 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); } @@ -4983,7 +4983,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; diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index 779343224fd..3b2cbd11428 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -3479,7 +3479,7 @@ gfc_conv_intrinsic_len (gfc_se * se, gfc_expr * expr) && (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_expr *expr) 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, gfc_expr * expr) 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: diff --git a/gcc/fortran/trans-io.c b/gcc/fortran/trans-io.c index 35f87bc3e56..0f6e0a5a40a 100644 --- a/gcc/fortran/trans-io.c +++ b/gcc/fortran/trans-io.c @@ -1591,7 +1591,7 @@ transfer_namelist_element (stmtblock_t * block, const char * var_name, 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 * block, const char * var_name, 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,9 @@ transfer_expr (gfc_se * se, gfc_typespec * ts, tree addr_expr, gfc_code * code) 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->type == BT_INTEGER) + && ts->u.derived != NULL + && (ts->is_iso_c == 1 || 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 +2015,14 @@ transfer_expr (gfc_se * se, gfc_typespec * ts, tree addr_expr, gfc_code * code) 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 +2094,7 @@ transfer_expr (gfc_se * se, gfc_typespec * ts, tree addr_expr, gfc_code * code) 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); diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index 6a1fb01cc60..935943727ab 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -1830,7 +1830,7 @@ check_forall_dependencies (gfc_code *c, stmtblock_t *pre, stmtblock_t *post) 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 * expr1, gfc_expr * expr2, &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); } diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c index 4b198717ffc..8cc63c26037 100644 --- a/gcc/fortran/trans-types.c +++ b/gcc/fortran/trans-types.c @@ -1000,8 +1000,8 @@ gfc_typenode_for_spec (gfc_typespec * spec) 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 * spec) 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 * spec) 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, gfc_symbol *to, 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 * derived) 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 * derived) 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); @@ -2261,7 +2261,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)) @@ -2286,7 +2286,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) {