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.
This commit is contained in:
Tobias Burnus
parent
ad1bea3a4b
commit
084dc63a02
@ -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 (",
|
||||
&& 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],
|
||||
true) == MATCH_YES)
|
||||
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;
|
||||
|
||||
82
gcc/testsuite/gfortran.dg/gomp/lastprivate-conditional-1.f90
Normal file
82
gcc/testsuite/gfortran.dg/gomp/lastprivate-conditional-1.f90
Normal file
@ -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
|
||||
46
gcc/testsuite/gfortran.dg/gomp/lastprivate-conditional-2.f90
Normal file
46
gcc/testsuite/gfortran.dg/gomp/lastprivate-conditional-2.f90
Normal file
@ -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" } }
|
||||
65
gcc/testsuite/gfortran.dg/gomp/lastprivate-conditional-3.f90
Normal file
65
gcc/testsuite/gfortran.dg/gomp/lastprivate-conditional-3.f90
Normal file
@ -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
|
||||
28
gcc/testsuite/gfortran.dg/gomp/lastprivate-conditional-4.f90
Normal file
28
gcc/testsuite/gfortran.dg/gomp/lastprivate-conditional-4.f90
Normal file
@ -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
|
||||
47
gcc/testsuite/gfortran.dg/gomp/lastprivate-conditional-5.f90
Normal file
47
gcc/testsuite/gfortran.dg/gomp/lastprivate-conditional-5.f90
Normal file
@ -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
|
||||
Loading…
Reference in New Issue
Block a user