! { 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