From 32af57e2269904ec2a56a9918f8a054e60aa5ef4 Mon Sep 17 00:00:00 2001 From: Thomas Koenig Date: Sun, 10 Oct 2010 09:52:46 +0000 Subject: [PATCH] frontend-passes.c: Include opts.h. 2010-10-09 Thomas Koenig * frontend-passes.c: Include opts.h. (optimize_comparison): Renamed from optimize_equality. Change second argument to operation to be compared. Use flag_finite_math_only to avoid comparing REAL and COMPLEX only when NANs are honored. Simplify comparing of string concatenations where left or right operands are equal. Simplify all comparison operations, based on the result of gfc_dep_compare_expr. * dependency.c: Include arith.h. (gfc_are_identical_variables): Volatile variables should not compare equal to themselves. (gfc_dep_compare_expr): Handle string constants and string concatenations. 2010-10-09 Thomas Koenig * gfortran.dg/character_comparison_4.f90: New test. * gfortran.dg/character_comparison_5.f90: New test. * gfortran.dg/character_comparison_6.f90: New test. From-SVN: r165248 --- gcc/fortran/ChangeLog | 16 +++ gcc/fortran/dependency.c | 46 +++++++ gcc/fortran/frontend-passes.c | 125 +++++++++++++++--- gcc/testsuite/ChangeLog | 8 +- .../gfortran.dg/character_comparison_4.f90 | 39 ++++++ .../gfortran.dg/character_comparison_5.f90 | 21 +++ .../gfortran.dg/character_comparison_6.f90 | 20 +++ 7 files changed, 254 insertions(+), 21 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/character_comparison_4.f90 create mode 100644 gcc/testsuite/gfortran.dg/character_comparison_5.f90 create mode 100644 gcc/testsuite/gfortran.dg/character_comparison_6.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 3a2af6704b1..55f57fc29cd 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,19 @@ +2010-10-09 Thomas Koenig + + * frontend-passes.c: Include opts.h. + (optimize_comparison): Renamed from optimize_equality. + Change second argument to operation to be compared. + Use flag_finite_math_only to avoid comparing REAL and + COMPLEX only when NANs are honored. Simplify comparing + of string concatenations where left or right operands are + equal. Simplify all comparison operations, based on the result + of gfc_dep_compare_expr. + * dependency.c: Include arith.h. + (gfc_are_identical_variables): Volatile variables should not + compare equal to themselves. + (gfc_dep_compare_expr): Handle string constants and string + concatenations. + 2010-10-08 Joseph Myers * f95-lang.c (LANG_HOOKS_INIT_OPTIONS_STRUCT): Define. diff --git a/gcc/fortran/dependency.c b/gcc/fortran/dependency.c index ee66d216ab5..40969f6e2d4 100644 --- a/gcc/fortran/dependency.c +++ b/gcc/fortran/dependency.c @@ -29,6 +29,7 @@ along with GCC; see the file COPYING3. If not see #include "gfortran.h" #include "dependency.h" #include "constructor.h" +#include "arith.h" /* static declarations */ /* Enums */ @@ -125,6 +126,11 @@ gfc_are_identical_variables (gfc_expr *e1, gfc_expr *e2) if (e1->symtree->n.sym != e2->symtree->n.sym) return false; + /* Volatile variables should never compare equal to themselves. */ + + if (e1->symtree->n.sym->attr.volatile_) + return false; + r1 = e1->ref; r2 = e2->ref; @@ -306,6 +312,42 @@ gfc_dep_compare_expr (gfc_expr *e1, gfc_expr *e2) } } + /* Compare A // B vs. C // D. */ + + if (e1->expr_type == EXPR_OP && e1->value.op.op == INTRINSIC_CONCAT + && e2->expr_type == EXPR_OP && e2->value.op.op == INTRINSIC_CONCAT) + { + int l, r; + + l = gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op1); + r = gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op2); + + if (l == -2) + return -2; + + if (l == 0) + { + /* Watch out for 'A ' // x vs. 'A' // x. */ + gfc_expr *e1_left = e1->value.op.op1; + gfc_expr *e2_left = e2->value.op.op1; + + if (e1_left->expr_type == EXPR_CONSTANT + && e2_left->expr_type == EXPR_CONSTANT + && e1_left->value.character.length + != e2_left->value.character.length) + return -2; + else + return r; + } + else + { + if (l != 0) + return l; + else + return r; + } + } + /* Compare X vs. X-C. */ if (e2->expr_type == EXPR_OP && e2->value.op.op == INTRINSIC_MINUS) { @@ -321,6 +363,10 @@ gfc_dep_compare_expr (gfc_expr *e1, gfc_expr *e2) switch (e1->expr_type) { case EXPR_CONSTANT: + /* Compare strings for equality. */ + if (e1->ts.type == BT_CHARACTER && e2->ts.type == BT_CHARACTER) + return gfc_compare_string (e1, e2); + if (e1->ts.type != BT_INTEGER || e2->ts.type != BT_INTEGER) return -2; diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c index aefee62808b..c08930297e1 100644 --- a/gcc/fortran/frontend-passes.c +++ b/gcc/fortran/frontend-passes.c @@ -25,6 +25,7 @@ along with GCC; see the file COPYING3. If not see #include "flags.h" #include "dependency.h" #include "constructor.h" +#include "opts.h" /* Forward declarations. */ @@ -32,7 +33,7 @@ static void strip_function_call (gfc_expr *); static void optimize_namespace (gfc_namespace *); static void optimize_assignment (gfc_code *); static bool optimize_op (gfc_expr *); -static bool optimize_equality (gfc_expr *, bool); +static bool optimize_comparison (gfc_expr *, gfc_intrinsic_op); /* Entry point - run all passes for a namespace. So far, only an optimization pass is run. */ @@ -226,15 +227,13 @@ optimize_op (gfc_expr *e) case INTRINSIC_GE_OS: case INTRINSIC_LE: case INTRINSIC_LE_OS: - return optimize_equality (e, true); - case INTRINSIC_NE: case INTRINSIC_NE_OS: case INTRINSIC_GT: case INTRINSIC_GT_OS: case INTRINSIC_LT: case INTRINSIC_LT_OS: - return optimize_equality (e, false); + return optimize_comparison (e, op); default: break; @@ -246,10 +245,12 @@ optimize_op (gfc_expr *e) /* Optimize expressions for equality. */ static bool -optimize_equality (gfc_expr *e, bool equal) +optimize_comparison (gfc_expr *e, gfc_intrinsic_op op) { gfc_expr *op1, *op2; bool change; + int eq; + bool result; op1 = e->value.op.op1; op2 = e->value.op.op2; @@ -276,7 +277,7 @@ optimize_equality (gfc_expr *e, bool equal) if (change) { - optimize_equality (e, equal); + optimize_comparison (e, op); return true; } @@ -287,22 +288,106 @@ optimize_equality (gfc_expr *e, bool equal) if (e->rank > 0) return false; - /* Check for direct comparison between identical variables. Don't compare - REAL or COMPLEX because of NaN checks. */ - if (op1->expr_type == EXPR_VARIABLE - && op2->expr_type == EXPR_VARIABLE - && op1->ts.type != BT_REAL && op2->ts.type != BT_REAL - && op1->ts.type != BT_COMPLEX && op2->ts.type !=BT_COMPLEX - && gfc_are_identical_variables (op1, op2)) + /* Don't compare REAL or COMPLEX expressions when honoring NaNs. */ + + if (flag_finite_math_only + || (op1->ts.type != BT_REAL && op2->ts.type != BT_REAL + && op1->ts.type != BT_COMPLEX && op2->ts.type != BT_COMPLEX)) { - /* Replace the expression by a constant expression. The typespec - and where remains the way it is. */ - gfc_free (op1); - gfc_free (op2); - e->expr_type = EXPR_CONSTANT; - e->value.logical = equal; - return true; + eq = gfc_dep_compare_expr (op1, op2); + if (eq == -2) + { + /* Replace A // B < A // C with B < C, and A // B < C // B + with A < C. */ + if (op1->ts.type == BT_CHARACTER && op2->ts.type == BT_CHARACTER + && op1->value.op.op == INTRINSIC_CONCAT + && op2->value.op.op == INTRINSIC_CONCAT) + { + gfc_expr *op1_left = op1->value.op.op1; + gfc_expr *op2_left = op2->value.op.op1; + gfc_expr *op1_right = op1->value.op.op2; + gfc_expr *op2_right = op2->value.op.op2; + + if (gfc_dep_compare_expr (op1_left, op2_left) == 0) + { + /* Watch out for 'A ' // x vs. 'A' // x. */ + + if (op1_left->expr_type == EXPR_CONSTANT + && op2_left->expr_type == EXPR_CONSTANT + && op1_left->value.character.length + != op2_left->value.character.length) + return -2; + else + { + gfc_free (op1_left); + gfc_free (op2_left); + e->value.op.op1 = op1_right; + e->value.op.op2 = op2_right; + optimize_comparison (e, op); + return true; + } + } + if (gfc_dep_compare_expr (op1_right, op2_right) == 0) + { + gfc_free (op1_right); + gfc_free (op2_right); + e->value.op.op1 = op1_left; + e->value.op.op2 = op2_left; + optimize_comparison (e, op); + return true; + } + } + } + else + { + /* eq can only be -1, 0 or 1 at this point. */ + switch (op) + { + case INTRINSIC_EQ: + case INTRINSIC_EQ_OS: + result = eq == 0; + break; + + case INTRINSIC_GE: + case INTRINSIC_GE_OS: + result = eq >= 0; + break; + + case INTRINSIC_LE: + case INTRINSIC_LE_OS: + result = eq <= 0; + break; + + case INTRINSIC_NE: + case INTRINSIC_NE_OS: + result = eq != 0; + break; + + case INTRINSIC_GT: + case INTRINSIC_GT_OS: + result = eq > 0; + break; + + case INTRINSIC_LT: + case INTRINSIC_LT_OS: + result = eq < 0; + break; + + default: + gfc_internal_error ("illegal OP in optimize_comparison"); + break; + } + + /* Replace the expression by a constant expression. The typespec + and where remains the way it is. */ + gfc_free (op1); + gfc_free (op2); + e->expr_type = EXPR_CONSTANT; + e->value.logical = result; + return true; + } } + return false; } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 2229bc444e3..dbb2a28cefb 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,8 +1,14 @@ +2010-10-09 Thomas Koenig + + * gfortran.dg/character_comparison_4.f90: New test. + * gfortran.dg/character_comparison_5.f90: New test. + * gfortran.dg/character_comparison_6.f90: New test. + 2010-10-09 Richard Henderson * lib/target-supports.exp (check_effective_target_automatic_stack_alignment): Always true. - + 2010-10-09 Richard Guenther PR lto/45956 diff --git a/gcc/testsuite/gfortran.dg/character_comparison_4.f90 b/gcc/testsuite/gfortran.dg/character_comparison_4.f90 new file mode 100644 index 00000000000..1ff8b470732 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/character_comparison_4.f90 @@ -0,0 +1,39 @@ +! { dg-do run } +! { dg-options "-O -fdump-tree-original" } +program main + implicit none + character(len=4) :: c, d + integer :: n + integer :: i + common /foo/ i + + n = 0 + i = 0 + c = 'abcd' + d = 'efgh' + + n = n + 1 ; if ('a' // c == 'a' // c) call yes + n = n + 1 ; if (c // 'a' == c // 'a') call yes + n = n + 1; if ('b' // c > 'a' // d) call yes + n = n + 1; if (c // 'b' > c // 'a') call yes + + if ('a' // c /= 'a' // c) call abort + if ('a' // c // 'b' == 'a' // c // 'a') call abort + if ('b' // c == 'a' // c) call abort + if (c // 'a' == c // 'b') call abort + if (c // 'a ' /= c // 'a') call abort + if (c // 'b' /= c // 'b ') call abort + + if (n /= i) call abort +end program main + +subroutine yes + implicit none + common /foo/ i + integer :: i + i = i + 1 +end subroutine yes + +! { dg-final { scan-tree-dump-times "gfortran_compare_string" 0 "original" } } +! { dg-final { cleanup-tree-dump "original" } } + diff --git a/gcc/testsuite/gfortran.dg/character_comparison_5.f90 b/gcc/testsuite/gfortran.dg/character_comparison_5.f90 new file mode 100644 index 00000000000..b9ad9215794 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/character_comparison_5.f90 @@ -0,0 +1,21 @@ +! { dg-do run } +! { dg-options "-O -fdump-tree-original" } +program main + implicit none + character(len=4) :: c, d + integer :: n + integer :: i + common /foo/ i + + n = 0 + i = 0 + c = 'abcd' + d = 'efgh' + if (c // 'a' >= d // 'a') call abort + if ('a' // c >= 'a' // d) call abort +end program main + +! { dg-final { scan-tree-dump-times "gfortran_concat_string" 0 "original" } } +! { dg-final { scan-tree-dump-times "gfortran_compare_string" 2 "original" } } +! { dg-final { cleanup-tree-dump "original" } } + diff --git a/gcc/testsuite/gfortran.dg/character_comparison_6.f90 b/gcc/testsuite/gfortran.dg/character_comparison_6.f90 new file mode 100644 index 00000000000..78f647705a2 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/character_comparison_6.f90 @@ -0,0 +1,20 @@ +! { dg-do run } +! { dg-options "-O -fdump-tree-original" } +program main + implicit none + character(len=4) :: c + integer :: n + integer :: i + common /foo/ i + + n = 0 + i = 0 + c = 'abcd' + if ('a ' // c == 'a' // c) call abort + if ('a' // c == 'a ' // c) call abort +end program main + +! { dg-final { scan-tree-dump-times "gfortran_concat_string" 4 "original" } } +! { dg-final { scan-tree-dump-times "gfortran_compare_string" 2 "original" } } +! { dg-final { cleanup-tree-dump "original" } } +