11586ed9c9
* testsuite/libgomp.fortran/use_device_addr-3.f90: Make 'stop' codes
unique.
* testsuite/libgomp.fortran/use_device_addr-4.f90: Ditto.
* testsuite/libgomp.fortran/use_device_ptr-optional-2.f90: Ditto.
* testsuite/libgomp.oacc-fortran/declare-5.f90: Ditto.
* testsuite/libgomp.oacc-fortran/optional-data-copyin-by-value.f90:
Ditto.
* testsuite/libgomp.oacc-fortran/optional-firstprivate.f90: Ditto.
* testsuite/libgomp.oacc-fortran/optional-update-host.f90: Ditto.
From-SVN: r279117
116 lines
2.4 KiB
Fortran
116 lines
2.4 KiB
Fortran
! Test OpenACC update to host with an optional argument.
|
|
|
|
! { dg-do run }
|
|
|
|
program optional_update_host
|
|
implicit none
|
|
|
|
integer, parameter :: n = 64
|
|
integer :: i
|
|
integer :: a_int, b_int, res_int
|
|
integer :: a_arr(n), b_arr(n), res_arr(n)
|
|
integer, allocatable :: a_alloc(:), b_alloc(:), res_alloc(:)
|
|
|
|
a_int = 5
|
|
b_int = 11
|
|
res_int = 0
|
|
|
|
call test_int(a_int, b_int)
|
|
if (res_int .ne. 0) stop 1
|
|
|
|
call test_int(a_int, b_int, res_int)
|
|
if (res_int .ne. a_int * b_int) stop 2
|
|
|
|
res_arr(:) = 0
|
|
do i = 1, n
|
|
a_arr(i) = i
|
|
b_arr(i) = n - i + 1
|
|
end do
|
|
|
|
call test_array(a_arr, b_arr)
|
|
do i = 1, n
|
|
if (res_arr(i) .ne. 0) stop 3
|
|
end do
|
|
|
|
call test_array(a_arr, b_arr, res_arr)
|
|
do i = 1, n
|
|
if (res_arr(i) .ne. a_arr(i) * b_arr(i)) stop 4
|
|
end do
|
|
|
|
allocate(a_alloc(n))
|
|
allocate(b_alloc(n))
|
|
allocate(res_alloc(n))
|
|
|
|
res_alloc(:) = 0
|
|
do i = 1, n
|
|
a_alloc(i) = i
|
|
b_alloc(i) = n - i + 1
|
|
end do
|
|
|
|
call test_allocatable(a_alloc, b_alloc)
|
|
do i = 1, n
|
|
if (res_alloc(i) .ne. 0) stop 5
|
|
end do
|
|
|
|
call test_allocatable(a_alloc, b_alloc, res_alloc)
|
|
do i = 1, n
|
|
if (res_alloc(i) .ne. a_alloc(i) * b_alloc(i)) stop 6
|
|
end do
|
|
|
|
deallocate(a_alloc)
|
|
deallocate(b_alloc)
|
|
deallocate(res_alloc)
|
|
contains
|
|
subroutine test_int(a, b, res)
|
|
integer :: a, b
|
|
integer, optional :: res
|
|
|
|
!$acc data create(a, b, res)
|
|
!$acc update device(a, b)
|
|
!$acc parallel
|
|
if (present(res)) res = a
|
|
if (present(res)) res = res * b
|
|
!$acc end parallel
|
|
!$acc update self(res)
|
|
!$acc end data
|
|
end subroutine test_int
|
|
|
|
subroutine test_array(a, b, res)
|
|
integer :: a(n), b(n)
|
|
integer, optional :: res(n)
|
|
|
|
!$acc data create(a, b, res)
|
|
!$acc update device(a, b)
|
|
!$acc parallel loop
|
|
do i = 1, n
|
|
if (present(res)) res(i) = a(i)
|
|
end do
|
|
|
|
!$acc parallel loop
|
|
do i = 1, n
|
|
if (present(res)) res(i) = res(i) * b(i)
|
|
end do
|
|
!$acc update self(res)
|
|
!$acc end data
|
|
end subroutine test_array
|
|
|
|
subroutine test_allocatable(a, b, res)
|
|
integer, allocatable :: a(:), b(:)
|
|
integer, allocatable, optional :: res(:)
|
|
|
|
!$acc data create(a, b, res)
|
|
!$acc update device(a, b)
|
|
!$acc parallel loop
|
|
do i = 1, n
|
|
if (present(res)) res(i) = a(i)
|
|
end do
|
|
|
|
!$acc parallel loop
|
|
do i = 1, n
|
|
if (present(res)) res(i) = res(i) * b(i)
|
|
end do
|
|
!$acc update self(res)
|
|
!$acc end data
|
|
end subroutine test_allocatable
|
|
end program optional_update_host
|