re PR fortran/47065 (Replace trim(a) by a(1:len_trim(a)))

2010-12-31  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/47065
	* frontend-passes.c (count_arglist):  Static variable to
	count the nesting of argument lists.
	(optimize_code):  Set count_arglist to 1 if within a call
	statement, to 0 otherwise.
	(optimize_trim):  New function.
	(optimize_expr):  Adjust count_arglist.  Call optimize_trim.

2010-12-31  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/47065
	* gfortran.dg/trim_optimize_3.f90:  New test.
	* gfortran.dg/trim_optimize_4.f90:  New test.

From-SVN: r168367

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index c2103314bef44f0ba86869008c31c109fe82a725..e25d4e38124e8d20ffabe0c9b1756545c2bdc4f1 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,13 @@
+2010-12-31  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+       PR fortran/47065
+       * frontend-passes.c (count_arglist):  Static variable to
+       count the nesting of argument lists.
+       (optimize_code):  Set count_arglist to 1 if within a call
+       statement, to 0 otherwise.
+       (optimize_trim):  New function.
+       (optimize_expr):  Adjust count_arglist.  Call optimize_trim.
+
 2010-12-31  Thomas Koenig  <tkoenig@gcc.gnu.org>
 
        PR fortran/45338

diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c
index 339458e2d621f22fc1e54ee56ef742ca35b2ae07..0777dba6869c16448e52b6a1fb3280bf9f6e89db 100644 (file)
--- a/gcc/fortran/frontend-passes.c
+++ b/gcc/fortran/frontend-passes.c
@@ -34,6 +34,11 @@ static void optimize_namespace (gfc_namespace *);
 static void optimize_assignment (gfc_code *);
 static bool optimize_op (gfc_expr *);
 static bool optimize_comparison (gfc_expr *, gfc_intrinsic_op);
+static bool optimize_trim (gfc_expr *);
+
+/* How deep we are inside an argument list.  */
+
+static int count_arglist;
 
 /* Entry point - run all passes for a namespace.  So far, only an
    optimization pass is run.  */
@@ -56,7 +61,18 @@ static int
 optimize_code (gfc_code **c, int *walk_subtrees ATTRIBUTE_UNUSED,
               void *data ATTRIBUTE_UNUSED)
 {
-  if ((*c)->op == EXEC_ASSIGN)
+
+  gfc_exec_op op;
+
+  op = (*c)->op;
+
+  if (op == EXEC_CALL || op == EXEC_COMPCALL || op == EXEC_ASSIGN_CALL
+      || op == EXEC_CALL_PPC)
+    count_arglist = 1;
+  else
+    count_arglist = 0;
+
+  if (op == EXEC_ASSIGN)
     optimize_assignment (*c);
   return 0;
 }
@@ -68,8 +84,25 @@ static int
 optimize_expr (gfc_expr **e, int *walk_subtrees ATTRIBUTE_UNUSED,
               void *data ATTRIBUTE_UNUSED)
 {
+  bool function_expr;
+
+  if ((*e)->expr_type == EXPR_FUNCTION)
+    {
+      count_arglist ++;
+      function_expr = true;
+    }
+  else
+    function_expr = false;
+
+  if (optimize_trim (*e))
+    gfc_simplify_expr (*e, 0);
+
   if ((*e)->expr_type == EXPR_OP && optimize_op (*e))
     gfc_simplify_expr (*e, 0);
+
+  if (function_expr)
+    count_arglist --;
+
   return 0;
 }
 
@@ -395,6 +428,76 @@ optimize_comparison (gfc_expr *e, gfc_intrinsic_op op)
   return false;
 }
 
+/* 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.  */
+
+static bool
+optimize_trim (gfc_expr *e)
+{
+  gfc_expr *a;
+  gfc_ref *ref;
+  gfc_expr *fcn;
+  gfc_actual_arglist *actual_arglist, *next;
+
+  /* Don't do this optimization within an argument list, because
+     otherwise aliasing issues may occur.  */
+
+  if (count_arglist != 1)
+    return false;
+
+  if (e->ts.type != BT_CHARACTER || e->expr_type != EXPR_FUNCTION
+      || e->value.function.isym == NULL
+      || e->value.function.isym->id != GFC_ISYM_TRIM)
+    return false;
+
+  a = e->value.function.actual->expr;
+
+  if (a->expr_type != EXPR_VARIABLE)
+    return false;
+
+  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;
+    }
+  else
+    {
+      strip_function_call (e);
+
+      /* Create the reference.  */
+
+      ref = gfc_get_ref ();
+      ref->type = REF_SUBSTRING;
+
+      /* Set the start of the reference.  */
+
+      ref->u.ss.start = gfc_get_int_expr (gfc_default_integer_kind, NULL, 1);
+
+      /* Build the function call to len_trim(x, gfc_defaul_integer_kind).  */
+
+      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;
+      e->ref = ref;
+      return true;
+    }
+}
+
 #define WALK_SUBEXPR(NODE) \
   do                                                   \
     {                                                  \

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 4e4601de1bb91088ead40747bd64b87dcbb5578d..82959637820a056795e9b03d9f77b1d08e49ab0e 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2010-12-31  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+       PR fortran/47065
+       * gfortran.dg/trim_optimize_3.f90:  New test.
+       * gfortran.dg/trim_optimize_4.f90:  New test.
+
 2010-12-31  Thomas Koenig  <tkoenig@gcc.gnu.org>
 
        PR fortran/45338

diff --git a/gcc/testsuite/gfortran.dg/trim_optimize_3.f90 b/gcc/testsuite/gfortran.dg/trim_optimize_3.f90
new file mode 100644 (file)
index 0000000..33cf8b2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/trim_optimize_3.f90
@@ -0,0 +1,16 @@
+! { dg-do run }
+! { dg-options "-O -fdump-tree-original" }
+! PR 47065 - replace trim with substring expressions.
+program main
+  character(len=10) :: a, b
+  character(kind=4,len=10) :: a4, b4
+  character(len=100) :: line
+  a = 'bcd'
+  b = trim(a) // 'x'
+  if (b /= 'bcdx') call abort
+  a4 = 4_"bcd"
+  b4 = trim(a4) // 4_'x'
+  if (b4 /= 4_'bcdx') call abort
+end
+! { 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_4.f90 b/gcc/testsuite/gfortran.dg/trim_optimize_4.f90
new file mode 100644 (file)
index 0000000..41c65b1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/trim_optimize_4.f90
@@ -0,0 +1,25 @@
+! { dg-do run }
+! PR 47065 - make sure that trim optimization does not lead to
+! wrong-code with aliasing.
+! Test case provided by Tobias Burnus.
+program main
+  character(len=12) :: str
+  str = '1234567890'
+  call sub(trim(str), str)
+  ! Should print '12345       '
+  if (str /= '12345       ') call abort
+  call two(trim(str))
+  if (str /= '123         ') call abort
+contains
+  subroutine sub(a,b)
+    character(len=*), intent(in) :: a
+    character(len=*), intent(out) :: b
+    b = ''
+    b = a(1:5)
+  end subroutine sub
+  subroutine two(a)
+    character(len=*), intent(in) :: a
+    str = ''
+    str(1:3) = a(1:3)
+  end subroutine two
+end program main