259 lines · plain
1! RUN: %python %S/test_errors.py %s %flang_fc12module m3 integer :: m(100)4 integer, constant :: c(10)5 integer, parameter :: p(5) = [1,2,3,4,5]6 contains7 attributes(device) subroutine devsub8 !ERROR: Statement may not appear in device code9 !$cuf kernel do <<< 1, 2 >>>10 do k=1,1011 end do12 end13 attributes(device) subroutine devsub214 real, device :: x(10)15 print*,'from device'16 print '(f10.5)', (x(ivar), ivar = 1, 10)17 write(*,*), "Hello world from device!"18 !WARNING: I/O statement might not be supported on device [-Wcuda-usage]19 write(12,'(10F4.1)'), x20 end21 attributes(global) subroutine devsub3(n)22 implicit none23 integer :: n24 integer :: i, ig, iGrid25 iGrid = gridDim%x*blockDim%x26 ig = (blockIdx%x-1)*blockDim%x + threadIdx%x27 28 !dir$ nounroll29 do i = ig, n, iGrid30 end do31 end subroutine32 attributes(global) subroutine hostglobal(a)33 integer :: a(*)34 i = threadIdx%x35 !ERROR: Host array 'm' cannot be present in device context36 if (i .le. N) a(i) = m(i)37 end subroutine38 39 attributes(device) function devfct(r1, r2) result(res)40 real(4), intent(in) :: r1(3), r2(3)41 real(4) :: res(3)42 res = r1 - r2 ! Do not error on function result43 end function44 45 attributes(global) subroutine hostparameter(a)46 integer :: a(*)47 i = threadIdx%x48 if (i .le. N) a(i) = p(i) ! ok. p is parameter49 end subroutine50 51 attributes(global) subroutine localarray()52 integer :: a(10)53 i = threadIdx%x54 a(i) = i55 end subroutine56 57 attributes(global) subroutine sharedarray(a)58 integer, device :: a(10)59 integer, shared :: s(10)60 i = threadIdx%x61 a(i) = s(10) ! ok, a is device and s is shared62 end subroutine63 64 attributes(global) subroutine cstarray(a)65 integer, device :: a(10)66 i = threadIdx%x67 a(i) = c(10) ! ok, a is device and c is constant68 end subroutine69 70 attributes(global) subroutine stoptest()71 print*,threadIdx%x72 stop ! ok73 end subroutine74 75 attributes(global) subroutine cycletest()76 integer :: i77 do i = 1, 1078 cycle ! ok79 end do80 end subroutine81 82 attributes(global) subroutine gototest()83 integer :: i84 goto 1085 10 print *, "X is negative!" 86 end subroutine87 88 attributes(global) subroutine exittest()89 integer :: i90 do i = 1, 1091 if (i == 1) then92 exit ! ok93 end if94 end do95 end subroutine96 97 attributes(global) subroutine selectcasetest()98 integer :: i99 select case(i)100 case (1)101 print*,'main'102 case default103 print*, 'default'104 end select105 end subroutine106 107 subroutine host()108 integer :: i109 !$cuf kernel do110 do i = 1, 10111 !ERROR: Statement may not appear in cuf kernel code112 cycle113 end do114 115 !$cuf kernel do116 do i = 1, 10117 if (i == 1) then118 !ERROR: Statement may not appear in cuf kernel code119 exit ! ok120 end if121 122 !ERROR: Statement may not appear in cuf kernel code123 goto 10124 10 print *, "X is negative!"125 end do126 end subroutine127end128 129program main130 integer, device :: a_d(10 ,10)131 integer :: b(10, 10)132 !$cuf kernel do <<< *, * >>> ! ok133 do j = 1, 0134 end do135 !$cuf kernel do <<< (*), (*) >>> ! ok136 do j = 1, 0137 end do138 !$cuf kernel do <<< (1,*), (2,*) >>> ! ok139 do j = 1, 0140 end do141 !ERROR: !$CUF KERNEL DO (1) must be followed by a DO construct with tightly nested outer levels of counted DO loops142 !$cuf kernel do <<< 1, 2 >>>143 do while (.false.)144 end do145 !ERROR: !$CUF KERNEL DO (1) must be followed by a DO construct with tightly nested outer levels of counted DO loops146 !$cuf kernel do <<< 1, 2 >>>147 do148 exit149 end do150 !$cuf kernel do <<< 1, 2 >>>151 do concurrent (j=1:10)152 end do153 !ERROR: !$CUF KERNEL DO (2) must be followed by a DO CONCURRENT construct with at least 2 indices154 !$cuf kernel do(2) <<< 1, 2 >>>155 do concurrent (j=1:10)156 end do157 !$cuf kernel do <<< 1, 2 >>>158 do 1 j=1,101591 continue ! ok160 !$cuf kernel do <<< 1, 2 >>>161 do j=1,10162 end do ! ok163 !$cuf kernel do <<< 1, 2 >>>164 do j=1,10165 !ERROR: Statement may not appear in device code166 !$cuf kernel do <<< 1, 2 >>>167 do k=1,10168 end do169 end do170 !ERROR: !$CUF KERNEL DO (-1): loop nesting depth must be positive171 !$cuf kernel do (-1) <<< 1, 2 >>>172 do j=1,10173 end do174 !ERROR: !$CUF KERNEL DO (1) must be followed by a DO construct with tightly nested outer levels of counted DO loops175 !$cuf kernel do <<< 1, 2 >>>176 continue177 !ERROR: !$CUF KERNEL DO (2) must be followed by a DO construct with tightly nested outer levels of counted DO loops178 !$cuf kernel do (2) <<< 1, 2 >>>179 do j=1,10180 end do181 !ERROR: !$CUF KERNEL DO (2) must be followed by a DO construct with tightly nested outer levels of counted DO loops182 !$cuf kernel do (2) <<< 1, 2 >>>183 do j=1,10184 continue185 end do186 !ERROR: !$CUF KERNEL DO (2) must be followed by a DO construct with tightly nested outer levels of counted DO loops187 !$cuf kernel do (2) <<< 1, 2 >>>188 do j=1,10189 do k=1,10190 end do191 continue192 end do193 !$cuf kernel do <<< 1, 2 >>>194 do j = 1, 10195 !ERROR: 'foo' may not be called in device code196 call foo197 !ERROR: 'bar' may not be called in device code198 x = bar()199 !ERROR: 'ifunc' may not be called in device code200 if (ifunc() /= 0) continue201 !ERROR: 'ifunc' may not be called in device code202 if (ifunc() /= 0) then203 !ERROR: 'ifunc' may not be called in device code204 else if (ifunc() /= 1) then205 end if206 end do207 208 !$cuf kernel do (2) <<<*, *>>>209 do j = 1, 10210 do i = 1, 10211 !ERROR: Host array 'b' cannot be present in device context212 a_d(i,j) = b(i,j)213 enddo214 enddo215end216 217subroutine host1()218 integer, device :: a(32)219 integer :: i, j220 221 !$cuf kernel do(1) <<<*,32>>>222 do i = 1, 32223 a(i) = a(i) * 2.0224 !ERROR: 'syncthreads' may not be called in device code225 call syncthreads() ! missing explicit use cudadevice226 a(i) = a(i) + a(j) - 34.0227 end do228end 229 230subroutine ieee_test231 use ieee_arithmetic232 233 real(8), device :: y(100)234 logical(4), managed :: ll(100)235 236 !$cuf kernel do(1)<<<*,*>>>237 do i = 1, 100238 ll(i) = ieee_is_finite(y(i)) ! allow ieee_arithmetic functions on the device.239 end do240end subroutine241 242attributes(host,device) subroutine do2(a,b,c,i)243 integer a(*), b(*), c(*)244 integer, value :: i 245 c(i) = a(i) - b(i) ! ok. Should not error with Host array 246 ! cannot be present in device context247end248 249attributes(global) subroutine blockTest250block251 integer(8) :: xloc252 integer(8) :: s(7)253 integer(4) :: i254 do i = 1, 7255 s = xloc ! ok.256 end do257end block258end subroutine259