+2018-07-02 Paul Thomas <pault@gcc.gnu.org>
+
+ PR fortran/45305
+ * expr.c : Add a prototype for scalarize_intrinsic_call.
+ (gfc_simplify_expr): Use scalarize_intrinsic_call for elemental
+ intrinsic function calls.
+ (scalarize_intrinsic_call): Add 'init_flag' argument. Check if
+ the expression or any of the actual argument expressions are
+ NULL. Before calling gfc_check_init_expr, check 'init_flag'.
+ Only simplify the scalarized expressions if there are no errors
+ on the stack.
+ (gfc_check_init_expr): Set 'init_flag' true in the call to
+ scalarize_intrinsic_call.
+
2018-06-28 Fritz Reese <fritzoreese@gmail.com>
PR fortran/82865
return t;
}
+
+static bool
+scalarize_intrinsic_call (gfc_expr *, bool init_flag);
+
/* Given an expression, simplify it by collapsing constant
expressions. Most simplification takes place when the expression
tree is being constructed. If an intrinsic function is simplified
gfc_simplify_expr (gfc_expr *p, int type)
{
gfc_actual_arglist *ap;
+ gfc_intrinsic_sym* isym = NULL;
+
if (p == NULL)
return true;
&& gfc_intrinsic_func_interface (p, 1) == MATCH_ERROR)
return false;
+ if (p->expr_type == EXPR_FUNCTION)
+ {
+ if (p->symtree)
+ isym = gfc_find_function (p->symtree->n.sym->name);
+ if (isym && isym->elemental)
+ scalarize_intrinsic_call (p, false);
+ }
+
break;
case EXPR_SUBSTRING:
/* Scalarize an expression for an elemental intrinsic call. */
static bool
-scalarize_intrinsic_call (gfc_expr *e)
+scalarize_intrinsic_call (gfc_expr *e, bool init_flag)
{
gfc_actual_arglist *a, *b;
gfc_constructor_base ctor;
gfc_constructor *ci, *new_ctor;
gfc_expr *expr, *old;
int n, i, rank[5], array_arg;
+ int errors = 0;
+
+ if (e == NULL)
+ return false;
+
+ a = e->value.function.actual;
+ for (; a; a = a->next)
+ if (a->expr && !gfc_is_constant_expr (a->expr))
+ return false;
/* Find which, if any, arguments are arrays. Assume that the old
expression carries the type information and that the first arg
for (; a; a = a->next)
{
/* Check that this is OK for an initialization expression. */
- if (a->expr && !gfc_check_init_expr (a->expr))
+ if (a->expr && init_flag && !gfc_check_init_expr (a->expr))
goto cleanup;
rank[n] = 0;
n++;
}
+ gfc_get_errors (NULL, &errors);
/* Using the array argument as the master, step through the array
calling the function for each element and advancing the array
/* Simplify the function calls. If the simplification fails, the
error will be flagged up down-stream or the library will deal
with it. */
- gfc_simplify_expr (new_ctor->expr, 0);
+ if (errors == 0)
+ gfc_simplify_expr (new_ctor->expr, 0);
for (i = 0; i < n; i++)
if (args[i])
array argument. */
isym = gfc_find_function (e->symtree->n.sym->name);
if (isym && isym->elemental
- && (t = scalarize_intrinsic_call (e)))
+ && (t = scalarize_intrinsic_call (e, true)))
break;
}
s = expr->symtree->n.sym;
if (s->ts.type != BT_CLASS)
return false;
-
+
rc = NULL;
for (r = expr->ref; r; r = r->next)
if (r->type == REF_COMPONENT)