diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index a32aedb3608..8c3a4d994bd 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,11 @@ +2013-03-28 Thomas Koenig + + 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 PR fortran/56650 diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c index ead32f87882..a77afc58e4b 100644 --- a/gcc/fortran/frontend-passes.c +++ b/gcc/fortran/frontend-passes.c @@ -135,6 +135,10 @@ optimize_code (gfc_code **c, int *walk_subtrees ATTRIBUTE_UNUSED, else count_arglist = 0; + current_code = c; + inserted_block = NULL; + changed_statement = NULL; + if (op == EXEC_ASSIGN) optimize_assignment (*c); return 0; @@ -991,13 +995,98 @@ optimize_lexical_comparison (gfc_expr *e) 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. */ static bool optimize_op (gfc_expr *e) { + bool changed; + gfc_intrinsic_op op = e->value.op.op; + changed = false; + /* Only use new-style comparisons. */ switch(op) { @@ -1037,7 +1126,15 @@ optimize_op (gfc_expr *e) case INTRINSIC_NE: case INTRINSIC_GT: 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: break; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index c1f0392b0bc..a24b837c4be 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2013-03-28 Thomas Koenig + + PR fortran/55806 + * gfortran.dg/array_constructor_43.f90: New test. + * gfortran.dg/random_seed_3.f90: New test. + 2013-03-28 Ian Bolton * gcc.target/aarch64/inc/asm-adder-clobber-lr.c: New test. diff --git a/gcc/testsuite/gfortran.dg/array_constructor_43.f90 b/gcc/testsuite/gfortran.dg/array_constructor_43.f90 new file mode 100644 index 00000000000..0fe96377e97 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/array_constructor_43.f90 @@ -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" } } diff --git a/gcc/testsuite/gfortran.dg/random_seed_3.f90 b/gcc/testsuite/gfortran.dg/random_seed_3.f90 new file mode 100644 index 00000000000..c4be96541b0 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/random_seed_3.f90 @@ -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