diff options
Diffstat (limited to 'gcc/fortran/trans-array.c')
| -rw-r--r-- | gcc/fortran/trans-array.c | 102 |
1 files changed, 52 insertions, 50 deletions
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 4dc69d2..83f0189 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -1495,11 +1495,55 @@ gfc_trans_array_constructor_value (stmtblock_t * pblock, tree type, } +/* A catch-all to obtain the string length for anything that is not a + a substring of non-constant length, a constant, array or variable. */ + +static void +get_array_ctor_all_strlen (stmtblock_t *block, gfc_expr *e, tree *len) +{ + gfc_se se; + gfc_ss *ss; + + /* Don't bother if we already know the length is a constant. */ + if (*len && INTEGER_CST_P (*len)) + return; + + 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.u.cl); + *len = e->ts.u.cl->backend_decl; + } + else + { + /* Otherwise, be brutal even if inefficient. */ + ss = gfc_walk_expr (e); + gfc_init_se (&se, NULL); + + /* No function call, in case of side effects. */ + se.no_function_call = 1; + if (ss == gfc_ss_terminator) + gfc_conv_expr (&se, e); + else + gfc_conv_expr_descriptor (&se, e, ss); + + /* Fix the value. */ + *len = gfc_evaluate_now (se.string_length, &se.pre); + + gfc_add_block_to_block (block, &se.pre); + gfc_add_block_to_block (block, &se.post); + + e->ts.u.cl->backend_decl = *len; + } +} + + /* Figure out the string length of a variable reference expression. Used by get_array_ctor_strlen. */ static void -get_array_ctor_var_strlen (gfc_expr * expr, tree * len) +get_array_ctor_var_strlen (stmtblock_t *block, gfc_expr * expr, tree * len) { gfc_ref *ref; gfc_typespec *ts; @@ -1526,7 +1570,11 @@ get_array_ctor_var_strlen (gfc_expr * expr, tree * len) case REF_SUBSTRING: if (ref->u.ss.start->expr_type != EXPR_CONSTANT || ref->u.ss.end->expr_type != EXPR_CONSTANT) - break; + { + /* Note that this might evaluate expr. */ + get_array_ctor_all_strlen (block, expr, len); + return; + } mpz_init_set_ui (char_len, 1); mpz_add (char_len, char_len, ref->u.ss.end->value.integer); mpz_sub (char_len, char_len, ref->u.ss.start->value.integer); @@ -1536,10 +1584,7 @@ get_array_ctor_var_strlen (gfc_expr * expr, tree * len) return; default: - /* TODO: Substrings are tricky because we can't evaluate the - expression more than once. For now we just give up, and hope - we can figure it out elsewhere. */ - return; + gcc_unreachable (); } } @@ -1547,49 +1592,6 @@ get_array_ctor_var_strlen (gfc_expr * expr, tree * len) } -/* A catch-all to obtain the string length for anything that is not a - constant, array or variable. */ -static void -get_array_ctor_all_strlen (stmtblock_t *block, gfc_expr *e, tree *len) -{ - gfc_se se; - gfc_ss *ss; - - /* Don't bother if we already know the length is a constant. */ - if (*len && INTEGER_CST_P (*len)) - return; - - 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.u.cl); - *len = e->ts.u.cl->backend_decl; - } - else - { - /* Otherwise, be brutal even if inefficient. */ - ss = gfc_walk_expr (e); - gfc_init_se (&se, NULL); - - /* No function call, in case of side effects. */ - se.no_function_call = 1; - if (ss == gfc_ss_terminator) - gfc_conv_expr (&se, e); - else - gfc_conv_expr_descriptor (&se, e, ss); - - /* Fix the value. */ - *len = gfc_evaluate_now (se.string_length, &se.pre); - - gfc_add_block_to_block (block, &se.pre); - gfc_add_block_to_block (block, &se.post); - - e->ts.u.cl->backend_decl = *len; - } -} - - /* Figure out the string length of a character array constructor. If len is NULL, don't calculate the length; this happens for recursive calls when a sub-array-constructor is an element but not at the first position, @@ -1633,7 +1635,7 @@ get_array_ctor_strlen (stmtblock_t *block, gfc_constructor_base base, tree * len case EXPR_VARIABLE: is_const = false; if (len) - get_array_ctor_var_strlen (c->expr, len); + get_array_ctor_var_strlen (block, c->expr, len); break; default: |