re PR fortran/55806 (Missed optimization with ANY or ALL)

2013-03-28  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/55806
	* frontend-passes.c (optimize_code):  Keep track of
	current code to make code insertion possible.
	(combine_array_constructor):  New function.
	(optimize_op):  Call it.

2013-03-28  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/55806
	* gfortran.dg/array_constructor_43.f90:  New test.
	* gfortran.dg/random_seed_3.f90:  New test.

From-SVN: r197216
This commit is contained in:
Thomas Koenig 2013-03-28 21:02:00 +00:00
parent 777e69760d
commit 4099436d98
5 changed files with 147 additions and 1 deletions

View File

@ -1,3 +1,11 @@
2013-03-28 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/55806
* frontend-passes.c (optimize_code): Keep track of
current code to make code insertion possible.
(combine_array_constructor): New function.
(optimize_op): Call it.
2013-03-27 Tobias Burnus <burnus@net-b.de> 2013-03-27 Tobias Burnus <burnus@net-b.de>
PR fortran/56650 PR fortran/56650

View File

@ -135,6 +135,10 @@ optimize_code (gfc_code **c, int *walk_subtrees ATTRIBUTE_UNUSED,
else else
count_arglist = 0; count_arglist = 0;
current_code = c;
inserted_block = NULL;
changed_statement = NULL;
if (op == EXEC_ASSIGN) if (op == EXEC_ASSIGN)
optimize_assignment (*c); optimize_assignment (*c);
return 0; return 0;
@ -991,13 +995,98 @@ optimize_lexical_comparison (gfc_expr *e)
return false; return false;
} }
/* Combine stuff like [a]>b into [a>b], for easier optimization later. Do not
do CHARACTER because of possible pessimization involving character
lengths. */
static bool
combine_array_constructor (gfc_expr *e)
{
gfc_expr *op1, *op2;
gfc_expr *scalar;
gfc_expr *new_expr;
gfc_constructor *c, *new_c;
gfc_constructor_base oldbase, newbase;
bool scalar_first;
/* Array constructors have rank one. */
if (e->rank != 1)
return false;
op1 = e->value.op.op1;
op2 = e->value.op.op2;
if (op1->expr_type == EXPR_ARRAY && op2->rank == 0)
scalar_first = false;
else if (op2->expr_type == EXPR_ARRAY && op1->rank == 0)
{
scalar_first = true;
op1 = e->value.op.op2;
op2 = e->value.op.op1;
}
else
return false;
if (op2->ts.type == BT_CHARACTER)
return false;
if (op2->expr_type == EXPR_CONSTANT)
scalar = gfc_copy_expr (op2);
else
scalar = create_var (gfc_copy_expr (op2));
oldbase = op1->value.constructor;
newbase = NULL;
e->expr_type = EXPR_ARRAY;
c = gfc_constructor_first (oldbase);
for (c = gfc_constructor_first (oldbase); c;
c = gfc_constructor_next (c))
{
new_expr = gfc_get_expr ();
new_expr->ts = e->ts;
new_expr->expr_type = EXPR_OP;
new_expr->rank = c->expr->rank;
new_expr->where = c->where;
new_expr->value.op.op = e->value.op.op;
if (scalar_first)
{
new_expr->value.op.op1 = gfc_copy_expr (scalar);
new_expr->value.op.op2 = gfc_copy_expr (c->expr);
}
else
{
new_expr->value.op.op1 = gfc_copy_expr (c->expr);
new_expr->value.op.op2 = gfc_copy_expr (scalar);
}
new_c = gfc_constructor_append_expr (&newbase, new_expr, &(e->where));
new_c->iterator = c->iterator;
c->iterator = NULL;
}
gfc_free_expr (op1);
gfc_free_expr (op2);
e->value.constructor = newbase;
return true;
}
/* Recursive optimization of operators. */ /* Recursive optimization of operators. */
static bool static bool
optimize_op (gfc_expr *e) optimize_op (gfc_expr *e)
{ {
bool changed;
gfc_intrinsic_op op = e->value.op.op; gfc_intrinsic_op op = e->value.op.op;
changed = false;
/* Only use new-style comparisons. */ /* Only use new-style comparisons. */
switch(op) switch(op)
{ {
@ -1037,7 +1126,15 @@ optimize_op (gfc_expr *e)
case INTRINSIC_NE: case INTRINSIC_NE:
case INTRINSIC_GT: case INTRINSIC_GT:
case INTRINSIC_LT: case INTRINSIC_LT:
return optimize_comparison (e, op); changed = optimize_comparison (e, op);
/* Fall through */
/* Look at array constructors. */
case INTRINSIC_PLUS:
case INTRINSIC_MINUS:
case INTRINSIC_TIMES:
case INTRINSIC_DIVIDE:
return combine_array_constructor (e) || changed;
default: default:
break; break;

View File

@ -1,3 +1,9 @@
2013-03-28 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/55806
* gfortran.dg/array_constructor_43.f90: New test.
* gfortran.dg/random_seed_3.f90: New test.
2013-03-28 Ian Bolton <ian.bolton@arm.com> 2013-03-28 Ian Bolton <ian.bolton@arm.com>
* gcc.target/aarch64/inc/asm-adder-clobber-lr.c: New test. * gcc.target/aarch64/inc/asm-adder-clobber-lr.c: New test.

View File

@ -0,0 +1,13 @@
! { dg-do compile }
! { dg-options "-ffrontend-optimize -fdump-tree-original" }
program main
implicit none
real :: a,b,c,d
call random_number(a)
call random_number(b)
call random_number(c)
call random_number(d)
if (any ([a,b,c,d] < 0.2)) print *,"foo"
end program main
! { dg-final { scan-tree-dump-times "\\\|\\\|" 3 "original" } }
! { dg-final { cleanup-tree-dump "original" } }

View File

@ -0,0 +1,22 @@
! { dg-do run }
! Check that array constructors using non-compile-time
! iterators are handled correctly.
program main
implicit none
call init_random_seed
contains
SUBROUTINE init_random_seed()
INTEGER :: i, n, clock
INTEGER, DIMENSION(:), ALLOCATABLE :: seed
CALL RANDOM_SEED(size = n)
ALLOCATE(seed(n))
CALL SYSTEM_CLOCK(COUNT=clock)
seed = clock + 37 * (/ (i - 1, i = 1, n) /)
CALL RANDOM_SEED(PUT = seed)
DEALLOCATE(seed)
END SUBROUTINE init_random_seed
end program main