[PATCH] Fix !$omp workshare (PR fortran/49792)

[Jakub Jelinek <jakub at redhat dot com>]

Hi!

As the first testcase shows, if we need a temporary for array assignment,
we can't easily parallelize it (we'd have to emit the temporary allocation
into a OMP_SINGLE, then copyprivate the result to all the other threads, then
do the OMP_FOR and afterwards OMP_SINGLE again to free it).
Similarly, if for f03 we need lhs reallocation.
And lastly, if workshare has empty body, but no NOWAIT clause, we want to
emit a barrier.

Regtested on x86_64-linux, committed to trunk and 4.6 so far.

2011-08-19  Jakub Jelinek  <jakub@redhat.com>

	PR fortran/49792
	* trans-expr.c (gfc_trans_assignment_1): Set OMPWS_SCALARIZER_WS
	bit in ompws_flags only if loop.temp_ss is NULL, and clear it if
	lhs needs reallocation.
	* trans-openmp.c (gfc_trans_omp_workshare): Don't return early if
	code is NULL, emit a barrier if workshare emitted no code at all
	and NOWAIT clause isn't present.

	* testsuite/libgomp.fortran/pr49792-1.f90: New test.
	* testsuite/libgomp.fortran/pr49792-2.f90: New test.

--- gcc/fortran/trans-expr.c.jj	2011-07-27 23:25:33.000000000 +0200
+++ gcc/fortran/trans-expr.c	2011-08-19 14:12:46.000000000 +0200
@@ -6137,10 +6137,6 @@ gfc_trans_assignment_1 (gfc_expr * expr1
   rss = NULL;
   if (lss != gfc_ss_terminator)
     {
-      /* Allow the scalarizer to workshare array assignments.  */
-      if (ompws_flags & OMPWS_WORKSHARE_FLAG)
-	ompws_flags |= OMPWS_SCALARIZER_WS;
-
       /* The assignment needs scalarization.  */
       lss_section = lss;
 
@@ -6196,6 +6192,10 @@ gfc_trans_assignment_1 (gfc_expr * expr1
 	  gfc_mark_ss_chain_used (loop.temp_ss, 3);
 	}
 
+      /* Allow the scalarizer to workshare array assignments.  */
+      if ((ompws_flags & OMPWS_WORKSHARE_FLAG) && loop.temp_ss == NULL)
+	ompws_flags |= OMPWS_SCALARIZER_WS;
+
       /* Start the scalarized loop body.  */
       gfc_start_scalarized_body (&loop, &body);
     }
@@ -6304,6 +6304,7 @@ gfc_trans_assignment_1 (gfc_expr * expr1
 	    && !gfc_expr_attr (expr1).codimension
 	    && !gfc_is_coindexed (expr1))
 	{
+	  ompws_flags &= ~OMPWS_SCALARIZER_WS;
 	  tmp = gfc_alloc_allocatable_for_assignment (&loop, expr1, expr2);
 	  if (tmp != NULL_TREE)
 	    gfc_add_expr_to_block (&loop.code[expr1->rank - 1], tmp);
--- gcc/fortran/trans-openmp.c.jj	2011-08-03 18:41:01.000000000 +0200
+++ gcc/fortran/trans-openmp.c	2011-08-19 13:58:02.000000000 +0200
@@ -1764,9 +1764,6 @@ gfc_trans_omp_workshare (gfc_code *code,
 
   pushlevel (0);
 
-  if (!code)
-    return build_empty_stmt (input_location);
-
   gfc_start_block (&block);
   pblock = &block;
 
@@ -1903,6 +1900,9 @@ gfc_trans_omp_workshare (gfc_code *code,
   else
     poplevel (0, 0, 0);
 
+  if (IS_EMPTY_STMT (stmt) && !clauses->nowait)
+    stmt = gfc_trans_omp_barrier ();
+
   ompws_flags = 0;
   return stmt;
 }
--- libgomp/testsuite/libgomp.fortran/pr49792-1.f90.jj	2011-08-19 14:14:53.000000000 +0200
+++ libgomp/testsuite/libgomp.fortran/pr49792-1.f90	2011-08-19 14:16:20.000000000 +0200
@@ -0,0 +1,18 @@
+! PR fortran/49792
+! { dg-do run }
+
+subroutine reverse(n, a)
+  integer :: n
+  real(kind=8) :: a(n)
+!$omp parallel workshare
+  a(:) = a(n:1:-1)
+!$omp end parallel workshare
+end subroutine reverse
+
+program pr49792
+  real(kind=8) :: a(16) = [1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16]
+  real(kind=8) :: b(16)
+  b(:) = a(16:1:-1)
+  call reverse (16,a)
+  if (any (a.ne.b)) call abort
+end program pr49792
--- libgomp/testsuite/libgomp.fortran/pr49792-2.f90.jj	2011-08-19 14:16:00.000000000 +0200
+++ libgomp/testsuite/libgomp.fortran/pr49792-2.f90	2011-08-19 14:28:25.000000000 +0200
@@ -0,0 +1,22 @@
+! PR fortran/49792
+! { dg-do run }
+! { dg-options "-std=f2003 -fall-intrinsics" }
+
+subroutine reverse(n, a)
+  integer :: n
+  real(kind=8) :: a(n)
+!$omp parallel workshare
+  a(:) = a(n:1:-1)
+!$omp end parallel workshare
+end subroutine reverse
+
+program pr49792
+  integer :: b(16)
+  integer, allocatable :: a(:)
+  b = 1
+!$omp parallel workshare
+  a = b
+!$omp end parallel workshare
+  if (size(a).ne.size(b)) call abort()
+  if (any (a.ne.b)) call abort()
+end program pr49792

	Jakub