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

5 files changed, 147 insertions, 1 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index a32aedb..8c3a4d9 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -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>
 
 	PR fortran/56650
diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c
index ead32f8..a77afc5 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 c1f0392..a24b837 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -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>
 
 	* 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 0000000..0fe9637
--- /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 0000000..c4be965
--- /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