c42cfb5ca3
gcc/ PR lto/70289 PR ipa/70348 PR tree-optimization/70373 PR middle-end/70533 PR middle-end/70534 PR middle-end/70535 * gimplify.c (gimplify_adjust_omp_clauses): Add or adjust data clauses for acc parallel reductions as necessary. Error on those that are private. * omp-low.c (scan_sharing_clauses): Don't install variables which are used in acc parallel reductions. (lower_rec_input_clauses): Remove dead code. (lower_oacc_reductions): Add support for reference reductions. (lower_reduction_clauses): Remove dead code. (lower_omp_target): Don't remap variables appearing in acc parallel reductions. * tree.h (OMP_CLAUSE_MAP_IN_REDUCTION): New macro. gcc/testsuite/ * c-c++-common/goacc/reduction-5.c: New test. * c-c++-common/goacc/reduction-promotions.c: New test. * gfortran.dg/goacc/reduction-3.f95: New test. * gfortran.dg/goacc/reduction-promotions.f90: New test. libgomp/ * testsuite/libgomp.oacc-c-c++-common/loop-reduction-gang-np-1.c: New test. * testsuite/libgomp.oacc-c-c++-common/loop-reduction-gw-np-1.c: New test. * testsuite/libgomp.oacc-c-c++-common/loop-reduction-gwv-np-1.c: New test. * testsuite/libgomp.oacc-c-c++-common/loop-reduction-gwv-np-2.c: New test. * testsuite/libgomp.oacc-c-c++-common/loop-reduction-gwv-np-3.c: New test. * testsuite/libgomp.oacc-c-c++-common/loop-reduction-gwv-np-4.c: New test. * testsuite/libgomp.oacc-c-c++-common/loop-reduction-vector-p-1.c: New test. * testsuite/libgomp.oacc-c-c++-common/loop-reduction-vector-p-2.c: New test. * testsuite/libgomp.oacc-c-c++-common/loop-reduction-worker-p-1.c: New test. * testsuite/libgomp.oacc-c-c++-common/loop-reduction-wv-p-1.c: New test. * testsuite/libgomp.oacc-c-c++-common/loop-reduction-wv-p-2.c: New test. * testsuite/libgomp.oacc-c-c++-common/loop-reduction-wv-p-3.c: New test. * testsuite/libgomp.oacc-c-c++-common/par-loop-comb-reduction-1.c: New test. * testsuite/libgomp.oacc-c-c++-common/par-loop-comb-reduction-2.c: New test. * testsuite/libgomp.oacc-c-c++-common/par-loop-comb-reduction-3.c: New test. * testsuite/libgomp.oacc-c-c++-common/par-loop-comb-reduction-4.c: New test. * testsuite/libgomp.oacc-c-c++-common/par-reduction-1.c: Add test coverage. * testsuite/libgomp.oacc-c-c++-common/par-reduction-2.c: Likewise. * testsuite/libgomp.oacc-c-c++-common/parallel-dims.c: Likewise. * testsuite/libgomp.oacc-c-c++-common/parallel-reduction.c: New test. * testsuite/libgomp.oacc-c-c++-common/pr70289.c: New test. * testsuite/libgomp.oacc-c-c++-common/pr70373.c: New test. * testsuite/libgomp.oacc-c-c++-common/reduction-1.c: Add test coverage. * testsuite/libgomp.oacc-c-c++-common/reduction-2.c: Likewise. * testsuite/libgomp.oacc-c-c++-common/reduction-3.c: Likewise. * testsuite/libgomp.oacc-c-c++-common/reduction-4.c: Likewise. * testsuite/libgomp.oacc-c-c++-common/reduction-5.c: Likewise. * testsuite/libgomp.oacc-c-c++-common/reduction-6.c: New test. * testsuite/libgomp.oacc-c-c++-common/reduction.h: New test. * testsuite/libgomp.oacc-fortran/parallel-reduction.f90: New test. * testsuite/libgomp.oacc-fortran/pr70289.f90: New test. * testsuite/libgomp.oacc-fortran/reduction-1.f90: Add test coverage. * testsuite/libgomp.oacc-fortran/reduction-2.f90: Likewise. * testsuite/libgomp.oacc-fortran/reduction-3.f90: Likewise. * testsuite/libgomp.oacc-fortran/reduction-4.f90: Likewise. * testsuite/libgomp.oacc-fortran/reduction-5.f90: Likewise. * testsuite/libgomp.oacc-fortran/reduction-6.f90: Likewise. * testsuite/libgomp.oacc-fortran/reduction-7.f90: New test. From-SVN: r234840
100 lines
2.0 KiB
Fortran
100 lines
2.0 KiB
Fortran
! { dg-do run }
|
|
! { dg-additional-options "-w" }
|
|
|
|
! subroutine reduction
|
|
|
|
program reduction
|
|
integer, parameter :: n = 40, c = 10
|
|
integer :: i, vsum, gs, ws, vs, cs, ns
|
|
|
|
call redsub_gang (gs, n, c)
|
|
call redsub_worker (ws, n, c)
|
|
call redsub_vector (vs, n, c)
|
|
call redsub_combined (cs, n, c)
|
|
call redsub_nested (ns, n, c)
|
|
|
|
vsum = 0
|
|
|
|
! Verify the results
|
|
do i = 1, n
|
|
vsum = vsum + c
|
|
end do
|
|
|
|
if (gs .ne. vsum) call abort ()
|
|
if (ws .ne. vsum) call abort ()
|
|
if (vs .ne. vsum) call abort ()
|
|
if (cs .ne. vsum) call abort ()
|
|
if (ns .ne. vsum) call abort ()
|
|
end program reduction
|
|
|
|
subroutine redsub_gang(sum, n, c)
|
|
integer :: sum, n, c
|
|
|
|
sum = 0
|
|
|
|
!$acc parallel copyin (n, c) num_gangs(n) copy(sum)
|
|
!$acc loop reduction(+:sum) gang
|
|
do i = 1, n
|
|
sum = sum + c
|
|
end do
|
|
!$acc end parallel
|
|
end subroutine redsub_gang
|
|
|
|
subroutine redsub_worker(sum, n, c)
|
|
integer :: sum, n, c
|
|
|
|
sum = 0
|
|
|
|
!$acc parallel copyin (n, c) num_workers(4) vector_length (32) copy(sum)
|
|
!$acc loop reduction(+:sum) worker
|
|
do i = 1, n
|
|
sum = sum + c
|
|
end do
|
|
!$acc end parallel
|
|
end subroutine redsub_worker
|
|
|
|
subroutine redsub_vector(sum, n, c)
|
|
integer :: sum, n, c
|
|
|
|
sum = 0
|
|
|
|
!$acc parallel copyin (n, c) vector_length(32) copy(sum)
|
|
!$acc loop reduction(+:sum) vector
|
|
do i = 1, n
|
|
sum = sum + c
|
|
end do
|
|
!$acc end parallel
|
|
end subroutine redsub_vector
|
|
|
|
subroutine redsub_combined(sum, n, c)
|
|
integer :: sum, n, c
|
|
|
|
sum = 0
|
|
|
|
!$acc parallel num_gangs (8) num_workers (4) vector_length(32) copy(sum)
|
|
!$acc loop reduction(+:sum) gang worker vector
|
|
do i = 1, n
|
|
sum = sum + c
|
|
end do
|
|
!$acc end parallel
|
|
end subroutine redsub_combined
|
|
|
|
subroutine redsub_nested(sum, n, c)
|
|
integer :: sum, n, c
|
|
integer :: ii, jj
|
|
|
|
ii = n / 10;
|
|
jj = 10;
|
|
sum = 0
|
|
|
|
!$acc parallel num_gangs (8) copy(sum)
|
|
!$acc loop reduction(+:sum) gang
|
|
do i = 1, ii
|
|
!$acc loop reduction(+:sum) vector
|
|
do j = 1, jj
|
|
sum = sum + c
|
|
end do
|
|
end do
|
|
!$acc end parallel
|
|
end subroutine redsub_nested
|