9106c51e57
Fix-up for commit b71ff8c15f "Fortran: improve
location data for OpenACC/OpenMP directives [PR97782]".
libgomp/
PR fortran/97782
* testsuite/libgomp.oacc-fortran/attach-descriptor-1.f90: Adjust.
124 lines
3.0 KiB
Fortran
124 lines
3.0 KiB
Fortran
! { dg-do run }
|
|
! { dg-skip-if "" { *-*-* } { "*" } { "-DACC_MEM_SHARED=0" } }
|
|
|
|
subroutine test(variant)
|
|
use openacc
|
|
implicit none
|
|
integer :: variant
|
|
type t
|
|
integer :: arr1(10)
|
|
integer, allocatable :: arr2(:)
|
|
end type t
|
|
integer :: i
|
|
type(t) :: myvar
|
|
integer, target :: tarr(10)
|
|
integer, pointer :: myptr(:)
|
|
|
|
allocate(myvar%arr2(10))
|
|
|
|
do i=1,10
|
|
myvar%arr1(i) = 0
|
|
myvar%arr2(i) = 0
|
|
tarr(i) = 0
|
|
end do
|
|
|
|
call acc_copyin(myvar)
|
|
call acc_copyin(myvar%arr2)
|
|
call acc_copyin(tarr)
|
|
|
|
myptr => tarr
|
|
|
|
if (variant == 0 &
|
|
.or. variant == 3 &
|
|
.or. variant == 5) then
|
|
!$acc enter data attach(myvar%arr2, myptr)
|
|
else if (variant == 1 &
|
|
.or. variant == 2 &
|
|
.or. variant == 4) then
|
|
!$acc enter data attach(myvar%arr2, myptr)
|
|
!$acc enter data attach(myvar%arr2, myptr)
|
|
else
|
|
! Internal error.
|
|
stop 1
|
|
end if
|
|
|
|
!$acc serial present(myvar%arr2)
|
|
! { dg-warning "using vector_length \\(32\\), ignoring 1" "" { target openacc_nvidia_accel_selected } .-1 }
|
|
do i=1,10
|
|
myvar%arr1(i) = i + variant
|
|
myvar%arr2(i) = i - variant
|
|
end do
|
|
myptr(3) = 99 - variant
|
|
!$acc end serial
|
|
|
|
if (variant == 0) then
|
|
!$acc exit data detach(myvar%arr2, myptr)
|
|
else if (variant == 1) then
|
|
!$acc exit data detach(myvar%arr2, myptr)
|
|
!$acc exit data detach(myvar%arr2, myptr)
|
|
else if (variant == 2) then
|
|
!$acc exit data detach(myvar%arr2, myptr)
|
|
!$acc exit data detach(myvar%arr2, myptr) finalize
|
|
else if (variant == 3 &
|
|
.or. variant == 4) then
|
|
!$acc exit data detach(myvar%arr2, myptr) finalize
|
|
else if (variant == 5) then
|
|
! Do not detach.
|
|
else
|
|
! Internal error.
|
|
stop 2
|
|
end if
|
|
|
|
if (.not. acc_is_present(myvar%arr2)) stop 10
|
|
if (.not. acc_is_present(myvar)) stop 11
|
|
if (.not. acc_is_present(tarr)) stop 12
|
|
|
|
call acc_copyout(myvar%arr2)
|
|
if (acc_is_present(myvar%arr2)) stop 20
|
|
if (.not. acc_is_present(myvar)) stop 21
|
|
if (.not. acc_is_present(tarr)) stop 22
|
|
call acc_copyout(myvar)
|
|
if (acc_is_present(myvar%arr2)) stop 30
|
|
if (acc_is_present(myvar)) stop 31
|
|
if (.not. acc_is_present(tarr)) stop 32
|
|
call acc_copyout(tarr)
|
|
if (acc_is_present(myvar%arr2)) stop 40
|
|
if (acc_is_present(myvar)) stop 41
|
|
if (acc_is_present(tarr)) stop 42
|
|
|
|
do i=1,10
|
|
if (myvar%arr1(i) .ne. i + variant) stop 50
|
|
if (variant == 5) then
|
|
! We have not detached, so have copyied out a device pointer, so cannot
|
|
! access 'myvar%arr2' on the host.
|
|
else
|
|
if (myvar%arr2(i) .ne. i - variant) stop 51
|
|
end if
|
|
end do
|
|
if (tarr(3) .ne. 99 - variant) stop 52
|
|
|
|
if (variant == 5) then
|
|
! If not explicitly stopping here, we'd in the following try to deallocate
|
|
! the device pointer on the host, SIGSEGV.
|
|
stop
|
|
end if
|
|
end subroutine test
|
|
|
|
program att
|
|
implicit none
|
|
|
|
call test(0)
|
|
|
|
call test(1)
|
|
|
|
call test(2)
|
|
|
|
call test(3)
|
|
|
|
call test(4)
|
|
|
|
call test(5)
|
|
! Make sure that 'test(5)' has stopped the program.
|
|
stop 60
|
|
end program att
|