1! RUN: %python %S/../test_errors.py %s %flang -fopenacc -pedantic 2 3! Check OpenACC restruction in branch in and out of some construct 4! 5subroutine openacc_clause_validity 6 7 implicit none 8 9 integer :: i, j, k 10 integer :: N = 256 11 real(8) :: a(256) 12 13 !$acc parallel 14 !$acc loop 15 do i = 1, N 16 a(i) = 3.14 17 !ERROR: RETURN statement is not allowed in a PARALLEL construct 18 return 19 end do 20 !$acc end parallel 21 22 !$acc parallel loop 23 do i = 1, N 24 a(i) = 3.14 25 !ERROR: RETURN statement is not allowed in a PARALLEL LOOP construct 26 return 27 end do 28 29 !$acc serial loop 30 do i = 1, N 31 a(i) = 3.14 32 !ERROR: RETURN statement is not allowed in a SERIAL LOOP construct 33 return 34 end do 35 36 !$acc kernels loop 37 do i = 1, N 38 a(i) = 3.14 39 !ERROR: RETURN statement is not allowed in a KERNELS LOOP construct 40 return 41 end do 42 43 !$acc parallel 44 !$acc loop 45 do i = 1, N 46 a(i) = 3.14 47 if(i == N-1) THEN 48 exit 49 end if 50 end do 51 !$acc end parallel 52 53 ! Exit branches out of parallel construct, not attached to an OpenACC parallel construct. 54 name1: do k=1, N 55 !$acc parallel 56 !$acc loop 57 outer: do i=1, N 58 inner: do j=1, N 59 ifname: if (j == 2) then 60 ! These are allowed. 61 exit 62 exit inner 63 exit outer 64 !ERROR: EXIT to construct 'name1' outside of PARALLEL construct is not allowed 65 exit name1 66 ! Exit to construct other than loops. 67 exit ifname 68 end if ifname 69 end do inner 70 end do outer 71 !$acc end parallel 72 end do name1 73 74 ! Exit branches out of parallel construct, attached to an OpenACC parallel construct. 75 thisblk: BLOCK 76 fortname: if (.true.) then 77 !PORTABILITY: The construct name 'name1' should be distinct at the subprogram level 78 name1: do k = 1, N 79 !$acc parallel 80 !ERROR: EXIT to construct 'fortname' outside of PARALLEL construct is not allowed 81 exit fortname 82 !$acc loop 83 do i = 1, N 84 a(i) = 3.14 85 if(i == N-1) THEN 86 !ERROR: EXIT to construct 'name1' outside of PARALLEL construct is not allowed 87 exit name1 88 end if 89 end do 90 91 loop2: do i = 1, N 92 a(i) = 3.33 93 !ERROR: EXIT to construct 'thisblk' outside of PARALLEL construct is not allowed 94 exit thisblk 95 end do loop2 96 !$acc end parallel 97 end do name1 98 end if fortname 99 end BLOCK thisblk 100 101 !Exit branches inside OpenACC construct. 102 !$acc parallel 103 !$acc loop 104 do i = 1, N 105 a(i) = 3.14 106 ifname: if (i == 2) then 107 ! This is allowed. 108 exit ifname 109 end if ifname 110 end do 111 !$acc end parallel 112 113 !$acc parallel 114 !$acc loop 115 do i = 1, N 116 a(i) = 3.14 117 if(i == N-1) THEN 118 stop 999 ! no error 119 end if 120 end do 121 !$acc end parallel 122 123 !$acc kernels 124 do i = 1, N 125 a(i) = 3.14 126 !ERROR: RETURN statement is not allowed in a KERNELS construct 127 return 128 end do 129 !$acc end kernels 130 131 !$acc kernels 132 do i = 1, N 133 a(i) = 3.14 134 if(i == N-1) THEN 135 exit 136 end if 137 end do 138 !$acc end kernels 139 140 !$acc kernels 141 do i = 1, N 142 a(i) = 3.14 143 if(i == N-1) THEN 144 stop 999 ! no error 145 end if 146 end do 147 !$acc end kernels 148 149 !$acc serial 150 do i = 1, N 151 a(i) = 3.14 152 !ERROR: RETURN statement is not allowed in a SERIAL construct 153 return 154 end do 155 !$acc end serial 156 157 !$acc serial 158 do i = 1, N 159 a(i) = 3.14 160 if(i == N-1) THEN 161 exit 162 end if 163 end do 164 !$acc end serial 165 166 name2: do k=1, N 167 !$acc serial 168 do i = 1, N 169 ifname: if (.true.) then 170 print *, "LGTM" 171 a(i) = 3.14 172 if(i == N-1) THEN 173 !ERROR: EXIT to construct 'name2' outside of SERIAL construct is not allowed 174 exit name2 175 exit ifname 176 end if 177 end if ifname 178 end do 179 !$acc end serial 180 end do name2 181 182 !$acc serial 183 do i = 1, N 184 a(i) = 3.14 185 if(i == N-1) THEN 186 stop 999 ! no error 187 end if 188 end do 189 !$acc end serial 190 191 192 !$acc data create(a) 193 194 !ERROR: RETURN statement is not allowed in a DATA construct 195 if (size(a) == 10) return 196 197 !$acc end data 198 199end subroutine openacc_clause_validity 200