aboutsummaryrefslogtreecommitdiff
path: root/gcc/fortran/trans-array.c
diff options
context:
space:
mode:
Diffstat (limited to 'gcc/fortran/trans-array.c')
-rw-r--r--gcc/fortran/trans-array.c64
1 files changed, 60 insertions, 4 deletions
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 17a63d2..2ebb365 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -1225,10 +1225,21 @@ gfc_trans_array_constructor_value (stmtblock_t * pblock, tree type,
loopbody = gfc_finish_block (&body);
- gfc_init_se (&se, NULL);
- gfc_conv_expr (&se, c->iterator->var);
- gfc_add_block_to_block (pblock, &se.pre);
- loopvar = se.expr;
+ if (c->iterator->var->symtree->n.sym->backend_decl)
+ {
+ gfc_init_se (&se, NULL);
+ gfc_conv_expr (&se, c->iterator->var);
+ gfc_add_block_to_block (pblock, &se.pre);
+ loopvar = se.expr;
+ }
+ else
+ {
+ /* If the iterator appears in a specification expression in
+ an interface mapping, we need to make a temp for the loop
+ variable because it is not declared locally. */
+ loopvar = gfc_typenode_for_spec (&c->iterator->var->ts);
+ loopvar = gfc_create_var (loopvar, "loopvar");
+ }
/* Make a temporary, store the current value in that
and return it, once the loop is done. */
@@ -4491,6 +4502,47 @@ gfc_get_dataptr_offset (stmtblock_t *block, tree parm, tree desc, tree offset,
}
+/* gfc_conv_expr_descriptor needs the character length of elemental
+ functions before the function is called so that the size of the
+ temporary can be obtained. The only way to do this is to convert
+ the expression, mapping onto the actual arguments. */
+static void
+get_elemental_fcn_charlen (gfc_expr *expr, gfc_se *se)
+{
+ gfc_interface_mapping mapping;
+ gfc_formal_arglist *formal;
+ gfc_actual_arglist *arg;
+ gfc_se tse;
+
+ formal = expr->symtree->n.sym->formal;
+ arg = expr->value.function.actual;
+ gfc_init_interface_mapping (&mapping);
+
+ /* Set se = NULL in the calls to the interface mapping, to supress any
+ backend stuff. */
+ for (; arg != NULL; arg = arg->next, formal = formal ? formal->next : NULL)
+ {
+ if (!arg->expr)
+ continue;
+ if (formal->sym)
+ gfc_add_interface_mapping (&mapping, formal->sym, NULL, arg->expr);
+ }
+
+ 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_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;
+ gfc_free_interface_mapping (&mapping);
+}
+
+
/* Convert an array for passing as an actual argument. Expressions and
vector subscripts are evaluated and stored in a temporary, which is then
passed. For whole arrays the descriptor is passed. For array sections
@@ -4624,6 +4676,10 @@ 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)
+ get_elemental_fcn_charlen (expr, se);
+
info = NULL;
}
else