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 <ja...@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 = █
@@ -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
