283 lines · plain
1! RUN: %python %S/test_errors.py %s %flang_fc12! C11413! 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! C11377! An image control statement shall not appear within a DO CONCURRENT construct.8!9! C113610! A RETURN statement shall not appear within a DO CONCURRENT construct.11!12! (11.1.7.5), paragraph 413! In a DO CONCURRENT, can't have an i/o statement with an ADVANCE= specifier14 15subroutine do_concurrent_test1(i,n)16 implicit none17 integer :: i, n18 do 10 concurrent (i = 1:n)19!ERROR: An image control statement is not allowed in DO CONCURRENT20 SYNC ALL21!ERROR: An image control statement is not allowed in DO CONCURRENT22 SYNC IMAGES (*)23!ERROR: An image control statement is not allowed in DO CONCURRENT24 SYNC MEMORY25!ERROR: An image control statement is not allowed in DO CONCURRENT26 stop27!ERROR: An image control statement is not allowed in DO CONCURRENT28 if (.false.) stop29 error stop ! ok30!ERROR: RETURN is not allowed in DO CONCURRENT31 return3210 continue33end subroutine do_concurrent_test134 35subroutine do_concurrent_test2(i,j,n,flag)36 use ieee_exceptions37 use iso_fortran_env, only: team_type38 implicit none39 integer :: i, n40 type(ieee_flag_type) :: flag41 logical :: flagValue, halting42 type(team_type) :: j43 type(ieee_status_type) :: status44 do concurrent (i = 1:n)45!ERROR: An image control statement is not allowed in DO CONCURRENT46 sync team (j)47!ERROR: An image control statement is not allowed in DO CONCURRENT48 change team (j)49!ERROR: An image control statement is not allowed in DO CONCURRENT50 critical51 end critical52 end team53!ERROR: ADVANCE specifier is not allowed in DO CONCURRENT54 write(*,'(a35)',advance='no')55!ERROR: 'ieee_get_status' may not be called in DO CONCURRENT56 call ieee_get_status(status)57!ERROR: 'ieee_set_status' may not be called in DO CONCURRENT58 call ieee_set_status(status)59!ERROR: 'ieee_get_halting_mode' may not be called in DO CONCURRENT60 call ieee_get_halting_mode(flag, halting)61!ERROR: 'ieee_set_halting_mode' may not be called in DO CONCURRENT62 call ieee_set_halting_mode(flag, halting)63!ERROR: 'ieee_get_flag' may not be called in DO CONCURRENT64 call ieee_get_flag(flag, flagValue)65!ERROR: 'ieee_set_flag' may not be called in DO CONCURRENT66 call ieee_set_flag(flag, flagValue)67 end do68end subroutine do_concurrent_test269 70subroutine s1()71 use iso_fortran_env72 type(event_type), save :: x[*]73 do concurrent (i = 1:n)74!ERROR: An image control statement is not allowed in DO CONCURRENT75 event post (x)76 end do77end subroutine s178 79subroutine s2()80 use iso_fortran_env81 type(event_type), save :: x[*]82 do concurrent (i = 1:n)83!ERROR: An image control statement is not allowed in DO CONCURRENT84 event wait (x)85 end do86end subroutine s287 88subroutine s3()89 use iso_fortran_env90 type(team_type) :: t91 92 do concurrent (i = 1:n)93!ERROR: An image control statement is not allowed in DO CONCURRENT94 form team(1, t)95 end do96end subroutine s397 98subroutine s4()99 use iso_fortran_env100 type(lock_type), save :: l[*]101 102 do concurrent (i = 1:n)103!ERROR: An image control statement is not allowed in DO CONCURRENT104 lock(l)105!ERROR: An image control statement is not allowed in DO CONCURRENT106 unlock(l)107 end do108end subroutine s4109 110subroutine s5()111 do concurrent (i = 1:n)112!ERROR: An image control statement is not allowed in DO CONCURRENT113 stop114 end do115end subroutine s5116 117subroutine s6()118 type :: type0119 integer, allocatable, dimension(:) :: type0_field120 integer, allocatable, dimension(:), codimension[:] :: coarray_type0_field121 end type122 123 type :: type1124 type(type0) :: type1_field125 end type126 127 type(type1), save :: pvar, qvar128 integer, allocatable, dimension(:) :: array1129 integer, allocatable, dimension(:) :: array2130 integer, allocatable, codimension[:] :: ca, cb131 integer, allocatable :: aa, ab132 133 ! All of the following are allowable outside a DO CONCURRENT134 allocate(array1(3), pvar%type1_field%type0_field(3), array2(9))135 allocate(pvar%type1_field%coarray_type0_field(3)[*])136 allocate(ca[*])137 allocate(ca[*], pvar%type1_field%coarray_type0_field(3)[*])138 139 do concurrent (i = 1:10)140 allocate(pvar%type1_field%type0_field(3))141 end do142 143 do concurrent (i = 1:10)144!ERROR: An image control statement is not allowed in DO CONCURRENT145 allocate(ca[*])146 end do147 148 do concurrent (i = 1:10)149!ERROR: An image control statement is not allowed in DO CONCURRENT150 deallocate(ca)151 end do152 153 do concurrent (i = 1:10)154!ERROR: An image control statement is not allowed in DO CONCURRENT155 allocate(pvar%type1_field%coarray_type0_field(3)[*])156 end do157 158 do concurrent (i = 1:10)159!ERROR: An image control statement is not allowed in DO CONCURRENT160 deallocate(pvar%type1_field%coarray_type0_field)161 end do162 163 do concurrent (i = 1:10)164!ERROR: An image control statement is not allowed in DO CONCURRENT165 allocate(ca[*], pvar%type1_field%coarray_type0_field(3)[*])166 end do167 168 do concurrent (i = 1:10)169!ERROR: An image control statement is not allowed in DO CONCURRENT170 deallocate(ca, pvar%type1_field%coarray_type0_field)171 end do172 173! Call to MOVE_ALLOC of a coarray outside a DO CONCURRENT. This is OK.174 call move_alloc(ca, cb)175 176! Call to MOVE_ALLOC with non-coarray arguments in a DO CONCURRENT. This is OK.177 allocate(aa)178 do concurrent (i = 1:10)179 call move_alloc(aa, ab)180 end do181 182 do concurrent (i = 1:10)183!ERROR: An image control statement is not allowed in DO CONCURRENT184 call move_alloc(ca, cb)185 end do186 187 do concurrent (i = 1:10)188!ERROR: An image control statement is not allowed in DO CONCURRENT189 call move_alloc(pvar%type1_field%coarray_type0_field, qvar%type1_field%coarray_type0_field)190 end do191end subroutine s6192 193subroutine s7()194 interface195 pure integer function pf()196 end function pf197 end interface198 interface generic199 impure integer function ipf()200 end function ipf201 end interface202 203 type :: procTypeNotPure204 procedure(notPureFunc), pointer, nopass :: notPureProcComponent205 end type procTypeNotPure206 207 type :: procTypePure208 procedure(pf), pointer, nopass :: pureProcComponent209 end type procTypePure210 211 type(procTypeNotPure) :: procVarNotPure212 type(procTypePure) :: procVarPure213 integer :: ivar214 215 procVarPure%pureProcComponent => pureFunc216 217 do concurrent (i = 1:10)218 print *, "hello"219 end do220 221 do concurrent (i = 1:10)222 ivar = pureFunc()223 end do224 225 ! This should not generate errors226 do concurrent (i = 1:10)227 ivar = procVarPure%pureProcComponent()228 end do229 230 ! This should generate an error231 do concurrent (i = 1:10)232!ERROR: Impure procedure 'notpureproccomponent' may not be referenced in DO CONCURRENT233 ivar = procVarNotPure%notPureProcComponent()234 end do235 236 ! This should generate an error237 do concurrent (i = 1:10)238!ERROR: Impure procedure 'ipf' may not be referenced in DO CONCURRENT239 ivar = generic()240 end do241 242 contains243 integer function notPureFunc()244 notPureFunc = 2245 end function notPureFunc246 247 pure integer function pureFunc()248 pureFunc = 3249 end function pureFunc250 251end subroutine s7252 253module m8254 type t255 contains256 procedure tbpAssign257 generic :: assignment(=) => tbpAssign258 end type259 interface assignment(=)260 module procedure nonTbpAssign261 end interface262 contains263 impure elemental subroutine tbpAssign(to, from)264 class(t), intent(out) :: to265 class(t), intent(in) :: from266 print *, 'impure due to I/O'267 end268 impure elemental subroutine nonTbpAssign(to, from)269 type(t), intent(out) :: to270 integer, intent(in) :: from271 print *, 'impure due to I/O'272 end273 subroutine test274 type(t) x, y275 do concurrent (j=1:1)276 !ERROR: The defined assignment subroutine 'tbpassign' is not pure277 x = y278 !ERROR: The defined assignment subroutine 'nontbpassign' is not pure279 x = 666280 end do281 end282end283