re PR fortran/50690 (ICE with front end optimization and OMP workshare)

2011-12-11  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/50690
	* frontend-passes.c (in_omp_workshare):  New variable.
	(cfe_expr_0):  Don't eliminiate common function if it would put
	the variable immediately into a WORKSHARE construct.
	(optimize_namespace):  Set in_omp_workshare.
	(gfc_code_walker):  Keep track of OMP PARALLEL and OMP WORKSHARE
	constructs.

2011-12-11  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/50690
	* gfortran.dg/gomp/workshare2.f90:  New test.
	* gfortran.dg/gomp/workshare3.f90:  New test.

From-SVN: r182208

gcc/fortran/ChangeLog

+2011-12-11  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR fortran/50690
+	* frontend-passes.c (in_omp_workshare):  New variable.
+	(cfe_expr_0):  Don't eliminiate common function if it would put
+	the variable immediately into a WORKSHARE construct.
+	(optimize_namespace):  Set in_omp_workshare.
+	(gfc_code_walker):  Keep track of OMP PARALLEL and OMP WORKSHARE
+	constructs.
+
 2011-12-10  Tobias Burnus  <burnus@net-b.de>
 
 	* trans-decl.c (add_argument_checking): Fix syntax.

gcc/fortran/frontend-passes.c

@@ -66,6 +66,10 @@ static gfc_namespace *current_ns;
 
 static int forall_level;
 
+/* Keep track of whether we are within an OMP workshare.  */
+
+static bool in_omp_workshare;
+
 /* Entry point - run all passes for a namespace.  So far, only an
    optimization pass is run.  */
 
@@ -367,6 +371,14 @@ cfe_expr_0 (gfc_expr **e, int *walk_subtrees,
   int i,j;
   gfc_expr *newvar;
 
+  /* Don't do this optimization within OMP workshare. */
+
+  if (in_omp_workshare)
+    {
+      *walk_subtrees = 0;
+      return 0;
+    }
+
   expr_count = 0;
 
   gfc_expr_walker (e, cfe_register_funcs, NULL);
@@ -505,6 +517,7 @@ optimize_namespace (gfc_namespace *ns)
 
   current_ns = ns;
   forall_level = 0;
+  in_omp_workshare = false;
 
   gfc_code_walker (&ns->code, convert_do_while, dummy_expr_callback, NULL);
   gfc_code_walker (&ns->code, cfe_code, cfe_expr_0, NULL);
@@ -1150,11 +1163,13 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t codefn, walk_expr_fn_t exprfn,
 	  gfc_actual_arglist *a;
 	  gfc_code *co;
 	  gfc_association_list *alist;
+	  bool saved_in_omp_workshare;
 
 	  /* There might be statement insertions before the current code,
 	     which must not affect the expression walker.  */
 
 	  co = *c;
+	  saved_in_omp_workshare = in_omp_workshare;
 
 	  switch (co->op)
 	    {
@@ -1330,16 +1345,34 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t codefn, walk_expr_fn_t exprfn,
 	      WALK_SUBEXPR (co->ext.dt->extra_comma);
 	      break;
 
-	    case EXEC_OMP_DO:
 	    case EXEC_OMP_PARALLEL:
 	    case EXEC_OMP_PARALLEL_DO:
 	    case EXEC_OMP_PARALLEL_SECTIONS:
+
+	      in_omp_workshare = false;
+
+	      /* This goto serves as a shortcut to avoid code
+		 duplication or a larger if or switch statement.  */
+	      goto check_omp_clauses;
+	      
+	    case EXEC_OMP_WORKSHARE:
 	    case EXEC_OMP_PARALLEL_WORKSHARE:
+
+	      in_omp_workshare = true;
+
+	      /* Fall through  */
+	      
+	    case EXEC_OMP_DO:
 	    case EXEC_OMP_SECTIONS:
 	    case EXEC_OMP_SINGLE:
-	    case EXEC_OMP_WORKSHARE:
 	    case EXEC_OMP_END_SINGLE:
 	    case EXEC_OMP_TASK:
+
+	      /* Come to this label only from the
+		 EXEC_OMP_PARALLEL_* cases above.  */
+
+	    check_omp_clauses:
+
 	      if (co->ext.omp_clauses)
 		{
 		  WALK_SUBEXPR (co->ext.omp_clauses->if_expr);
@@ -1366,6 +1399,7 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t codefn, walk_expr_fn_t exprfn,
 	  if (co->op == EXEC_FORALL)
 	    forall_level --;
 
+	  in_omp_workshare = saved_in_omp_workshare;
 	}
     }
   return 0;

gcc/testsuite/ChangeLog

+2011-12-11  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR fortran/50690
+	* gfortran.dg/gomp/workshare2.f90:  New test.
+	* gfortran.dg/gomp/workshare3.f90:  New test.
+
 2011-12-11  Eric Botcazou  <ebotcazou@adacore.com>
 
 	* gnat.dg/specs/elab3.ads: New test.

gcc/testsuite/gfortran.dg/gomp/workshare2.f90

+! { dg-do compile }
+! { dg-options "-fopenmp -ffrontend-optimize -fdump-tree-original" }
+! PR 50690 - this used to ICE because workshare could not handle
+! BLOCKs.
+! To test for correct execution, run this program (but don't forget
+! to unset the stack limit).
+program foo
+  implicit none
+  integer, parameter :: n = 10000000
+  real, parameter :: eps = 3e-7
+  integer :: i,j
+  real :: A(n), B(5), C(n)
+  real :: tmp
+  B(1) = 3.344
+  tmp = B(1)
+  do i=1,10
+     call random_number(a)
+     c = a
+     !$omp parallel default(shared)
+     !$omp workshare
+     A(:) = A(:)*cos(B(1))+A(:)*cos(B(1))
+     !$omp end workshare nowait
+     !$omp end parallel ! sync is implied here
+  end do
+
+  c = c*tmp + c*tmp
+
+  do j=1,n
+     if (abs(a(j)-c(j)) > eps) then
+        print *,1,j,a(j), c(j)
+        call abort
+     end if
+  end do
+
+  do i=1,10
+     call random_number(a)
+     c = a
+     !$omp parallel workshare default(shared)
+     A(:) = A(:)*cos(B(1))+A(:)*cos(B(1))
+     !$omp end parallel workshare
+  end do
+
+  c = c*tmp + c*tmp
+  do j=1,n
+     if (abs(a(j)-c(j)) > eps) then
+        print *,2,j,a(j), c(j)
+        call abort
+     end if
+  end do
+
+end program foo
+! { dg-final { scan-tree-dump-times "__var" 0 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }

gcc/testsuite/gfortran.dg/gomp/workshare3.f90

+! { dg-do compile }
+! { dg-options "-ffrontend-optimize -fdump-tree-original -fopenmp" }
+! Test that common function elimination is done within the OMP parallel
+! blocks even if there is a workshare around it.
+program foo
+  implicit none
+  integer, parameter :: n = 10000000
+  real, parameter :: eps = 3e-7
+  integer :: i,j
+  real :: A(n), B(5), C(n)
+  real :: tmp
+  B(1) = 3.344
+  tmp = B(1)
+  do i=1,10
+     call random_number(a)
+     c = a
+     !$omp parallel workshare
+     !$omp parallel default(shared)
+     !$omp do
+     do j=1,n
+       A(j) = A(j)*cos(B(1))+A(j)*cos(B(1))
+     end do
+     !$omp end do
+     !$omp end parallel
+     !$omp end parallel workshare
+  end do
+
+  c = c*cos(b(1))+ c*cos(b(1))
+
+  do j=1,n
+     if (abs(a(j)-c(j)) > eps) then
+        print *,1,j,a(j), c(j)
+        call abort
+     end if
+  end do
+
+end program foo
+! { dg-final { scan-tree-dump-times "__builtin_cosf" 2 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }