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