===================================================================
@@ -664,6 +664,7 @@
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. */
@@ -681,46 +682,54 @@
if (a->expr_type != EXPR_VARIABLE)
return false;
+ /* Follow all references to find the correct place to put the newly
+ created reference. FIXME: Also handle substring references and
+ array references. Array references cause strange regressions at
+ the moment. */
+
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 || (*rr)->type == REF_ARRAY)
+ 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 following patch extends the trim optimization to variables like trim(a%x). Going for trim(a(1)) led to a very strange regression, so I took that out (for now). Regression-tested. OK for trunk? Thomas 2011-03-26 Thomas Koenig <tkoenig@gcc.gnu.org> PR fortran/47065 * frontend-passes (optimize_trim): Also follow references, except when they are substring references or array references. 2011-03-26 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. program main use foo implicit none type t character(len=2) :: x end type t type(t) :: a character(len=3) :: b character(len=10) :: line a%x = 'a' write(unit=line,fmt='(A,A)') trim(a%x),"X" if (line /= 'aX ') call abort b = 'ab' write (unit=line,fmt='(A,A)') trim(b),"Y" if (line /= 'abY ') call abort end program main ! { dg-final { scan-tree-dump-times "string_len_trim" 2 "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