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