aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--gcc/fortran/ChangeLog16
-rw-r--r--gcc/fortran/dependency.c46
-rw-r--r--gcc/fortran/frontend-passes.c125
-rw-r--r--gcc/testsuite/ChangeLog8
-rw-r--r--gcc/testsuite/gfortran.dg/character_comparison_4.f9039
-rw-r--r--gcc/testsuite/gfortran.dg/character_comparison_5.f9021
-rw-r--r--gcc/testsuite/gfortran.dg/character_comparison_6.f9020
7 files changed, 254 insertions, 21 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 3a2af67..55f57fc 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,19 @@
+2010-10-09 Thomas Koenig <tkoenig@gcc.gnu.org>
+
+ * 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 <joseph@codesourcery.com>
* f95-lang.c (LANG_HOOKS_INIT_OPTIONS_STRUCT): Define.
diff --git a/gcc/fortran/dependency.c b/gcc/fortran/dependency.c
index ee66d21..40969f6 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 aefee62..c089302 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 2229bc4..dbb2a28 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,8 +1,14 @@
+2010-10-09 Thomas Koenig <tkoenig@gcc.gnu.org>
+
+ * 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 <rth@redhat.com>
* lib/target-supports.exp
(check_effective_target_automatic_stack_alignment): Always true.
-
+
2010-10-09 Richard Guenther <rguenther@suse.de>
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 0000000..1ff8b47
--- /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 0000000..b9ad921
--- /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 0000000..78f6477
--- /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" } }
+
generated by cgit v1.1 at 2024-11-02 22:42:54 +0000