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

! RUN: %python %S/test_errors.py %s %flang_fc1 -fopenacc
module m
  real, device :: a(4,8)
  real, managed, allocatable :: b(:,:)
  integer, constant :: x = 1
  type :: int
     real :: i, s 
  end type int
  interface operator (+)
     module procedure addHost
     module procedure addDevice
  end interface operator (+)
 contains
  attributes(global) subroutine kernel(a,b,c,n,m)
    integer, value :: n
    integer, intent(in) :: m
    real a(n,m), c(n,m)
    real, managed :: b(n,m)
  end
  attributes(device) subroutine devsub(a,n)
    integer, value :: n
    real, device :: a(n)
  end
  subroutine test
    real c(4)
    allocate(b(4,8))
    !ERROR: dummy argument 'm=' has ATTRIBUTES(DEVICE) but its associated actual argument has no CUDA data attribute
    call kernel<<<1,32>>>(a,b,b,4,8)
    !$acc parallel loop copy(c)
    do j = 1, 1
      call devsub(c,4) ! not checked in OpenACC construct
    end do
  end
  attributes(global) subroutine sub1(x)
    integer :: x
  end
  subroutine sub2()
    call sub1<<<1,1>>>(x) ! actual constant to device dummy
  end
  function addHost(a, b) result(c)
    type(int), intent(in) :: a, b
    type(int) :: c
  end function addHost
  attributes(device) function addDevice(a, b) result(c)
    type(int), device :: c
    type(int), intent(in) :: a ,b
  end function addDevice
  attributes(global) subroutine overload(c, a, b)
    type (int) :: c, a, b
    c = a+b ! ok resolve to addDevice
  end subroutine overload

  attributes(host,device) subroutine hostdev(a)
    integer :: a(*)
  end subroutine
  
  subroutine host()
    integer :: a(10)
    call hostdev(a) ! ok because hostdev is attributes(host,device)
  end subroutine

  subroutine sub_ignore_tkr_m(x, n)
!dir$ ignore_tkr (m) x
    integer, unified :: x(n)
    integer, value :: n
  end subroutine
  subroutine test_ignore_tkr_m()
    integer :: host_arr(10)
    integer, managed :: managed_arr(10)
    call sub_ignore_tkr_m(host_arr, 10)
    call sub_ignore_tkr_m(managed_arr, 10)
  end subroutine

end

module assumed_type_cuda_buffers
  interface generic_recv
    module procedure recv_assumed_size
  end interface

contains
  subroutine recv_assumed_size(buf, count)
    type(*) :: buf(1_8:*)
    integer, intent(in) :: count
  end subroutine

  subroutine recv_assumed_rank(buf, count)
    type(*) :: buf(..)
    integer, intent(in) :: count
  end subroutine

  subroutine test
    real, device :: d(10)
    call recv_assumed_size(d, 10)
    call recv_assumed_rank(d, 10)
    call generic_recv(d, 10)
  end subroutine
end module