===================================================================
@@ -486,6 +486,35 @@ optimize_binop_array_assignment (gfc_code *c, gfc_
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,25 +528,8 @@ 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. */
+ remove_trim (rhs);
- 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;
- }
- }
-
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
/* Strip off unneeded TRIM calls from string comparisons. */
- change = false;
+ change = remove_trim (op1);
- 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 (remove_trim (op2))
+ 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;
- }
-
- if (change)
- {
- optimize_comparison (e, op);
- return 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
&& 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
}
}
- return false;
+ return change;
}
/* Optimize a trim function by replacing it with an equivalent substring
Hello world, this is the last round of TRIM optimizations. This patch extends the treatment of trailing TRIMs in concatenations to comparisions. It also does a bit of code cleanup by removing some duplication, and by not changing the rhs in optimize_assignment. OK for trunk? Thomas 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. ! { 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" } }