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 15subroutine 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 2710 continue 28end subroutine do_concurrent_test1 29 30subroutine 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 60end subroutine do_concurrent_test2 61 62subroutine 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 69end subroutine s1 70 71subroutine 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 78end subroutine s2 79 80subroutine 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 88end subroutine s3 89 90subroutine 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 100end subroutine s4 101 102subroutine s5() 103 do concurrent (i = 1:n) 104!ERROR: An image control statement is not allowed in DO CONCURRENT 105 stop 106 end do 107end subroutine s5 108 109subroutine 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. 167call 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 192end subroutine s6 193 194subroutine 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 242end subroutine s7 243