From 4f21f0daa3b108e1e38be13234e4f6119aa1c33b Mon Sep 17 00:00:00 2001
From: Thomas Koenig <tkoenig@gcc.gnu.org>
Date: Mon, 13 Jun 2011 08:36:47 +0000
Subject: [PATCH] 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
---
gcc/fortran/ChangeLog | 7 ++
gcc/fortran/frontend-passes.c | 79 +++++++++----------
gcc/testsuite/ChangeLog | 4 +
gcc/testsuite/gfortran.dg/trim_optimize_8.f90 | 14 ++++
4 files changed, 61 insertions(+), 43 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/trim_optimize_8.f90
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index ad06808d1392..af621be59e8f 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 d1cc22979b79..4d8c77a12694 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 cf6f36884ec0..c3f3a15c4409 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 000000000000..60dfd193a487
--- /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" } }
--
GitLab