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