2aea19bdb1
gcc/ChangeLog: * config/nvptx/nvptx.cc (nvptx_goacc_validate_dims_1): Update warning messages. libgomp/ChangeLog: * testsuite/libgomp.oacc-c++/privatized-ref-2.C: Update scanning patterns. * testsuite/libgomp.oacc-c++/privatized-ref-3.C: Likewise. * testsuite/libgomp.oacc-c-c++-common/acc_prof-kernels-1.c: Likewise. * testsuite/libgomp.oacc-c-c++-common/kernels-loop-2.c: Likewise. * testsuite/libgomp.oacc-c-c++-common/parallel-dims.c: Likewise. * testsuite/libgomp.oacc-c-c++-common/pr85486.c: Likewise. * testsuite/libgomp.oacc-c-c++-common/pr95270-1.c: Likewise. * testsuite/libgomp.oacc-c-c++-common/routine-nohost-2.c: Likewise. * testsuite/libgomp.oacc-c-c++-common/struct-copyout-1.c: Likewise. * testsuite/libgomp.oacc-c-c++-common/struct-copyout-2.c: Likewise. * testsuite/libgomp.oacc-c-c++-common/vector-length-64-1.c: Likewise. * testsuite/libgomp.oacc-fortran/attach-descriptor-1.f90: Likewise. * testsuite/libgomp.oacc-fortran/derivedtypes-arrays-1.f90: Likewise. * testsuite/libgomp.oacc-fortran/kernels-loop-2.f95: Likewise. * testsuite/libgomp.oacc-fortran/parallel-dims.f90: Likewise. * testsuite/libgomp.oacc-fortran/privatized-ref-1.f95: Likewise. Co-authored-by: Thomas Schwinge <thomas@codesourcery.com>
123 lines
3 KiB
Fortran
123 lines
3 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
|