1 ! RUN: %python %S/../test_errors.py %s %flang -fopenacc -pedantic
3 ! Check OpenACC clause validity for the following construct and directive:
6 program openacc_serial_validity
11 real(8), dimension(10) :: arr
15 integer :: i
, j
, b
, gang_size
, vector_size
, worker_size
16 integer, parameter :: N
= 256
17 integer, dimension(N
) :: c
18 logical, dimension(N
) :: d
, e
20 integer :: wait1
, wait2
22 logical :: reduction_l
23 real(8), dimension(N
, N
) :: aa
, bb
, cc
24 real(8), dimension(:), allocatable
:: dd
26 logical :: ifCondition
= .TRUE
.
28 type(atype
), dimension(10) :: ta
30 real(8), dimension(N
) :: a
, f
, g
, h
33 !ERROR: Directive SET may not be called within a compute region
34 !$acc set default_async(i)
40 !ERROR: Directive SET may not be called within a compute region
41 !$acc set default_async(i)
55 !ERROR: At most one ASYNC clause can appear on the SERIAL directive
56 !$acc serial async(1) async(2)
59 !$acc serial async(async1)
68 !$acc serial wait(wait1)
71 !$acc serial wait(1,2)
74 !$acc serial wait(wait1, wait2)
77 !$acc serial wait(wait1) wait(wait2)
80 !PORTABILITY: NUM_GANGS clause is not allowed on the SERIAL directive and will be ignored
81 !$acc serial num_gangs(8)
84 !PORTABILITY: NUM_WORKERS clause is not allowed on the SERIAL directive and will be ignored
85 !$acc serial num_workers(8)
88 !PORTABILITY: VECTOR_LENGTH clause is not allowed on the SERIAL directive and will be ignored
89 !$acc serial vector_length(128)
92 !$acc serial if(.true.)
95 !ERROR: At most one IF clause can appear on the SERIAL directive
96 !$acc serial if(.true.) if(ifCondition)
99 !$acc serial if(ifCondition)
105 !$acc serial self(.true.)
108 !$acc serial self(ifCondition)
111 !$acc serial reduction(.neqv.: reduction_l)
112 !$acc loop reduction(.neqv.: reduction_l)
114 reduction_l
= d(i
) .neqv
. e(i
)
118 !$acc serial copy(aa) copyin(bb) copyout(cc)
121 !$acc serial copy(aa, bb) copyout(zero: cc)
124 !$acc serial present(aa, bb) create(cc)
127 !$acc serial copyin(readonly: aa, bb) create(zero: cc)
130 !$acc serial deviceptr(aa, bb) no_create(cc)
133 !ERROR: Argument `aa` on the ATTACH clause must be a variable or array with the POINTER or ALLOCATABLE attribute
134 !$acc serial attach(aa, dd, p)
137 !$acc serial firstprivate(bb, cc)
140 !$acc serial private(aa)
143 !$acc serial default(none)
146 !$acc serial default(present)
149 !ERROR: At most one DEFAULT clause can appear on the SERIAL directive
150 !$acc serial default(present) default(none)
153 !$acc serial device_type(*) async wait
156 !$acc serial device_type(*) async
162 !ERROR: Clause IF is not allowed after clause DEVICE_TYPE on the SERIAL directive
163 !$acc serial device_type(*) if(.TRUE.)
171 !ERROR: CYCLE to construct outside of SERIAL construct is not allowed
182 end program openacc_serial_validity