6e4d01d61f
2019-12-06 Tobias Burnus <tobias@codesourcery.com>
Kwok Cheung Yeung <kcy@codesourcery.com>
gcc/fortran/
* trans-openmp.c (gfc_build_conditional_assign,
gfc_build_conditional_assign_expr): New static functions.
(gfc_omp_finish_clause, gfc_trans_omp_clauses): Handle mapping of
absent optional arguments and fix mapping of present optional args.
gcc/
* omp-low.c (lower_omp_target): For optional arguments, deref once
more to obtain the type.
libgomp/
* oacc-mem.c (update_dev_host, gomp_acc_insert_pointer): Just return
if input it a NULL pointer.
* testsuite/libgomp.oacc-c-c++-common/lib-43.c: Remove; dependent on
diagnostic of NULL pointer.
* testsuite/libgomp.oacc-c-c++-common/lib-47.c: Ditto.
* testsuite/libgomp.fortran/optional-map.f90: New.
* testsuite/libgomp.fortran/use_device_addr-1.f90
(test_dummy_opt_callee_1_absent): New.
(test_dummy_opt_call_1): Call it.
* testsuite/libgomp.fortran/use_device_addr-2.f90: Likewise.
* testsuite/libgomp.fortran/use_device_addr-3.f90: Likewise.
* testsuite/libgomp.fortran/use_device_addr-4.f90: Likewise.
* testsuite/libgomp.oacc-fortran/optional-cache.f95: New.
* testsuite/libgomp.oacc-fortran/optional-data-copyin-by-value.f90: New.
* testsuite/libgomp.oacc-fortran/optional-data-copyin.f90: New.
* testsuite/libgomp.oacc-fortran/optional-data-copyout.f90: New.
* testsuite/libgomp.oacc-fortran/optional-data-enter-exit.f90: New.
* testsuite/libgomp.oacc-fortran/optional-declare.f90: New.
* testsuite/libgomp.oacc-fortran/optional-firstprivate.f90: New.
* testsuite/libgomp.oacc-fortran/optional-host_data.f90: New.
* testsuite/libgomp.oacc-fortran/optional-nested-calls.f90: New.
* testsuite/libgomp.oacc-fortran/optional-private.f90: New.
* testsuite/libgomp.oacc-fortran/optional-reduction.f90: New.
* testsuite/libgomp.oacc-fortran/optional-update-device.f90: New.
* testsuite/libgomp.oacc-fortran/optional-update-host.f90: New.
Co-Authored-By: Kwok Cheung Yeung <kcy@codesourcery.com>
From-SVN: r279043
116 lines
2.6 KiB
Fortran
116 lines
2.6 KiB
Fortran
! Test that optional arguments work in private clauses. The effect of
|
|
! non-present arguments in private clauses is undefined, and is not tested
|
|
! for. The tests are based on those in private-variables.f90.
|
|
|
|
! { dg-do run }
|
|
|
|
program main
|
|
implicit none
|
|
|
|
type vec3
|
|
integer x, y, z, attr(13)
|
|
end type vec3
|
|
integer :: x
|
|
type(vec3) :: pt
|
|
integer :: arr(2)
|
|
|
|
call t1(x)
|
|
call t2(pt)
|
|
call t3(arr)
|
|
contains
|
|
|
|
! Test of gang-private variables declared on loop directive.
|
|
|
|
subroutine t1(x)
|
|
integer, optional :: x
|
|
integer :: i, arr(32)
|
|
|
|
do i = 1, 32
|
|
arr(i) = i
|
|
end do
|
|
|
|
!$acc parallel copy(arr) num_gangs(32) num_workers(8) vector_length(32)
|
|
!$acc loop gang private(x)
|
|
do i = 1, 32
|
|
x = i * 2;
|
|
arr(i) = arr(i) + x
|
|
end do
|
|
!$acc end parallel
|
|
|
|
do i = 1, 32
|
|
if (arr(i) .ne. i * 3) STOP 1
|
|
end do
|
|
end subroutine t1
|
|
|
|
|
|
! Test of gang-private addressable variable declared on loop directive, with
|
|
! broadcasting to partitioned workers.
|
|
|
|
subroutine t2(pt)
|
|
integer i, j, arr(0:32*32)
|
|
type(vec3), optional :: pt
|
|
|
|
do i = 0, 32*32-1
|
|
arr(i) = i
|
|
end do
|
|
|
|
!$acc parallel copy(arr) num_gangs(32) num_workers(8) vector_length(32)
|
|
!$acc loop gang private(pt)
|
|
do i = 0, 31
|
|
pt%x = i
|
|
pt%y = i * 2
|
|
pt%z = i * 4
|
|
pt%attr(5) = i * 6
|
|
|
|
!$acc loop vector
|
|
do j = 0, 31
|
|
arr(i * 32 + j) = arr(i * 32 + j) + pt%x + pt%y + pt%z + pt%attr(5);
|
|
end do
|
|
end do
|
|
!$acc end parallel
|
|
|
|
do i = 0, 32 * 32 - 1
|
|
if (arr(i) .ne. i + (i / 32) * 13) STOP 2
|
|
end do
|
|
end subroutine t2
|
|
|
|
! Test of vector-private variables declared on loop directive. Array type.
|
|
|
|
subroutine t3(pt)
|
|
integer, optional :: pt(2)
|
|
integer :: i, j, k, idx, arr(0:32*32*32)
|
|
|
|
do i = 0, 32*32*32-1
|
|
arr(i) = i
|
|
end do
|
|
|
|
!$acc parallel copy(arr) num_gangs(32) num_workers(8) vector_length(32)
|
|
!$acc loop gang
|
|
do i = 0, 31
|
|
!$acc loop worker
|
|
do j = 0, 31
|
|
!$acc loop vector private(pt)
|
|
do k = 0, 31
|
|
pt(1) = ieor(i, j * 3)
|
|
pt(2) = ior(i, j * 5)
|
|
arr(i * 1024 + j * 32 + k) = arr(i * 1024 + j * 32 + k) + pt(1) * k
|
|
arr(i * 1024 + j * 32 + k) = arr(i * 1024 + j * 32 + k) + pt(2) * k
|
|
end do
|
|
end do
|
|
end do
|
|
!$acc end parallel
|
|
|
|
do i = 0, 32 - 1
|
|
do j = 0, 32 -1
|
|
do k = 0, 32 - 1
|
|
idx = i * 1024 + j * 32 + k
|
|
if (arr(idx) .ne. idx + ieor(i, j * 3) * k + ior(i, j * 5) * k) then
|
|
STOP 3
|
|
end if
|
|
end do
|
|
end do
|
|
end do
|
|
end subroutine t3
|
|
|
|
end program main
|