From 7e3b6543e0a188283f2307019e835eeb77cdf795 Mon Sep 17 00:00:00 2001 From: Thomas Koenig Date: Sun, 27 Mar 2011 17:40:26 +0000 Subject: [PATCH] re PR fortran/47065 (Replace trim(a) by a(1:len_trim(a))) 2011-03-27 Thomas Koenig PR fortran/47065 * frontend-passes (optimize_trim): Also follow references, except when they are substring references or array references. 2011-03-27 Thomas Koenig PR fortran/47065 * gfortran.dg/trim_optimize_5.f90: New test. * gfortran.dg/trim_optimize_6.f90: New test. From-SVN: r171575 --- gcc/fortran/ChangeLog | 6 ++ gcc/fortran/frontend-passes.c | 67 +++++++++++-------- gcc/testsuite/ChangeLog | 6 ++ gcc/testsuite/gfortran.dg/trim_optimize_5.f90 | 21 ++++++ gcc/testsuite/gfortran.dg/trim_optimize_6.f90 | 25 +++++++ 5 files changed, 96 insertions(+), 29 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/trim_optimize_5.f90 create mode 100644 gcc/testsuite/gfortran.dg/trim_optimize_6.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index e266fc3db72..95d9b78a0bd 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2011-03-27 Thomas Koenig + + PR fortran/47065 + * frontend-passes (optimize_trim): Also follow references, except + when they are substring references or array references. + 2011-03-27 Tobias Burnus PR fortran/18918 diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c index e26ae68a5a9..2051b0c566d 100644 --- a/gcc/fortran/frontend-passes.c +++ b/gcc/fortran/frontend-passes.c @@ -664,6 +664,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. */ @@ -681,46 +682,54 @@ optimize_trim (gfc_expr *e) 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) \ diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 8fdef5218ef..3cc61b079d5 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2011-03-27 Thomas Koenig + + PR fortran/47065 + * gfortran.dg/trim_optimize_5.f90: New test. + * gfortran.dg/trim_optimize_6.f90: New test. + 2011-03-27 Richard Sandiford PR target/38598 diff --git a/gcc/testsuite/gfortran.dg/trim_optimize_5.f90 b/gcc/testsuite/gfortran.dg/trim_optimize_5.f90 new file mode 100644 index 00000000000..70a85d601d4 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/trim_optimize_5.f90 @@ -0,0 +1,21 @@ +! { 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" } } diff --git a/gcc/testsuite/gfortran.dg/trim_optimize_6.f90 b/gcc/testsuite/gfortran.dg/trim_optimize_6.f90 new file mode 100644 index 00000000000..2303bb4ef78 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/trim_optimize_6.f90 @@ -0,0 +1,25 @@ +! { 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 -- 2.30.2