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