OpenMP: Support 'lastprivate (conditional:' in Fortran
gcc/fortran/ChangeLog:
* gfortran.h (gfc_omp_namelist): Add lastprivate_conditional.
* openmp.c (gfc_match_omp_clauses): Handle 'conditional:'
modifier of 'lastprivate'.
* trans-openmp.c (gfc_omp_clause_default_ctor): Don't assert
on OMP_CLAUSE__CONDTEMP_ and other OMP_*TEMP_.
(gfc_trans_omp_variable_list): Handle lastprivate_conditional.
gcc/testsuite/ChangeLog:
* gfortran.dg/gomp/lastprivate-conditional-1.f90: New test.
* gfortran.dg/gomp/lastprivate-conditional-2.f90: New test.
* gfortran.dg/gomp/lastprivate-conditional-3.f90: New test.
* gfortran.dg/gomp/lastprivate-conditional-4.f90: New test.
* gfortran.dg/gomp/lastprivate-conditional-5.f90: New test.
gcc/fortran/gfortran.h | 1 +
gcc/fortran/openmp.c | 20 ++++--
gcc/fortran/trans-openmp.c | 23 ++++--
.../gfortran.dg/gomp/lastprivate-conditional-1.f90 | 82 ++++++++++++++++++++++
.../gfortran.dg/gomp/lastprivate-conditional-2.f90 | 46 ++++++++++++
.../gfortran.dg/gomp/lastprivate-conditional-3.f90 | 65 +++++++++++++++++
.../gfortran.dg/gomp/lastprivate-conditional-4.f90 | 28 ++++++++
.../gfortran.dg/gomp/lastprivate-conditional-5.f90 | 47 +++++++++++++
8 files changed, 304 insertions(+), 8 deletions(-)
@@ -1242,6 +1242,7 @@ typedef struct gfc_omp_namelist
gfc_omp_map_op map_op;
gfc_omp_linear_op linear_op;
struct gfc_common_head *common;
+ bool lastprivate_conditional;
} u;
struct gfc_omp_namelist_udr *udr;
struct gfc_omp_namelist *next;
@@ -1355,10 +1355,22 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
break;
case 'l':
if ((mask & OMP_CLAUSE_LASTPRIVATE)
- && gfc_match_omp_variable_list ("lastprivate (",
- &c->lists[OMP_LIST_LASTPRIVATE],
- true) == MATCH_YES)
- continue;
+ && gfc_match ("lastprivate ( ") == MATCH_YES)
+ {
+ bool conditional = gfc_match ("conditional : ") == MATCH_YES;
+ head = NULL;
+ if (gfc_match_omp_variable_list ("",
+ &c->lists[OMP_LIST_LASTPRIVATE],
+ false, NULL, &head) == MATCH_YES)
+ {
+ gfc_omp_namelist *n;
+ for (n = *head; n; n = n->next)
+ n->u.lastprivate_conditional = conditional;
+ continue;
+ }
+ gfc_current_locus = old_loc;
+ break;
+ }
end_colon = false;
head = NULL;
if ((mask & OMP_CLAUSE_LINEAR)
@@ -613,10 +613,21 @@ gfc_omp_clause_default_ctor (tree clause, tree decl, tree outer)
tree type = TREE_TYPE (decl), size, ptr, cond, then_b, else_b;
stmtblock_t block, cond_block;
- gcc_assert (OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_PRIVATE
- || OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_LASTPRIVATE
- || OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_LINEAR
- || OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_REDUCTION);
+ switch (OMP_CLAUSE_CODE (clause))
+ {
+ case OMP_CLAUSE__LOOPTEMP_:
+ case OMP_CLAUSE__REDUCTEMP_:
+ case OMP_CLAUSE__CONDTEMP_:
+ case OMP_CLAUSE__SCANTEMP_:
+ return NULL;
+ case OMP_CLAUSE_PRIVATE:
+ case OMP_CLAUSE_LASTPRIVATE:
+ case OMP_CLAUSE_LINEAR:
+ case OMP_CLAUSE_REDUCTION:
+ break;
+ default:
+ gcc_unreachable ();
+ }
if ((! GFC_DESCRIPTOR_TYPE_P (type)
|| GFC_TYPE_ARRAY_AKIND (type) != GFC_ARRAY_ALLOCATABLE)
@@ -1678,6 +1689,10 @@ gfc_trans_omp_variable_list (enum omp_clause_code code,
tree node = build_omp_clause (input_location, code);
OMP_CLAUSE_DECL (node) = t;
list = gfc_trans_add_clause (node, list);
+
+ if (code == OMP_CLAUSE_LASTPRIVATE
+ && namelist->u.lastprivate_conditional)
+ OMP_CLAUSE_LASTPRIVATE_CONDITIONAL (node) = 1;
}
}
return list;
new file mode 100644
@@ -0,0 +1,82 @@
+subroutine foo (p)
+ implicit none
+ logical :: p(:)
+ integer a, b, c, d, e, f, g, h;
+ integer :: i
+ a = -1; b = -1; c = -1; d = -1; e = -1; f = -1; g = -1; h = -1
+ !$omp teams
+ !$omp distribute lastprivate (conditional: a) ! { dg-error "conditional 'lastprivate' clause on 'distribute' construct" }
+ do i = 1, 32
+ if (p(i)) &
+ a = i
+ end do
+ !$omp distribute simd lastprivate (conditional: b) ! { dg-error "conditional 'lastprivate' clause on 'distribute' construct" }
+ do i = 1, 32
+ if (p(i)) &
+ b = i
+ end do
+ !$omp distribute parallel do lastprivate (conditional: c) ! { dg-error "conditional 'lastprivate' clause on 'distribute' construct" }
+ do i = 1, 32
+ if (p(i)) &
+ c = i
+ end do
+ !$omp distribute parallel do simd lastprivate (conditional: d) ! { dg-error "conditional 'lastprivate' clause on 'distribute' construct" }
+ do i = 1, 32
+ if (p(i)) &
+ d = i
+ end do
+ !$omp end teams
+
+ !$omp teams distribute parallel do lastprivate (conditional: e) ! { dg-error "conditional 'lastprivate' clause on 'distribute' construct" }
+ do i = 1, 32
+ if (p(i)) &
+ e = i
+ end do
+
+ !$omp parallel
+ !$omp master
+ !$omp taskloop lastprivate (conditional: f) ! { dg-error "conditional 'lastprivate' clause on 'taskloop' construct" }
+ do i = 1, 32
+ if (p(i)) &
+ f = i
+ end do
+! !$omp master taskloop simd lastprivate (conditional: g) ! { dg!error "conditional 'lastprivate' clause on 'taskloop' construct" }
+! do i = 1, 32
+! if (p(i)) &
+! g = i
+! end do
+ !$omp end master
+ !$omp end parallel
+
+! !$omp parallel master taskloop simd lastprivate (conditional: h) ! { dg!error "conditional 'lastprivate' clause on 'taskloop' construct" }
+! do i = 1, 32
+! if (p(i)) &
+! h = i
+! end do
+! !$omp end parallel master taskloop simd
+end subroutine
+
+!struct S { int a, b; };
+
+subroutine bar (p)
+ implicit none
+ logical :: p(:)
+ type s_t
+ integer :: a, b
+ end type s_t
+ type(s_t) s, t
+ integer i
+ s = s_t(-1, -1)
+ t = s_t( 1, 2)
+ !$omp parallel do lastprivate (conditional: s) ! { dg-error "non-scalar variable 's' in conditional 'lastprivate' clause" }
+ do i = 1, 32
+ if (p(i)) then
+ block
+ type(s_t) u
+ u = t
+ u%b = i
+ s = u
+ end block
+ end if
+ end do
+end subroutine
new file mode 100644
@@ -0,0 +1,46 @@
+! { dg-additional-options "-fdump-tree-original" }
+subroutine foo (p)
+ logical :: p(:)
+ integer i
+ integer a, b, c, d, e, f, g, h
+ a = -1; b = -1; c = -1; d = -1; e = -1; f = -1; g = -1; h = -1
+ !$omp parallel
+ !$omp do lastprivate (conditional: a)
+ do i = 1, 32
+ if (p(i)) &
+ a = i
+ end do
+ !$omp end parallel
+ !$omp simd lastprivate (conditional: b)
+ do i = 1, 32
+ if (p(i)) &
+ b = i
+ end do
+ !$omp parallel
+ !$omp do simd lastprivate (conditional: c)
+ do i = 1, 32
+ if (p(i)) &
+ c = i
+ end do
+ !$omp end parallel
+ !$omp parallel do lastprivate (conditional: d)
+ do i = 1, 32
+ if (p(i)) &
+ d = i
+ end do
+ !$omp end parallel do
+ !$omp parallel do simd lastprivate (conditional: e)
+ do i = 1, 32
+ if (p(i)) &
+ e = i
+ end do
+ !$omp end parallel do simd
+end subroutine
+
+! { dg-final { scan-tree-dump-times "#pragma omp for lastprivate\\(conditional:a\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "#pragma omp simd linear\\(i:1\\) lastprivate\\(conditional:b\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "#pragma omp for lastprivate\\(conditional:c\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "#pragma omp simd linear\\(i:1\\) lastprivate\\(conditional:c\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "#pragma omp parallel lastprivate\\(conditional:d\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "#pragma omp parallel lastprivate\\(conditional:e\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "#pragma omp simd linear\\(i:1\\) lastprivate\\(conditional:e\\)" 1 "original" } }
new file mode 100644
@@ -0,0 +1,65 @@
+subroutine foo
+ integer i, j, k
+ !$omp parallel
+ !$omp do lastprivate (conditional: i) ! { dg-warning "conditional 'lastprivate' on loop iterator 'i' ignored" }
+ do i = 1, 32
+ end do
+ !$omp do collapse (3) lastprivate (conditional: i) ! { dg-warning "conditional 'lastprivate' on loop iterator 'i' ignored" }
+ do i = 1, 32
+ do j = 1, 32
+ do k = 1, 32
+ end do
+ end do
+ end do
+ !$omp do collapse (3) lastprivate (conditional: j) ! { dg-warning "conditional 'lastprivate' on loop iterator 'j' ignored" }
+ do i = 1, 32
+ do j = 1, 32
+ do k = 1, 32
+ end do
+ end do
+ end do
+ !$omp do collapse (3) lastprivate (conditional: k) ! { dg-warning "conditional 'lastprivate' on loop iterator 'k' ignored" }
+ do i = 1, 32
+ do j = 1, 32
+ do k = 1, 32
+ end do
+ end do
+ end do
+ !$omp end parallel
+
+ ! Error in eqiv. C code: "conditional 'lastprivate' on loop iterator 'i' ignored"
+ !$omp parallel do lastprivate (conditional: i)
+ do i = 1, 32
+ end do
+ !$omp end parallel do
+
+ ! Error in eqiv. C code: "conditional 'lastprivate' on loop iterator 'i' ignored"
+ !$omp parallel do collapse (3) lastprivate (conditional: i)
+ do i = 1, 32
+ do j = 1, 32
+ do k = 1, 32
+ end do
+ end do
+ end do
+ !$omp end parallel do
+
+ ! Error in eqiv. C code: "conditional 'lastprivate' on loop iterator 'j' ignored"
+ !$omp parallel do collapse (3) lastprivate (conditional: j)
+ do i = 1, 32
+ do j = 1, 32
+ do k = 1, 32
+ end do
+ end do
+ end do
+ !$omp end parallel do
+
+ ! Error in eqiv. C code: "conditional 'lastprivate' on loop iterator 'k' ignored"
+ !$omp parallel do collapse (3) lastprivate (conditional: k)
+ do i = 1, 32
+ do j = 1, 32
+ do k = 1, 32
+ end do
+ end do
+ end do
+ !$omp end parallel do
+end subroutine
new file mode 100644
@@ -0,0 +1,28 @@
+module m
+integer x, w
+end module m
+
+subroutine foo
+ use m
+ interface
+ logical function bar(i)
+ integer i
+ end function
+ end interface
+ integer y, i, z
+ logical tmp
+ y = 5
+ !$omp teams num_teams(1) firstprivate (x) shared (y) shared (w)
+ !$omp parallel do firstprivate (x, y, z, w) lastprivate (conditional: x, y, z, w)
+ do i = 1, 64
+ if (bar (i)) then
+ x = i;
+ y = i + 1;
+ z = i + 2;
+ w = i + 3;
+ end if
+ tmp = bar (y);
+ tmp = bar (z);
+ end do
+ !$omp end teams
+end
new file mode 100644
@@ -0,0 +1,47 @@
+! { dg-do compile }
+! { dg-options "-O2 -fopenmp -fdump-tree-ompexp" }
+! { dg-final { scan-tree-dump-times "GOMP_loop_start " 3 "ompexp" } }
+! { dg-final { scan-tree-dump-times "GOMP_loop_end_nowait " 3 "ompexp" } }
+
+module m
+ logical r
+end module m
+
+subroutine foo (a)
+ use m
+ implicit none
+ logical a(:)
+ integer :: i
+ !$omp do lastprivate(conditional: r)
+ do i = 1, 64
+ if (a(i)) &
+ r = a(i)
+ end do
+ !$omp end do nowait
+end
+
+subroutine bar (a)
+ use m
+ implicit none
+ logical a(:)
+ integer :: i
+ !$omp do lastprivate(conditional: r) schedule (static, 4)
+ do i = 1, 64
+ if (a(i)) &
+ r = a(i)
+ end do
+ !$omp end do nowait
+end
+
+subroutine baz (a)
+ use m
+ implicit none
+ logical a(:)
+ integer :: i
+ !$omp do lastprivate(conditional: r) schedule (runtime)
+ do i = 1, 64
+ if (a(i)) &
+ r = a(i)
+ end do
+ !$omp end do nowait
+end