===================================================================
@@ -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) \
Hello world, the attached patch does the trim optimizations when there are references, except substring references. This was made possible by Paul's fix to PR 47348. Regression-tested. OK for trunk? Or should I rather wait until 4.6 is released? 2011-02-20 Thomas Koenig <tkoenig@gcc.gnu.org> PR fortran/47065 * frontend-passes (check_impure_function): New function. * optimize_trim: Also follow references, except when they are substring references. Don't replace calls to trim with substrings if the substring indices contain impure functions. 2011-02-20 Thomas Koenig <tkoenig@gcc.gnu.org> PR fortran/47065 * gfortran.dg/trim_optimize_5.f90: New test. * gfortran.dg/trim_optimize_6.f90: New test. ! { dg-do run } ! { dg-options "-O -fdump-tree-original" } ! PR 47065 - replace trim with substring expressions even with references. module foo implicit none contains pure function f() integer :: f f = 2 end function f end module foo program main use foo implicit none type t character(len=2) :: x end type t type(t) :: a character(len=3) :: b(4) character(len=10) :: line a%x = 'a' write(unit=line,fmt='(A,A)') trim(a%x),"X" if (line /= 'aX ') call abort b(1) = 'ab' write(unit=line,fmt='(A,A)') trim(b(1)),"X" if (line /= 'abX ') call abort b(2) = 'cd' write(unit=line,fmt='(A,A)') trim(b(f())),"X" if (line /= 'cdX ') call abort end program main ! { dg-final { scan-tree-dump-times "string_len_trim" 3 "original" } } ! { dg-final { cleanup-tree-dump "original" } ! { dg-do run } ! PR 47065 - make sure that impure functions are not evaluated twice when ! replacing calls to trim with expression(1:len_trim) module foo implicit none contains function f() integer :: f integer :: s=0 s = s + 1 f = s end function f end module foo program main use foo implicit none character(len=10) :: line character(len=4) :: b(2) b(1) = 'a' b(2) = 'bc' write(unit=line,fmt='(A,A)') trim(b(f())), "X" if (line /= "aX ") call abort if (f() .ne. 2) call abort end program main