1! Test that optional arguments work in private clauses.  The effect of
2! non-present arguments in private clauses is undefined, and is not tested
3! for.  The tests are based on those in private-variables.f90.
4
5! { dg-do run }
6
7! { dg-additional-options "-fopt-info-note-omp" }
8! { dg-additional-options "--param=openacc-privatization=noisy" }
9! { dg-additional-options "-foffload=-fopt-info-note-omp" }
10! { dg-additional-options "-foffload=--param=openacc-privatization=noisy" }
11! for testing/documenting aspects of that functionality.
12
13! { dg-additional-options "-Wopenacc-parallelism" } for testing/documenting
14! aspects of that functionality.
15
16
17program main
18  implicit none
19
20  type vec3
21     integer x, y, z, attr(13)
22  end type vec3
23  integer :: x
24  type(vec3) :: pt
25  integer :: arr(2)
26
27  call t1(x)
28  call t2(pt)
29  call t3(arr)
30contains
31
32  ! Test of gang-private variables declared on loop directive.
33
34  subroutine t1(x)
35    integer, optional :: x
36    integer :: i, arr(32)
37
38    do i = 1, 32
39       arr(i) = i
40    end do
41
42    !$acc parallel copy(arr) num_gangs(32) num_workers(8) vector_length(32)
43    ! { dg-warning "region is worker partitioned but does not contain worker partitioned code" "" { target *-*-* } .-1 }
44    ! { dg-warning "region is vector partitioned but does not contain vector partitioned code" "" { target *-*-* } .-2 }
45    !$acc loop gang private(x)
46    ! { dg-note {variable 'i' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } .-1 }
47    ! { dg-note {variable 'x' in 'private' clause potentially has improper OpenACC privatization level: 'parm_decl'} "TODO" { target *-*-* } .-2 }
48    do i = 1, 32
49       x = i * 2;
50       arr(i) = arr(i) + x
51    end do
52    !$acc end parallel
53
54    do i = 1, 32
55       if (arr(i) .ne. i * 3) STOP 1
56    end do
57  end subroutine t1
58
59
60  ! Test of gang-private addressable variable declared on loop directive, with
61  ! broadcasting to partitioned workers.
62
63  subroutine t2(pt)
64    integer i, j, arr(0:32*32)
65    type(vec3), optional :: pt
66
67    do i = 0, 32*32-1
68       arr(i) = i
69    end do
70
71    !$acc parallel copy(arr) num_gangs(32) num_workers(8) vector_length(32)
72    ! { dg-warning "region is worker partitioned but does not contain worker partitioned code" "" { target *-*-* } .-1 }
73    !$acc loop gang private(pt)
74    ! { dg-note {variable 'i' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } .-1 }
75    ! { dg-note {variable 'pt' in 'private' clause potentially has improper OpenACC privatization level: 'parm_decl'} "TODO" { target *-*-* } .-2 }
76    do i = 0, 31
77       pt%x = i
78       pt%y = i * 2
79       pt%z = i * 4
80       pt%attr(5) = i * 6
81
82       !$acc loop vector
83       ! { dg-note {variable 'j' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } .-1 }
84       do j = 0, 31
85          arr(i * 32 + j) = arr(i * 32 + j) + pt%x + pt%y + pt%z + pt%attr(5);
86       end do
87    end do
88    !$acc end parallel
89
90    do i = 0, 32 * 32 - 1
91       if (arr(i) .ne. i + (i / 32) * 13) STOP 2
92    end do
93  end subroutine t2
94
95  ! Test of vector-private variables declared on loop directive. Array type.
96
97  subroutine t3(pt)
98    integer, optional :: pt(2)
99    integer :: i, j, k, idx, arr(0:32*32*32)
100
101    do i = 0, 32*32*32-1
102       arr(i) = i
103    end do
104
105    !$acc parallel copy(arr) num_gangs(32) num_workers(8) vector_length(32)
106    !$acc loop gang
107    ! { dg-note {variable 'i' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } .-1 }
108    do i = 0, 31
109       !$acc loop worker
110       ! { dg-note {variable 'j' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } .-1 }
111       do j = 0, 31
112          !$acc loop vector private(pt)
113          ! { dg-note {variable 'k' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } .-1 }
114          ! { dg-note {variable 'pt' in 'private' clause potentially has improper OpenACC privatization level: 'parm_decl'} "TODO" { target *-*-* } .-2 }
115          do k = 0, 31
116             pt(1) = ieor(i, j * 3)
117             pt(2) = ior(i, j * 5)
118             arr(i * 1024 + j * 32 + k) = arr(i * 1024 + j * 32 + k) + pt(1) * k
119             arr(i * 1024 + j * 32 + k) = arr(i * 1024 + j * 32 + k) + pt(2) * k
120          end do
121       end do
122    end do
123    !$acc end parallel
124
125    do i = 0, 32 - 1
126       do j = 0, 32 -1
127          do k = 0, 32 - 1
128             idx = i * 1024 + j * 32 + k
129             if (arr(idx) .ne. idx + ieor(i, j * 3) * k + ior(i, j * 5) * k) then
130                STOP 3
131             end if
132          end do
133       end do
134    end do
135  end subroutine t3
136
137end program main
138