TheRock/compiler/amd-llvm/flang/test/Semantics/cuf09.cuf

! RUN: %python %S/test_errors.py %s %flang_fc1
module m
  integer :: m(100)
  integer, constant :: c(10)
  integer, parameter :: p(5) = [1,2,3,4,5]
  type :: t1
    integer, allocatable, unified :: m(:)
  end type
  type :: t2
    integer :: m(10)
  end type
 contains
  attributes(device) subroutine devsub
    !ERROR: Statement may not appear in device code
    !$cuf kernel do <<< 1, 2 >>>
    do k=1,10
    end do
  end
  attributes(device) subroutine devsub2
    real, device :: x(10)
    print*,'from device'
    print '(f10.5)', (x(ivar), ivar = 1, 10)
    write(*,*), "Hello world from device!"
    !WARNING: I/O statement might not be supported on device [-Wcuda-usage]
    write(12,'(10F4.1)'), x
  end
  attributes(global) subroutine devsub3(n)
    implicit none
    integer :: n
    integer :: i, ig, iGrid
    iGrid = gridDim%x*blockDim%x
    ig = (blockIdx%x-1)*blockDim%x + threadIdx%x
 
    !dir$ nounroll
    do i = ig, n, iGrid
    end do
  end subroutine
  attributes(global) subroutine hostglobal(a)
    integer :: a(*)
    i = threadIdx%x
    !ERROR: Host array 'm' cannot be present in device context
    if (i .le. N) a(i) = m(i)
  end subroutine

  attributes(device) function devfct(r1, r2) result(res)
    real(4), intent(in) :: r1(3), r2(3)
    real(4) :: res(3)
    res = r1 - r2 ! Do not error on function result
  end function

  attributes(global) subroutine hostparameter(a)
    integer :: a(*)
    i = threadIdx%x
    if (i .le. N) a(i) = p(i) ! ok. p is parameter
  end subroutine

  attributes(global) subroutine localarray()
    integer :: a(10)
    i = threadIdx%x
    a(i) = i
  end subroutine

  attributes(global) subroutine sharedarray(a)
    integer, device :: a(10)
    integer, shared :: s(10)
    i = threadIdx%x
    a(i) = s(10) ! ok, a is device and s is shared
  end subroutine

  attributes(global) subroutine cstarray(a)
    integer, device :: a(10)
    i = threadIdx%x
    a(i) = c(10) ! ok, a is device and c is constant
  end subroutine

  attributes(global) subroutine stoptest()
    print*,threadIdx%x
    stop ! ok
  end subroutine

  attributes(global) subroutine cycletest()
    integer :: i
    do i = 1, 10
      cycle ! ok
    end do
  end subroutine

  attributes(global) subroutine gototest()
    integer :: i
    goto 10
    10 print *, "X is negative!" 
  end subroutine

  attributes(global) subroutine exittest()
    integer :: i
    do i = 1, 10
      if (i == 1) then
        exit ! ok
      end if
    end do
  end subroutine

  attributes(global) subroutine selectcasetest()
    integer :: i
    select case(i)
    case (1)
      print*,'main'
    case default
      print*, 'default'
    end select
  end subroutine

  subroutine host()
    integer :: i
    !$cuf kernel do
    do i = 1, 10
      !ERROR: Statement may not appear in cuf kernel code
      cycle
    end do

    !$cuf kernel do
    do i = 1, 10
      if (i == 1) then
        !ERROR: Statement may not appear in cuf kernel code
        exit ! ok
      end if

      !ERROR: Statement may not appear in cuf kernel code
      goto 10
      10 print *, "X is negative!"
    end do
  end subroutine
end

program main
  use m
  integer, device :: a_d(10 ,10)
  integer :: b(10, 10)
  type(t1) :: t1d
  type(t2) :: t2d
  type(t2), unified :: t2unified
  !$cuf kernel do <<< *, * >>> ! ok
  do j = 1, 0
  end do
  !$cuf kernel do <<< (*), (*) >>> ! ok
  do j = 1, 0
  end do
  !$cuf kernel do <<< (1,*), (2,*) >>> ! ok
  do j = 1, 0
  end do
  !ERROR: !$CUF KERNEL DO (1) must be followed by a DO construct with tightly nested outer levels of counted DO loops
  !$cuf kernel do <<< 1, 2 >>>
  do while (.false.)
  end do
  !ERROR: !$CUF KERNEL DO (1) must be followed by a DO construct with tightly nested outer levels of counted DO loops
  !$cuf kernel do <<< 1, 2 >>>
  do
    exit
  end do
  !$cuf kernel do <<< 1, 2 >>>
  do concurrent (j=1:10)
  end do
  !ERROR: !$CUF KERNEL DO (2) must be followed by a DO CONCURRENT construct with at least 2 indices
  !$cuf kernel do(2) <<< 1, 2 >>>
  do concurrent (j=1:10)
  end do
  !$cuf kernel do <<< 1, 2 >>>
  do 1 j=1,10
1 continue ! ok
  !$cuf kernel do <<< 1, 2 >>>
  do j=1,10
  end do ! ok
  !$cuf kernel do <<< 1, 2 >>>
  do j=1,10
    !ERROR: Statement may not appear in device code
    !$cuf kernel do <<< 1, 2 >>>
    do k=1,10
    end do
  end do
  !ERROR: !$CUF KERNEL DO (-1): loop nesting depth must be positive
  !$cuf kernel do (-1) <<< 1, 2 >>>
  do j=1,10
  end do
  !ERROR: !$CUF KERNEL DO (1) must be followed by a DO construct with tightly nested outer levels of counted DO loops
  !$cuf kernel do <<< 1, 2 >>>
  continue
  !ERROR: !$CUF KERNEL DO (2) must be followed by a DO construct with tightly nested outer levels of counted DO loops
  !$cuf kernel do (2) <<< 1, 2 >>>
  do j=1,10
  end do
  !ERROR: !$CUF KERNEL DO (2) must be followed by a DO construct with tightly nested outer levels of counted DO loops
  !$cuf kernel do (2) <<< 1, 2 >>>
  do j=1,10
    continue
  end do
  !ERROR: !$CUF KERNEL DO (2) must be followed by a DO construct with tightly nested outer levels of counted DO loops
  !$cuf kernel do (2) <<< 1, 2 >>>
  do j=1,10
    do k=1,10
    end do
    continue
  end do
  !$cuf kernel do <<< 1, 2 >>>
  do j = 1, 10
    !ERROR: 'foo' may not be called in device code
    call foo
    !ERROR: 'bar' may not be called in device code
    x = bar()
    !ERROR: 'ifunc' may not be called in device code
    if (ifunc() /= 0) continue
    !ERROR: 'ifunc' may not be called in device code
    if (ifunc() /= 0) then
    !ERROR: 'ifunc' may not be called in device code
    else if (ifunc() /= 1) then
    end if
  end do

  !$cuf kernel do (2) <<<*, *>>>
  do j = 1, 10
     do i = 1, 10
        !ERROR: Host array 'b' cannot be present in device context
        a_d(i,j) = b(i,j)
     enddo
  enddo

  !$cuf kernel do <<<*, *>>>
  do j = 1, 10
    t1d%m(j) = j
    !ERROR: Host array 'm' cannot be present in device context
    t2d%m(j) = j
    t2unified%m(j) = j ! ok. t2unified is unified
  end do
end

subroutine host1()
  integer, device :: a(32)
  integer :: i, j

  !$cuf kernel do(1) <<<*,32>>>
  do i = 1, 32
    a(i) = a(i) * 2.0
    !ERROR: 'syncthreads' may not be called in device code
    call syncthreads() ! missing explicit use cudadevice
    a(i) = a(i) + a(j) - 34.0
  end do
end 

subroutine ieee_test
  use ieee_arithmetic

  real(8), device :: y(100)
  logical(4), managed :: ll(100)

  !$cuf kernel do(1)<<<*,*>>>
  do i = 1, 100
    ll(i) = ieee_is_finite(y(i)) ! allow ieee_arithmetic functions on the device.
  end do
end subroutine

attributes(host,device) subroutine do2(a,b,c,i)
  integer a(*), b(*), c(*)
  integer, value :: i  
  c(i) = a(i) - b(i) ! ok. Should not error with Host array 
                     ! cannot be present in device context
end

attributes(global) subroutine blockTest
block
  integer(8) :: xloc
  integer(8) :: s(7)
  integer(4) :: i
  do i = 1, 7
    s = xloc ! ok.
  end do
end block
end subroutine