1! { dg-do run }
2! { dg-skip-if "" { *-*-* } { "-DACC_MEM_SHARED=1" } }
3
4! { dg-additional-options "-fopt-info-all-omp" }
5! { dg-additional-options "--param=openacc-privatization=noisy" }
6! { dg-additional-options "-foffload=-fopt-info-all-omp" }
7! { dg-additional-options "-foffload=--param=openacc-privatization=noisy" }
8! for testing/documenting aspects of that functionality.
9
10! Tests to exercise the declare directive along with
11! the clauses: copy
12!              copyin
13!              copyout
14!              create
15!              present
16!              present_or_copy
17!              present_or_copyin
18!              present_or_copyout
19!              present_or_create
20
21module vars
22  implicit none
23  integer z
24  !$acc declare create (z)
25end module vars
26
27subroutine subr5 (a, b, c, d)
28  implicit none
29  integer, parameter :: N = 8
30  integer :: i
31  integer :: a(N)
32  !$acc declare present_or_copyin (a)
33  integer :: b(N)
34  !$acc declare present_or_create (b)
35  integer :: c(N)
36  !$acc declare present_or_copyout (c)
37  integer :: d(N)
38  !$acc declare present_or_copy (d)
39
40  i = 0
41
42  !$acc parallel
43  ! { dg-note {variable 'D\.[0-9]+' declared in block isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } .-1 }
44    do i = 1, N
45      b(i) = a(i)
46      c(i) = b(i)
47      d(i) = d(i) + b(i)
48    end do
49  !$acc end parallel
50
51end subroutine
52
53subroutine subr4 (a, b)
54  implicit none
55  integer, parameter :: N = 8
56  integer :: i
57  integer :: a(N)
58  !$acc declare present (a)
59  integer :: b(N)
60  !$acc declare copyout (b)
61
62  i = 0
63
64  !$acc parallel
65  ! { dg-note {variable 'D\.[0-9]+' declared in block isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } .-1 }
66  do i = 1, N
67    b(i) = a(i)
68  end do
69  !$acc end parallel
70
71end subroutine
72
73subroutine subr3 (a, c)
74  implicit none
75  integer, parameter :: N = 8
76  integer :: i
77  integer :: a(N)
78  !$acc declare present (a)
79  integer :: c(N)
80  !$acc declare copyin (c)
81
82  i = 0
83
84  !$acc parallel
85  ! { dg-note {variable 'D\.[0-9]+' declared in block isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } .-1 }
86  do i = 1, N
87    a(i) = c(i)
88    c(i) = 0
89  end do
90  !$acc end parallel
91
92end subroutine
93
94subroutine subr2 (a, b, c)
95  implicit none
96  integer, parameter :: N = 8
97  integer :: i
98  integer :: a(N)
99  !$acc declare present (a)
100  integer :: b(N)
101  !$acc declare create (b)
102  integer :: c(N)
103  !$acc declare copy (c)
104
105  i = 0
106
107  !$acc parallel
108  ! { dg-note {variable 'D\.[0-9]+' declared in block isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } .-1 }
109  do i = 1, N
110    b(i) = a(i)
111    c(i) = b(i) + c(i) + 1
112  end do
113  !$acc end parallel
114
115end subroutine
116
117subroutine subr1 (a)
118  implicit none
119  integer, parameter :: N = 8
120  integer :: i
121  integer :: a(N)
122  !$acc declare present (a)
123
124  i = 0
125
126  !$acc parallel
127  ! { dg-note {variable 'D\.[0-9]+' declared in block isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } .-1 }
128  do i = 1, N
129    a(i) = a(i) + 1
130  end do
131  !$acc end parallel
132
133end subroutine
134
135subroutine test (a, e)
136  use openacc
137  implicit none
138  logical :: e
139  integer, parameter :: N = 8
140  integer :: a(N)
141
142  if (acc_is_present (a) .neqv. e) STOP 1
143
144end subroutine
145
146subroutine subr0 (a, b, c, d)
147  ! { dg-note {variable 'C\.[0-9]+' declared in block potentially has improper OpenACC privatization level: 'const_decl'} "TODO" { target *-*-* } .-1 }
148  ! { dg-note {variable 'D\.[0-9]+' declared in block isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } .-2 }
149  ! { dg-note {variable 'a\.[0-9]+' declared in block isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } .-3 }
150  implicit none
151  integer, parameter :: N = 8
152  integer :: a(N)
153  !$acc declare copy (a)
154  integer :: b(N)
155  integer :: c(N)
156  integer :: d(N)
157  integer :: i
158
159  call test (a, .true.)
160  call test (b, .false.)
161  call test (c, .false.)
162
163  call subr1 (a)
164
165  call test (a, .true.)
166  call test (b, .false.)
167  call test (c, .false.)
168
169  call subr2 (a, b, c)
170
171  call test (a, .true.)
172  call test (b, .false.)
173  call test (c, .false.)
174
175  do i = 1, N
176    if (c(i) .ne. 8) STOP 2
177  end do
178
179  call subr3 (a, c)
180
181  call test (a, .true.)
182  call test (b, .false.)
183  call test (c, .false.)
184
185  do i = 1, N
186    if (a(i) .ne. 2) STOP 3
187    if (c(i) .ne. 8) STOP 4
188  end do
189
190  call subr4 (a, b)
191
192  call test (a, .true.)
193  call test (b, .false.)
194  call test (c, .false.)
195
196  do i = 1, N
197    if (b(i) .ne. 8) STOP 5
198  end do
199
200  call subr5 (a, b, c, d)
201
202  call test (a, .true.)
203  call test (b, .false.)
204  call test (c, .false.)
205  call test (d, .false.)
206
207  do i = 1, N
208    if (c(i) .ne. 8) STOP 6
209    if (d(i) .ne. 13) STOP 7
210  end do
211
212end subroutine
213
214program main
215  ! { dg-note {variable 'C\.[0-9]+' declared in block potentially has improper OpenACC privatization level: 'const_decl'} "TODO" { target *-*-* } .-1 }
216  ! { dg-note {variable 'D\.[0-9]+' declared in block isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } .-2 }
217  ! { dg-note {variable 'S\.[0-9]+' declared in block isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } .-3 }
218  ! { dg-note {variable 'desc\.[0-9]+' declared in block is candidate for adjusting OpenACC privatization level} "TODO" { target *-*-* } .-4 }
219  use vars
220  use openacc
221  implicit none
222  integer, parameter :: N = 8
223  integer :: a(N)
224  integer :: b(N)
225  integer :: c(N)
226  integer :: d(N)
227  integer :: i
228
229  a(:) = 2
230  b(:) = 3
231  c(:) = 4
232  d(:) = 5
233
234  if (acc_is_present (z) .neqv. .true.) STOP 8
235
236  call subr0 (a, b, c, d)
237
238  call test (a, .false.)
239  call test (b, .false.)
240  call test (c, .false.)
241  call test (d, .false.)
242
243  do i = 1, N
244    if (a(i) .ne. 8) STOP 9
245    if (b(i) .ne. 8) STOP 10
246    if (c(i) .ne. 8) STOP 11
247    if (d(i) .ne. 13) STOP 12
248  end do
249
250end program
251