1! { dg-do run } 2! { dg-skip-if "" { *-*-* } { "*" } { "-DACC_MEM_SHARED=0" } } 3 4subroutine test(variant) 5 use openacc 6 implicit none 7 integer :: variant 8 type t 9 integer :: arr1(10) 10 integer, allocatable :: arr2(:) 11 end type t 12 integer :: i 13 type(t) :: myvar 14 integer, target :: tarr(10) 15 integer, pointer :: myptr(:) 16 17 allocate(myvar%arr2(10)) 18 19 do i=1,10 20 myvar%arr1(i) = 0 21 myvar%arr2(i) = 0 22 tarr(i) = 0 23 end do 24 25 call acc_copyin(myvar) 26 call acc_copyin(myvar%arr2) 27 call acc_copyin(tarr) 28 29 myptr => tarr 30 31 if (variant == 0 & 32 .or. variant == 3 & 33 .or. variant == 5) then 34 !$acc enter data attach(myvar%arr2, myptr) 35 else if (variant == 1 & 36 .or. variant == 2 & 37 .or. variant == 4) then 38 !$acc enter data attach(myvar%arr2, myptr) 39 !$acc enter data attach(myvar%arr2, myptr) 40 else 41 ! Internal error. 42 stop 1 43 end if 44 45 !$acc serial present(myvar%arr2) 46 ! { dg-warning "using vector_length \\(32\\), ignoring 1" "" { target openacc_nvidia_accel_selected } .-1 } 47 do i=1,10 48 myvar%arr1(i) = i + variant 49 myvar%arr2(i) = i - variant 50 end do 51 myptr(3) = 99 - variant 52 !$acc end serial 53 54 if (variant == 0) then 55 !$acc exit data detach(myvar%arr2, myptr) 56 else if (variant == 1) then 57 !$acc exit data detach(myvar%arr2, myptr) 58 !$acc exit data detach(myvar%arr2, myptr) 59 else if (variant == 2) then 60 !$acc exit data detach(myvar%arr2, myptr) 61 !$acc exit data detach(myvar%arr2, myptr) finalize 62 else if (variant == 3 & 63 .or. variant == 4) then 64 !$acc exit data detach(myvar%arr2, myptr) finalize 65 else if (variant == 5) then 66 ! Do not detach. 67 else 68 ! Internal error. 69 stop 2 70 end if 71 72 if (.not. acc_is_present(myvar%arr2)) stop 10 73 if (.not. acc_is_present(myvar)) stop 11 74 if (.not. acc_is_present(tarr)) stop 12 75 76 call acc_copyout(myvar%arr2) 77 if (acc_is_present(myvar%arr2)) stop 20 78 if (.not. acc_is_present(myvar)) stop 21 79 if (.not. acc_is_present(tarr)) stop 22 80 call acc_copyout(myvar) 81 if (acc_is_present(myvar%arr2)) stop 30 82 if (acc_is_present(myvar)) stop 31 83 if (.not. acc_is_present(tarr)) stop 32 84 call acc_copyout(tarr) 85 if (acc_is_present(myvar%arr2)) stop 40 86 if (acc_is_present(myvar)) stop 41 87 if (acc_is_present(tarr)) stop 42 88 89 do i=1,10 90 if (myvar%arr1(i) .ne. i + variant) stop 50 91 if (variant == 5) then 92 ! We have not detached, so have copyied out a device pointer, so cannot 93 ! access 'myvar%arr2' on the host. 94 else 95 if (myvar%arr2(i) .ne. i - variant) stop 51 96 end if 97 end do 98 if (tarr(3) .ne. 99 - variant) stop 52 99 100 if (variant == 5) then 101 ! If not explicitly stopping here, we'd in the following try to deallocate 102 ! the device pointer on the host, SIGSEGV. 103 stop 104 end if 105end subroutine test 106 107program att 108 implicit none 109 110 call test(0) 111 112 call test(1) 113 114 call test(2) 115 116 call test(3) 117 118 call test(4) 119 120 call test(5) 121 ! Make sure that 'test(5)' has stopped the program. 122 stop 60 123end program att 124