1
2! { dg-do run }
3! { dg-additional-options "-cpp" }
4
5! { dg-additional-options "-fopt-info-note-omp" }
6! { dg-additional-options "--param=openacc-privatization=noisy" }
7! { dg-additional-options "-foffload=-fopt-info-note-omp" }
8! { dg-additional-options "-foffload=--param=openacc-privatization=noisy" }
9! for testing/documenting aspects of that functionality.
10
11! { dg-additional-options "-Wopenacc-parallelism" } for testing/documenting
12! aspects of that functionality.
13!TODO { dg-additional-options "-fno-inline" } for stable results regarding OpenACC 'routine'.
14
15#define M 8
16#define N 32
17
18program main
19  integer :: i
20  integer :: a(N)
21  integer :: b(M * N)
22
23  do i = 1, N
24    a(i) = 0
25  end do
26
27  !$acc parallel copy (a)
28  !$acc loop seq
29  ! { dg-note {variable 'i' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } .-1 }
30    do i = 1, N
31      call seq (a)
32    end do
33  !$acc end parallel
34
35  do i = 1, N
36    if (a(i) .ne.N) STOP 1
37  end do
38
39  !$acc parallel copy (a)
40  !$acc loop seq
41  ! { dg-note {variable 'i' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } .-1 }
42    do i = 1, N
43      call gang (a)
44    end do
45  !$acc end parallel
46
47  do i = 1, N
48    if (a(i) .ne. (N + (N * (-1 * i)))) STOP 2
49  end do
50
51  do i = 1, N
52    b(i) = i
53  end do
54
55  !$acc parallel copy (b)
56  !$acc loop seq
57  ! { dg-note {variable 'i' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } .-1 }
58    do i = 1, N
59      call worker (b)
60    end do
61  !$acc end parallel
62
63  do i = 1, N
64    if (b(i) .ne. N + i) STOP 3
65  end do
66
67  do i = 1, N
68    a(i) = i
69  end do
70
71  !$acc parallel copy (a)
72  !$acc loop seq
73  ! { dg-note {variable 'i' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } .-1 }
74    do i = 1, N
75      call vector (a)
76    end do
77  !$acc end parallel
78
79  do i = 1, N
80    if (a(i) .ne. 0) STOP 4
81  end do
82
83contains
84
85subroutine vector (a)
86  !$acc routine vector
87  integer, intent (inout) :: a(N)
88  integer :: i
89
90  !$acc loop vector
91  ! { dg-note {variable 'i' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } .-1 }
92  do i = 1, N
93    a(i) = a(i) - a(i)
94  end do
95
96end subroutine vector
97
98subroutine worker (b)
99  !$acc routine worker
100  integer, intent (inout) :: b(M*N)
101  integer :: i, j
102
103  !$acc loop worker
104  ! { dg-note {variable 'i' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } .-1 }
105  do i = 1, N
106  !$acc loop vector
107     ! { dg-note {variable 'j' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } .-1 }
108    do j = 1, M
109      b(j + ((i - 1) * M)) = b(j + ((i - 1) * M)) + 1
110    end do
111  end do
112
113end subroutine worker
114
115subroutine gang (a)
116  !$acc routine gang
117  ! { dg-warning "region is worker partitioned but does not contain worker partitioned code" "" { target *-*-* } .-2 }
118  ! { dg-warning "region is vector partitioned but does not contain vector partitioned code" "" { target *-*-* } .-3 }
119  integer, intent (inout) :: a(N)
120  integer :: i
121
122  !$acc loop gang
123  ! { dg-note {variable 'i' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } .-1 }
124  do i = 1, N
125    a(i) = a(i) - i
126  end do
127
128end subroutine gang
129
130subroutine seq (a)
131  !$acc routine seq
132  integer, intent (inout) :: a(N)
133  integer :: i
134
135  do i = 1, N
136    a(i) = a(i) + 1
137  end do
138
139end subroutine seq
140
141end program main
142