OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

frontend-passes.c: Include opts.h. 

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-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.

From-SVN: r165248
This commit is contained in:
Thomas Koenig 2010-10-10 09:52:46 +00:00
parent 0e88eb8694
commit 32af57e226
7 changed files with 254 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
gcc/fortran/ChangeLog
View File

@ -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.

46
gcc/fortran/dependency.c
View File

@ -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;

125
gcc/fortran/frontend-passes.c
View File

@ -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;
}

8
gcc/testsuite/ChangeLog
View File

@ -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

39
gcc/testsuite/gfortran.dg/character_comparison_4.f90 Normal file
View File

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

21
gcc/testsuite/gfortran.dg/character_comparison_5.f90 Normal file
View File

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

20
gcc/testsuite/gfortran.dg/character_comparison_6.f90 Normal file
View File

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