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" } } +