[flang] Accept polymorphic component element in storage_size
[llvm-project.git] / flang / test / Semantics / OpenACC / acc-data.f90
blobe51579ebb21c9655e106305aced7067a189a8bc3
1 ! RUN: %python %S/../test_errors.py %s %flang -fopenacc
3 ! Check OpenACC clause validity for the following construct and directive:
4 ! 2.6.5 Data
5 ! 2.14.6 Enter Data
6 ! 2.14.7 Exit Data
8 program openacc_data_validity
10 implicit none
12 type atype
13 real(8), dimension(10) :: arr
14 real(8) :: s
15 end type atype
17 integer :: i, j, b, gang_size, vector_size, worker_size
18 integer, parameter :: N = 256
19 integer, dimension(N) :: c
20 logical, dimension(N) :: d, e
21 integer :: async1
22 integer :: wait1, wait2
23 real :: reduction_r
24 logical :: reduction_l
25 real(8), dimension(N, N) :: aa, bb, cc
26 real(8), dimension(:), allocatable :: dd
27 real(8), pointer :: p
28 logical :: ifCondition = .TRUE.
29 type(atype) :: t
30 type(atype), dimension(10) :: ta
32 real(8), dimension(N) :: a, f, g, h
34 !ERROR: At least one of ATTACH, COPYIN, CREATE clause must appear on the ENTER DATA directive
35 !$acc enter data
37 !ERROR: Modifier is not allowed for the COPYIN clause on the ENTER DATA directive
38 !$acc enter data copyin(zero: i)
40 !ERROR: Only the ZERO modifier is allowed for the CREATE clause on the ENTER DATA directive
41 !$acc enter data create(readonly: i)
43 !ERROR: COPYOUT clause is not allowed on the ENTER DATA directive
44 !$acc enter data copyin(i) copyout(i)
46 !$acc enter data create(aa) if(.TRUE.)
48 !$acc enter data create(a(1:10))
50 !$acc enter data create(t%arr)
52 !$acc enter data create(t%arr(2:4))
54 !ERROR: At most one IF clause can appear on the ENTER DATA directive
55 !$acc enter data create(aa) if(.TRUE.) if(ifCondition)
57 !$acc enter data create(aa) if(ifCondition)
59 !$acc enter data create(aa) async
61 !ERROR: At most one ASYNC clause can appear on the ENTER DATA directive
62 !$acc enter data create(aa) async async
64 !$acc enter data create(aa) async(async1)
66 !$acc enter data create(aa) async(1)
68 !$acc enter data create(aa) wait(1)
70 !$acc enter data create(aa) wait(wait1)
72 !$acc enter data create(aa) wait(wait1, wait2)
74 !$acc enter data create(aa) wait(wait1) wait(wait2)
76 !ERROR: Argument `bb` on the ATTACH clause must be a variable or array with the POINTER or ALLOCATABLE attribute
77 !$acc enter data attach(bb)
79 !ERROR: At least one of COPYOUT, DELETE, DETACH clause must appear on the EXIT DATA directive
80 !$acc exit data
82 !ERROR: Modifier is not allowed for the COPYOUT clause on the EXIT DATA directive
83 !$acc exit data copyout(zero: i)
85 !$acc exit data delete(aa)
87 !$acc exit data delete(aa) finalize
89 !ERROR: At most one FINALIZE clause can appear on the EXIT DATA directive
90 !$acc exit data delete(aa) finalize finalize
92 !ERROR: Argument `cc` on the DETACH clause must be a variable or array with the POINTER or ALLOCATABLE attribute
93 !$acc exit data detach(cc)
95 !ERROR: Argument on the DETACH clause must be a variable or array with the POINTER or ALLOCATABLE attribute
96 !$acc exit data detach(/i/)
98 !$acc exit data copyout(bb)
100 !$acc exit data delete(aa) if(.TRUE.)
102 !$acc exit data delete(aa) if(ifCondition)
104 !ERROR: At most one IF clause can appear on the EXIT DATA directive
105 !$acc exit data delete(aa) if(ifCondition) if(.TRUE.)
107 !$acc exit data delete(aa) async
109 !ERROR: At most one ASYNC clause can appear on the EXIT DATA directive
110 !$acc exit data delete(aa) async async
112 !$acc exit data delete(aa) async(async1)
114 !$acc exit data delete(aa) async(1)
116 !$acc exit data delete(aa) wait(1)
118 !$acc exit data delete(aa) wait(wait1)
120 !$acc exit data delete(aa) wait(wait1, wait2)
122 !$acc exit data delete(aa) wait(wait1) wait(wait2)
124 !ERROR: Only the ZERO modifier is allowed for the COPYOUT clause on the DATA directive
125 !$acc data copyout(readonly: i)
126 !$acc end data
128 !ERROR: At most one IF clause can appear on the DATA directive
129 !$acc data copy(i) if(.true.) if(.true.)
130 !$acc end data
132 !ERROR: At least one of COPYOUT, DELETE, DETACH clause must appear on the EXIT DATA directive
133 !$acc exit data
135 !ERROR: At least one of ATTACH, COPY, COPYIN, COPYOUT, CREATE, DEFAULT, DEVICEPTR, NO_CREATE, PRESENT clause must appear on the DATA directive
136 !$acc data
137 !$acc end data
139 !$acc data copy(aa) if(.true.)
140 !$acc end data
142 !$acc data copy(aa) if(ifCondition)
143 !$acc end data
145 !$acc data copy(aa, bb, cc)
146 !$acc end data
148 !$acc data copyin(aa) copyin(readonly: bb) copyout(cc)
149 !$acc end data
151 !$acc data copyin(readonly: aa, bb) copyout(zero: cc)
152 !$acc end data
154 !$acc data create(aa, bb(:,:)) create(zero: cc(:,:))
155 !$acc end data
157 !$acc data no_create(aa) present(bb, cc)
158 !$acc end data
160 !$acc data deviceptr(aa) attach(dd, p)
161 !$acc end data
163 !$acc data copy(aa, bb) default(none)
164 !$acc end data
166 !$acc data copy(aa, bb) default(present)
167 !$acc end data
169 !ERROR: At most one DEFAULT clause can appear on the DATA directive
170 !$acc data copy(aa, bb) default(none) default(present)
171 !$acc end data
173 !ERROR: At most one IF clause can appear on the DATA directive
174 !$acc data copy(aa) if(.true.) if(ifCondition)
175 !$acc end data
177 !$acc data copyin(i)
178 !ERROR: Unmatched PARALLEL directive
179 !$acc end parallel
181 end program openacc_data_validity