===================================================================
@@ -428,6 +428,27 @@ optimize_comparison (gfc_expr *e, gfc_intrinsic_op
return false;
}
+/* Callback for gfc_expr_walker to check for the presence of
+ an impure function in an expression. */
+
+static int
+check_impure_function (gfc_expr **e, int *walk_subtrees ATTRIBUTE_UNUSED,
+ void *data ATTRIBUTE_UNUSED)
+{
+ if ((*e)->expr_type == EXPR_FUNCTION)
+ {
+ if ((*e)->value.function.esym
+ && !(*e)->value.function.esym->result->attr.pure)
+ return 1;
+
+ if ((*e)->value.function.isym
+ && !(*e)->value.function.isym->pure)
+ return 1;
+ }
+
+ return 0;
+}
+
/* Optimize a trim function by replacing it with an equivalent substring
involving a call to len_trim. This only works for expressions where
variables are trimmed. Return true if anything was modified. */
@@ -439,6 +460,7 @@ optimize_trim (gfc_expr *e)
gfc_ref *ref;
gfc_expr *fcn;
gfc_actual_arglist *actual_arglist, *next;
+ gfc_ref **rr = NULL;
/* Don't do this optimization within an argument list, because
otherwise aliasing issues may occur. */
@@ -456,46 +478,58 @@ optimize_trim (gfc_expr *e)
if (a->expr_type != EXPR_VARIABLE)
return false;
+ /* Don't do this optimization if might involve calling an impure
+ function. FIXME: Make it into a temporary variable later. */
+
+ if (gfc_expr_walker (&e, check_impure_function, NULL))
+ return false;
+
+ /* Follow all references to find the correct place to put the newly
+ created reference. FIXME: Also handle substring references. */
+
if (a->ref)
{
- /* FIXME - also handle substring references, by modifying the
- reference itself. Make sure not to evaluate functions in
- the references twice. */
- return false;
+ for (rr = &(a->ref); *rr; rr = &((*rr)->next))
+ {
+ if ((*rr)->type == REF_SUBSTRING)
+ return false;
+ }
}
- else
- {
- strip_function_call (e);
- /* Create the reference. */
+ strip_function_call (e);
- ref = gfc_get_ref ();
- ref->type = REF_SUBSTRING;
+ if (e->ref == NULL)
+ rr = &(e->ref);
- /* Set the start of the reference. */
+ /* Create the reference. */
- ref->u.ss.start = gfc_get_int_expr (gfc_default_integer_kind, NULL, 1);
+ ref = gfc_get_ref ();
+ ref->type = REF_SUBSTRING;
- /* Build the function call to len_trim(x, gfc_defaul_integer_kind). */
+ /* Set the start of the reference. */
- fcn = gfc_get_expr ();
- fcn->expr_type = EXPR_FUNCTION;
- fcn->value.function.isym =
- gfc_intrinsic_function_by_id (GFC_ISYM_LEN_TRIM);
- actual_arglist = gfc_get_actual_arglist ();
- actual_arglist->expr = gfc_copy_expr (e);
- next = gfc_get_actual_arglist ();
- next->expr = gfc_get_int_expr (gfc_default_integer_kind, NULL,
- gfc_default_integer_kind);
- actual_arglist->next = next;
- fcn->value.function.actual = actual_arglist;
+ ref->u.ss.start = gfc_get_int_expr (gfc_default_integer_kind, NULL, 1);
- /* Set the end of the reference to the call to len_trim. */
+ /* Build the function call to len_trim(x, gfc_defaul_integer_kind). */
- ref->u.ss.end = fcn;
- e->ref = ref;
- return true;
- }
+ fcn = gfc_get_expr ();
+ fcn->expr_type = EXPR_FUNCTION;
+ fcn->value.function.isym =
+ gfc_intrinsic_function_by_id (GFC_ISYM_LEN_TRIM);
+ actual_arglist = gfc_get_actual_arglist ();
+ actual_arglist->expr = gfc_copy_expr (e);
+ next = gfc_get_actual_arglist ();
+ next->expr = gfc_get_int_expr (gfc_default_integer_kind, NULL,
+ gfc_default_integer_kind);
+ actual_arglist->next = next;
+ fcn->value.function.actual = actual_arglist;
+
+ /* Set the end of the reference to the call to len_trim. */
+
+ ref->u.ss.end = fcn;
+ gcc_assert (*rr == NULL);
+ *rr = ref;
+ return true;
}
#define WALK_SUBEXPR(NODE) \