|
173
|
1 ! RUN: %S/test_errors.sh %s %t %f18
|
|
|
2 ! C1141
|
|
|
3 ! A reference to the procedure IEEE_SET_HALTING_MODE ! from the intrinsic
|
|
|
4 ! module IEEE_EXCEPTIONS, shall not ! appear within a DO CONCURRENT construct.
|
|
|
5 !
|
|
|
6 ! C1137
|
|
|
7 ! An image control statement shall not appear within a DO CONCURRENT construct.
|
|
|
8 !
|
|
|
9 ! C1136
|
|
|
10 ! A RETURN statement shall not appear within a DO CONCURRENT construct.
|
|
|
11 !
|
|
|
12 ! (11.1.7.5), paragraph 4
|
|
|
13 ! In a DO CONCURRENT, can't have an i/o statement with an ADVANCE= specifier
|
|
|
14
|
|
|
15 subroutine do_concurrent_test1(i,n)
|
|
|
16 implicit none
|
|
|
17 integer :: i, n
|
|
|
18 do 10 concurrent (i = 1:n)
|
|
|
19 !ERROR: An image control statement is not allowed in DO CONCURRENT
|
|
|
20 SYNC ALL
|
|
|
21 !ERROR: An image control statement is not allowed in DO CONCURRENT
|
|
|
22 SYNC IMAGES (*)
|
|
|
23 !ERROR: An image control statement is not allowed in DO CONCURRENT
|
|
|
24 SYNC MEMORY
|
|
|
25 !ERROR: RETURN is not allowed in DO CONCURRENT
|
|
|
26 return
|
|
|
27 10 continue
|
|
|
28 end subroutine do_concurrent_test1
|
|
|
29
|
|
|
30 subroutine do_concurrent_test2(i,j,n,flag)
|
|
|
31 use ieee_exceptions
|
|
|
32 use iso_fortran_env, only: team_type
|
|
|
33 implicit none
|
|
|
34 integer :: i, n
|
|
|
35 type(ieee_flag_type) :: flag
|
|
|
36 logical :: flagValue, halting
|
|
|
37 type(team_type) :: j
|
|
|
38 type(ieee_status_type) :: status
|
|
|
39 do concurrent (i = 1:n)
|
|
|
40 !ERROR: An image control statement is not allowed in DO CONCURRENT
|
|
|
41 sync team (j)
|
|
|
42 !ERROR: An image control statement is not allowed in DO CONCURRENT
|
|
|
43 change team (j)
|
|
|
44 !ERROR: An image control statement is not allowed in DO CONCURRENT
|
|
|
45 critical
|
|
|
46 !ERROR: Call to an impure procedure is not allowed in DO CONCURRENT
|
|
|
47 call ieee_get_status(status)
|
|
|
48 !ERROR: IEEE_SET_HALTING_MODE is not allowed in DO CONCURRENT
|
|
|
49 call ieee_set_halting_mode(flag, halting)
|
|
|
50 end critical
|
|
|
51 end team
|
|
|
52 !ERROR: ADVANCE specifier is not allowed in DO CONCURRENT
|
|
|
53 write(*,'(a35)',advance='no')
|
|
|
54 end do
|
|
|
55
|
|
|
56 ! The following is OK
|
|
|
57 do concurrent (i = 1:n)
|
|
|
58 call ieee_set_flag(flag, flagValue)
|
|
|
59 end do
|
|
|
60 end subroutine do_concurrent_test2
|
|
|
61
|
|
|
62 subroutine s1()
|
|
|
63 use iso_fortran_env
|
|
|
64 type(event_type) :: x
|
|
|
65 do concurrent (i = 1:n)
|
|
|
66 !ERROR: An image control statement is not allowed in DO CONCURRENT
|
|
|
67 event post (x)
|
|
|
68 end do
|
|
|
69 end subroutine s1
|
|
|
70
|
|
|
71 subroutine s2()
|
|
|
72 use iso_fortran_env
|
|
|
73 type(event_type) :: x
|
|
|
74 do concurrent (i = 1:n)
|
|
|
75 !ERROR: An image control statement is not allowed in DO CONCURRENT
|
|
|
76 event wait (x)
|
|
|
77 end do
|
|
|
78 end subroutine s2
|
|
|
79
|
|
|
80 subroutine s3()
|
|
|
81 use iso_fortran_env
|
|
|
82 type(team_type) :: t
|
|
|
83
|
|
|
84 do concurrent (i = 1:n)
|
|
|
85 !ERROR: An image control statement is not allowed in DO CONCURRENT
|
|
|
86 form team(1, t)
|
|
|
87 end do
|
|
|
88 end subroutine s3
|
|
|
89
|
|
|
90 subroutine s4()
|
|
|
91 use iso_fortran_env
|
|
|
92 type(lock_type) :: l
|
|
|
93
|
|
|
94 do concurrent (i = 1:n)
|
|
|
95 !ERROR: An image control statement is not allowed in DO CONCURRENT
|
|
|
96 lock(l)
|
|
|
97 !ERROR: An image control statement is not allowed in DO CONCURRENT
|
|
|
98 unlock(l)
|
|
|
99 end do
|
|
|
100 end subroutine s4
|
|
|
101
|
|
|
102 subroutine s5()
|
|
|
103 do concurrent (i = 1:n)
|
|
|
104 !ERROR: An image control statement is not allowed in DO CONCURRENT
|
|
|
105 stop
|
|
|
106 end do
|
|
|
107 end subroutine s5
|
|
|
108
|
|
|
109 subroutine s6()
|
|
|
110 type :: type0
|
|
|
111 integer, allocatable, dimension(:) :: type0_field
|
|
|
112 integer, allocatable, dimension(:), codimension[:] :: coarray_type0_field
|
|
|
113 end type
|
|
|
114
|
|
|
115 type :: type1
|
|
|
116 type(type0) :: type1_field
|
|
|
117 end type
|
|
|
118
|
|
|
119 type(type1) :: pvar;
|
|
|
120 type(type1) :: qvar;
|
|
|
121 integer, allocatable, dimension(:) :: array1
|
|
|
122 integer, allocatable, dimension(:) :: array2
|
|
|
123 integer, allocatable, codimension[:] :: ca, cb
|
|
|
124 integer, allocatable :: aa, ab
|
|
|
125
|
|
|
126 ! All of the following are allowable outside a DO CONCURRENT
|
|
|
127 allocate(array1(3), pvar%type1_field%type0_field(3), array2(9))
|
|
|
128 allocate(pvar%type1_field%coarray_type0_field(3)[*])
|
|
|
129 allocate(ca[*])
|
|
|
130 allocate(ca[*], pvar%type1_field%coarray_type0_field(3)[*])
|
|
|
131
|
|
|
132 do concurrent (i = 1:10)
|
|
|
133 allocate(pvar%type1_field%type0_field(3))
|
|
|
134 end do
|
|
|
135
|
|
|
136 do concurrent (i = 1:10)
|
|
|
137 !ERROR: An image control statement is not allowed in DO CONCURRENT
|
|
|
138 allocate(ca[*])
|
|
|
139 end do
|
|
|
140
|
|
|
141 do concurrent (i = 1:10)
|
|
|
142 !ERROR: An image control statement is not allowed in DO CONCURRENT
|
|
|
143 deallocate(ca)
|
|
|
144 end do
|
|
|
145
|
|
|
146 do concurrent (i = 1:10)
|
|
|
147 !ERROR: An image control statement is not allowed in DO CONCURRENT
|
|
|
148 allocate(pvar%type1_field%coarray_type0_field(3)[*])
|
|
|
149 end do
|
|
|
150
|
|
|
151 do concurrent (i = 1:10)
|
|
|
152 !ERROR: An image control statement is not allowed in DO CONCURRENT
|
|
|
153 deallocate(pvar%type1_field%coarray_type0_field)
|
|
|
154 end do
|
|
|
155
|
|
|
156 do concurrent (i = 1:10)
|
|
|
157 !ERROR: An image control statement is not allowed in DO CONCURRENT
|
|
|
158 allocate(ca[*], pvar%type1_field%coarray_type0_field(3)[*])
|
|
|
159 end do
|
|
|
160
|
|
|
161 do concurrent (i = 1:10)
|
|
|
162 !ERROR: An image control statement is not allowed in DO CONCURRENT
|
|
|
163 deallocate(ca, pvar%type1_field%coarray_type0_field)
|
|
|
164 end do
|
|
|
165
|
|
|
166 ! Call to MOVE_ALLOC of a coarray outside a DO CONCURRENT. This is OK.
|
|
|
167 call move_alloc(ca, cb)
|
|
|
168
|
|
|
169 ! Note that the errors below relating to MOVE_ALLOC() bing impure are bogus.
|
|
|
170 ! They're the result of the fact that access to the move_alloc() instrinsic
|
|
|
171 ! is not yet possible.
|
|
|
172
|
|
|
173 allocate(aa)
|
|
|
174 do concurrent (i = 1:10)
|
|
|
175 !ERROR: Call to an impure procedure is not allowed in DO CONCURRENT
|
|
|
176 call move_alloc(aa, ab)
|
|
|
177 end do
|
|
|
178
|
|
|
179 ! Call to MOVE_ALLOC with non-coarray arguments in a DO CONCURRENT. This is OK.
|
|
|
180
|
|
|
181 do concurrent (i = 1:10)
|
|
|
182 !ERROR: Call to an impure procedure is not allowed in DO CONCURRENT
|
|
|
183 !ERROR: An image control statement is not allowed in DO CONCURRENT
|
|
|
184 call move_alloc(ca, cb)
|
|
|
185 end do
|
|
|
186
|
|
|
187 do concurrent (i = 1:10)
|
|
|
188 !ERROR: Call to an impure procedure is not allowed in DO CONCURRENT
|
|
|
189 !ERROR: An image control statement is not allowed in DO CONCURRENT
|
|
|
190 call move_alloc(pvar%type1_field%coarray_type0_field, qvar%type1_field%coarray_type0_field)
|
|
|
191 end do
|
|
|
192 end subroutine s6
|
|
|
193
|
|
|
194 subroutine s7()
|
|
|
195 interface
|
|
|
196 pure integer function pf()
|
|
|
197 end function pf
|
|
|
198 end interface
|
|
|
199
|
|
|
200 type :: procTypeNotPure
|
|
|
201 procedure(notPureFunc), pointer, nopass :: notPureProcComponent
|
|
|
202 end type procTypeNotPure
|
|
|
203
|
|
|
204 type :: procTypePure
|
|
|
205 procedure(pf), pointer, nopass :: pureProcComponent
|
|
|
206 end type procTypePure
|
|
|
207
|
|
|
208 type(procTypeNotPure) :: procVarNotPure
|
|
|
209 type(procTypePure) :: procVarPure
|
|
|
210 integer :: ivar
|
|
|
211
|
|
|
212 procVarPure%pureProcComponent => pureFunc
|
|
|
213
|
|
|
214 do concurrent (i = 1:10)
|
|
|
215 print *, "hello"
|
|
|
216 end do
|
|
|
217
|
|
|
218 do concurrent (i = 1:10)
|
|
|
219 ivar = pureFunc()
|
|
|
220 end do
|
|
|
221
|
|
|
222 ! This should not generate errors
|
|
|
223 do concurrent (i = 1:10)
|
|
|
224 ivar = procVarPure%pureProcComponent()
|
|
|
225 end do
|
|
|
226
|
|
|
227 ! This should generate an error
|
|
|
228 do concurrent (i = 1:10)
|
|
|
229 !ERROR: Call to an impure procedure component is not allowed in DO CONCURRENT
|
|
|
230 ivar = procVarNotPure%notPureProcComponent()
|
|
|
231 end do
|
|
|
232
|
|
|
233 contains
|
|
|
234 integer function notPureFunc()
|
|
|
235 notPureFunc = 2
|
|
|
236 end function notPureFunc
|
|
|
237
|
|
|
238 pure integer function pureFunc()
|
|
|
239 pureFunc = 3
|
|
|
240 end function pureFunc
|
|
|
241
|
|
|
242 end subroutine s7
|
