2011-03-27 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-27  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.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@171575 138bc75d-0d04-0410-961f-82ee72b054a4

5 files changed, 96 insertions, 29 deletions

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  <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-27  Tobias Burnus  <burnus@net-b.de>
 
 	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  <tkoenig@gcc.gnu.org>
+
+	PR fortran/47065
+	* gfortran.dg/trim_optimize_5.f90:  New test.
+	* gfortran.dg/trim_optimize_6.f90:  New test.
+
 2011-03-27  Richard Sandiford  <rdsandiford@googlemail.com>
 
 	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