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

4 files changed, 61 insertions, 43 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index ad06808..af621be 100644
--- 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 d1cc229..4d8c77a 100644
--- 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 cf6f368..c3f3a15 100644
--- 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
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" } }