mirror of
https://gcc.gnu.org/git/gcc.git
synced 2024-11-24 11:24:05 +08:00
7981524755
Fix-up for recent commit r13-116-g3f8c389fe90bf565a6221a46bb7fb745dd4c1510
"OpenMP: Fix use_device_{addr,ptr} with in-data-sharing arg", where we
currently get:
libgomp: use_device_ptr pointer wasn't mapped
FAIL: libgomp.fortran/use_device_addr-5.f90 -O execution test
libgomp/
* testsuite/libgomp.fortran/use_device_addr-5.f90: Fix up
multi-device testing.
144 lines
5.4 KiB
Fortran
144 lines
5.4 KiB
Fortran
program main
|
|
use omp_lib
|
|
implicit none
|
|
integer, allocatable :: aaa(:,:,:)
|
|
integer :: i
|
|
|
|
allocate (aaa(-4:10,-3:8,2))
|
|
aaa(:,:,:) = reshape ([(i, i = 1, size(aaa))], shape(aaa))
|
|
|
|
do i = 0, omp_get_num_devices()
|
|
!$omp target data map(to: aaa) device(i)
|
|
call test_addr (aaa, i)
|
|
call test_ptr (aaa, i)
|
|
!$omp end target data
|
|
end do
|
|
deallocate (aaa)
|
|
|
|
contains
|
|
|
|
subroutine test_addr (aaaa, dev)
|
|
use iso_c_binding
|
|
integer, target, allocatable :: aaaa(:,:,:), bbbb(:,:,:)
|
|
integer, value :: dev
|
|
integer :: i
|
|
type(c_ptr) :: ptr
|
|
logical :: is_shared
|
|
|
|
is_shared = .false.
|
|
!$omp target device(dev) map(to: is_shared)
|
|
is_shared = .true.
|
|
!$omp end target
|
|
|
|
allocate (bbbb(-4:10,-3:8,2))
|
|
bbbb(:,:,:) = reshape ([(-i, i = 1, size(bbbb))], shape(bbbb))
|
|
!$omp target enter data map(to: bbbb) device(dev)
|
|
if (any (lbound (aaaa) /= [-4, -3, 1])) error stop 1
|
|
if (any (shape (aaaa) /= [15, 12, 2])) error stop 2
|
|
if (any (lbound (bbbb) /= [-4, -3, 1])) error stop 3
|
|
if (any (shape (bbbb) /= [15, 12, 2])) error stop 4
|
|
if (any (aaaa /= -bbbb)) error stop 5
|
|
if (any (aaaa /= reshape ([(i, i = 1, size(aaaa))], shape(aaaa)))) &
|
|
error stop 6
|
|
|
|
!$omp parallel do shared(bbbb, aaaa)
|
|
do i = 1,1
|
|
if (any (lbound (aaaa) /= [-4, -3, 1])) error stop 5
|
|
if (any (shape (aaaa) /= [15, 12, 2])) error stop 6
|
|
if (any (lbound (bbbb) /= [-4, -3, 1])) error stop 7
|
|
if (any (shape (bbbb) /= [15, 12, 2])) error stop 8
|
|
if (any (aaaa /= -bbbb)) error stop 5
|
|
if (any (aaaa /= reshape ([(i, i = 1, size(aaaa))], shape(aaaa)))) &
|
|
error stop 6
|
|
ptr = c_loc (aaaa)
|
|
!$omp target data use_device_addr(bbbb, aaaa) device(dev)
|
|
if (any (lbound (aaaa) /= [-4, -3, 1])) error stop 9
|
|
if (any (shape (aaaa) /= [15, 12, 2])) error stop 10
|
|
if (any (lbound (bbbb) /= [-4, -3, 1])) error stop 11
|
|
if (any (shape (bbbb) /= [15, 12, 2])) error stop 12
|
|
if (is_shared) then
|
|
if (any (aaaa /= -bbbb)) error stop 5
|
|
if (any (aaaa /= reshape ([(i, i = 1, size(aaaa))], shape(aaaa)))) &
|
|
error stop 6
|
|
end if
|
|
if (is_shared .neqv. c_associated (ptr, c_loc (aaaa))) error stop
|
|
|
|
!$omp target has_device_addr(bbbb, aaaa) device(dev)
|
|
if (any (lbound (aaaa) /= [-4, -3, 1])) error stop 9
|
|
if (any (shape (aaaa) /= [15, 12, 2])) error stop 10
|
|
if (any (lbound (bbbb) /= [-4, -3, 1])) error stop 11
|
|
if (any (shape (bbbb) /= [15, 12, 2])) error stop 12
|
|
if (any (aaaa /= -bbbb)) error stop 5
|
|
if (any (aaaa /= reshape ([(i, i = 1, size(aaaa))], shape(aaaa)))) &
|
|
error stop 6
|
|
!$omp end target
|
|
!$omp end target data
|
|
end do
|
|
!$omp target exit data map(delete: bbbb) device(dev)
|
|
deallocate (bbbb)
|
|
end subroutine test_addr
|
|
|
|
subroutine test_ptr (aaaa, dev)
|
|
use iso_c_binding
|
|
integer, target, allocatable :: aaaa(:,:,:), bbbb(:,:,:)
|
|
integer, value :: dev
|
|
integer :: i
|
|
type(c_ptr) :: ptr
|
|
logical :: is_shared
|
|
|
|
is_shared = .false.
|
|
!$omp target device(dev) map(to: is_shared)
|
|
is_shared = .true.
|
|
!$omp end target
|
|
|
|
allocate (bbbb(-4:10,-3:8,2))
|
|
bbbb(:,:,:) = reshape ([(-i, i = 1, size(bbbb))], shape(bbbb))
|
|
!$omp target enter data map(to: bbbb) device(dev)
|
|
if (any (lbound (aaaa) /= [-4, -3, 1])) error stop 1
|
|
if (any (shape (aaaa) /= [15, 12, 2])) error stop 2
|
|
if (any (lbound (bbbb) /= [-4, -3, 1])) error stop 3
|
|
if (any (shape (bbbb) /= [15, 12, 2])) error stop 4
|
|
if (any (aaaa /= -bbbb)) error stop 5
|
|
if (any (aaaa /= reshape ([(i, i = 1, size(aaaa))], shape(aaaa)))) &
|
|
error stop 6
|
|
|
|
!$omp parallel do shared(bbbb, aaaa)
|
|
do i = 1,1
|
|
if (any (lbound (aaaa) /= [-4, -3, 1])) error stop 5
|
|
if (any (shape (aaaa) /= [15, 12, 2])) error stop 6
|
|
if (any (lbound (bbbb) /= [-4, -3, 1])) error stop 7
|
|
if (any (shape (bbbb) /= [15, 12, 2])) error stop 8
|
|
if (any (aaaa /= -bbbb)) error stop 5
|
|
if (any (aaaa /= reshape ([(i, i = 1, size(aaaa))], shape(aaaa)))) &
|
|
error stop 6
|
|
ptr = c_loc (aaaa)
|
|
!$omp target data use_device_ptr(bbbb, aaaa) device(dev)
|
|
if (any (lbound (aaaa) /= [-4, -3, 1])) error stop 9
|
|
if (any (shape (aaaa) /= [15, 12, 2])) error stop 10
|
|
if (any (lbound (bbbb) /= [-4, -3, 1])) error stop 11
|
|
if (any (shape (bbbb) /= [15, 12, 2])) error stop 12
|
|
if (is_shared) then
|
|
if (any (aaaa /= -bbbb)) error stop 5
|
|
if (any (aaaa /= reshape ([(i, i = 1, size(aaaa))], shape(aaaa)))) &
|
|
error stop 6
|
|
end if
|
|
if (is_shared .neqv. c_associated (ptr, c_loc (aaaa))) error stop
|
|
|
|
! Uses has_device_addr due to PR fortran/105318
|
|
!!$omp target is_device_ptr(bbbb, aaaa) device(dev)
|
|
!$omp target has_device_addr(bbbb, aaaa) device(dev)
|
|
if (any (lbound (aaaa) /= [-4, -3, 1])) error stop 9
|
|
if (any (shape (aaaa) /= [15, 12, 2])) error stop 10
|
|
if (any (lbound (bbbb) /= [-4, -3, 1])) error stop 11
|
|
if (any (shape (bbbb) /= [15, 12, 2])) error stop 12
|
|
if (any (aaaa /= -bbbb)) error stop 5
|
|
if (any (aaaa /= reshape ([(i, i = 1, size(aaaa))], shape(aaaa)))) &
|
|
error stop 6
|
|
!$omp end target
|
|
!$omp end target data
|
|
end do
|
|
!$omp target exit data map(delete: bbbb) device(dev)
|
|
deallocate (bbbb)
|
|
end subroutine test_ptr
|
|
end program main
|