1! { dg-do run }
2
3module vars
4  implicit none
5  real b
6  !$acc declare device_resident (b)
7
8  integer :: x, y, z
9  common /block/ x, y, z
10  !$acc declare device_resident (/block/)
11end module vars
12
13subroutine set()
14  use openacc
15  implicit none
16  integer :: a(5), b(1), c, vals(7)
17  common /another/ a, b, c
18  !$acc declare device_resident (/another/)
19  if (.not. acc_is_present (a)) stop 10
20  if (.not. acc_is_present (b)) stop 11
21  if (.not. acc_is_present (c)) stop 12
22
23  vals = 99
24  ! NOTE: The current (Nov 2019) implementation requires the 'present'
25  ! as it tries to otherwises map the device_resident variables;
26  ! following OpenMP 4.0 semantic: 'a' + 'b' are 'copy' (map fromto) and
27  ! 'c' is firstprivate.
28  !$acc parallel copyout(vals) present(a, b, c)
29    a = [11,12,13,14,15]
30    b = 16
31    c = 47
32    vals(1:5) = a
33    vals(6:6) = b
34    vals(7) = c
35  !$acc end parallel
36
37  if (.not. acc_is_present (a)) stop 13
38  if (.not. acc_is_present (b)) stop 14
39  if (.not. acc_is_present (c)) stop 15
40
41  if (any (vals /= [11,12,13,14,15,16,47])) stop 16
42end subroutine set
43
44subroutine check()
45  use openacc
46  implicit none
47  integer :: g, h(3), i(3)
48  common /another/ g, h, i
49  integer :: val(7)
50  !$acc declare device_resident (/another/)
51  if (.not. acc_is_present (g)) stop 20
52  if (.not. acc_is_present (h)) stop 21
53  if (.not. acc_is_present (i)) stop 22
54
55  val = 99
56  !$acc parallel copyout(val) present(g, h, i)
57    val(5:7) = i
58    val(1) = g
59    val(2:4) = h
60  !$acc end parallel
61
62  if (.not. acc_is_present (g)) stop 23
63  if (.not. acc_is_present (h)) stop 24
64  if (.not. acc_is_present (i)) stop 25
65
66
67  !print *, val
68  if (any (val /= [11,12,13,14,15,16,47])) stop 26
69end subroutine check
70
71
72program test
73  use vars
74  use openacc
75  implicit none
76  real a
77  integer :: k
78
79  call set()
80  call check()
81
82  if (.not. acc_is_present (b)) stop 1
83  if (.not. acc_is_present (x)) stop 2
84  if (.not. acc_is_present (y)) stop 3
85  if (.not. acc_is_present (z)) stop 4
86
87  a = 2.0
88  k = 42
89
90  !$acc parallel copy (a, k)
91    b = a
92    a = 1.0
93    a = a + b
94    x = k
95    y = 7*k - 2*x
96    z = 3*y
97    k = k - z + y
98   !$acc end parallel
99
100  if (.not. acc_is_present (b)) stop 5
101  if (.not. acc_is_present (x)) stop 6
102  if (.not. acc_is_present (y)) stop 7
103  if (.not. acc_is_present (z)) stop 8
104
105  if (a /= 3.0) stop 30
106  if (k /= -378) stop 31
107end program test
108