frontend-passes.c (remove_trim): New function.

2011-06-13  Thomas Koenig  <tkoenig@gcc.gnu.org>

	* frontend-passes.c (remove_trim):  New function.
	(optimize_assignment):  Use it.
	(optimize_comparison):  Likewise.  Return correct status
	for previous change.

2011-06-13  Thomas Koenig  <tkoenig@gcc.gnu.org>

	* gfortran.dg/trim_optimize_8.f90:  New test case.

From-SVN: r174983

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index ad06808d1392af69294710a8df7a6650dbf19e88..af621be59e8f2029d04f641a6a236823617d8db3 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+2011-06-13  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+       * frontend-passes.c (remove_trim):  New function.
+       (optimize_assignment):  Use it.
+       (optimize_comparison):  Likewise.  Return correct status
+       for previous change.
+
 2011-06-12  Tobias Burnus
 
        PR fortran/49324

diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c
index d1cc22979b7903e14c07282d1c6697c68aa90acb..4d8c77a12694beb6d27190fcc50afeb083fcb819 100644 (file)
--- a/gcc/fortran/frontend-passes.c
+++ b/gcc/fortran/frontend-passes.c
@@ -486,6 +486,35 @@ optimize_binop_array_assignment (gfc_code *c, gfc_expr **rhs, bool seen_op)
   return false;
 }
 
+/* Remove unneeded TRIMs at the end of expressions.  */
+
+static bool
+remove_trim (gfc_expr *rhs)
+{
+  bool ret;
+
+  ret = false;
+
+  /* Check for a // b // trim(c).  Looping is probably not
+     necessary because the parser usually generates
+     (// (// a b ) trim(c) ) , but better safe than sorry.  */
+
+  while (rhs->expr_type == EXPR_OP
+        && rhs->value.op.op == INTRINSIC_CONCAT)
+    rhs = rhs->value.op.op2;
+
+  while (rhs->expr_type == EXPR_FUNCTION && rhs->value.function.isym
+        && rhs->value.function.isym->id == GFC_ISYM_TRIM)
+    {
+      strip_function_call (rhs);
+      /* Recursive call to catch silly stuff like trim ( a // trim(b)).  */
+      remove_trim (rhs);
+      ret = true;
+    }
+
+  return ret;
+}
+
 /* Optimizations for an assignment.  */
 
 static void
@@ -499,24 +528,7 @@ optimize_assignment (gfc_code * c)
   /* Optimize away a = trim(b), where a is a character variable.  */
 
   if (lhs->ts.type == BT_CHARACTER)
-    {
-      /* Check for a // b // trim(c).  Looping is probably not
-        necessary because the parser usually generates
-        (// (// a b ) trim(c) ) , but better safe than sorry.  */
-
-      while (rhs->expr_type == EXPR_OP
-            && rhs->value.op.op == INTRINSIC_CONCAT)
-       rhs = rhs->value.op.op2;
-
-      if (rhs->expr_type == EXPR_FUNCTION &&
-         rhs->value.function.isym &&
-         rhs->value.function.isym->id == GFC_ISYM_TRIM)
-       {
-         strip_function_call (rhs);
-         optimize_assignment (c);
-         return;
-       }
-    }
+    remove_trim (rhs);
 
   if (lhs->rank > 0 && gfc_check_dependency (lhs, rhs, true) == 0)
     optimize_binop_array_assignment (c, &rhs, false);
@@ -639,36 +651,17 @@ optimize_comparison (gfc_expr *e, gfc_intrinsic_op op)
 
   /* Strip off unneeded TRIM calls from string comparisons.  */
 
-  change = false;
-
-  if (op1->expr_type == EXPR_FUNCTION 
-      && op1->value.function.isym
-      && op1->value.function.isym->id == GFC_ISYM_TRIM)
-    {
-      strip_function_call (op1);
-      change = true;
-    }
-
-  if (op2->expr_type == EXPR_FUNCTION 
-      && op2->value.function.isym
-      && op2->value.function.isym->id == GFC_ISYM_TRIM)
-    {
-      strip_function_call (op2);
-      change = true;
-    }
+  change = remove_trim (op1);
 
-  if (change)
-    {
-      optimize_comparison (e, op);
-      return true;
-    }
+  if (remove_trim (op2))
+    change = true;
 
   /* An expression of type EXPR_CONSTANT is only valid for scalars.  */
   /* TODO: A scalar constant may be acceptable in some cases (the scalarizer
      handles them well). However, there are also cases that need a non-scalar
      argument. For example the any intrinsic. See PR 45380.  */
   if (e->rank > 0)
-    return false;
+    return change;
 
   /* Don't compare REAL or COMPLEX expressions when honoring NaNs.  */
 
@@ -698,7 +691,7 @@ optimize_comparison (gfc_expr *e, gfc_intrinsic_op op)
                        && op2_left->expr_type == EXPR_CONSTANT
                        && op1_left->value.character.length
                           != op2_left->value.character.length)
-                   return false;
+                   return change;
                  else
                    {
                      free (op1_left);
@@ -787,7 +780,7 @@ optimize_comparison (gfc_expr *e, gfc_intrinsic_op op)
        }
     }
 
-  return false;
+  return change;
 }
 
 /* Optimize a trim function by replacing it with an equivalent substring

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index cf6f36884ec0e350d36298a27ae60e7a3cfef580..c3f3a15c4409ab49ed8051aaff0cb132d64721bb 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2011-06-13  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+       * gfortran.dg/trim_optimize_8.f90:  New test case.
+
 2011-06-13 Jakub Jelinek  <jakub@redhat.com>
           Ira Rosen  <ira.rosen@linaro.org>
 

diff --git a/gcc/testsuite/gfortran.dg/trim_optimize_8.f90 b/gcc/testsuite/gfortran.dg/trim_optimize_8.f90
new file mode 100644 (file)
index 0000000..60dfd19
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/trim_optimize_8.f90
@@ -0,0 +1,14 @@
+! { dg-do compile }
+! { dg-options "-O -fdump-tree-original" }
+! Check that trailing trims are also removed from assignment of
+! expressions involving concatenations of strings .
+program main
+  character(2) :: a,b
+  character(8) :: d
+  a = 'a '
+  b = 'b '
+  if (trim(a // trim(b)) /= 'a b ') call abort
+  if (trim (trim(a) // trim(b)) /= 'ab ') call abort
+end
+! { dg-final { scan-tree-dump-times "string_len_trim" 1 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }