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

! RUN: %python %S/test_errors.py %s %flang_fc1 -fopenacc

module devicemod
  real, constant :: c(10)
end module

program test
  use devicemod
  real, device :: a(10)
  real, managed :: m(10)
  a = 1.0
!ERROR: device data not allowed in I/O statements
  print *, a(1)
!ERROR: device data not allowed in I/O statements
  print *, a

  print*, m(9) ! ok
  print*, m ! ok

!ERROR: device data not allowed in I/O statements
  print*, c
!ERROR: device data not allowed in I/O statements
  print*, c(5)
end

subroutine host()
  integer :: i
  real, device :: a(10)
  !$acc parallel loop
  do i = 1, 10
    print*, a(i) ! ok
  end do

  !$cuf kernel do
  do i = 1, 10
    print*, a(i) ! ok
  end do
end subroutine

attributes(global) subroutine global1()
  real, device :: a(10)
  print*, a ! ok
end subroutine

attributes(device) subroutine device1()
  real, device :: a(10)
  print*, a ! ok
end subroutine

attributes(global) subroutine global_with_block()
  block
    real, device :: a(10)
    print*, a ! ok
  end block
end subroutine

subroutine intrinsic_error(n)
  integer :: n
  real(8), device :: d(n,n), x(n)
!ERROR: Actual argument d associated with host intrinsic sum is on the device
  x = sum(d,dim=2)
end subroutine

subroutine intrinsic_error_skipped(ws)
  integer(8), device, optional :: ws(*)
  integer(8) :: p
  if (.not. present(ws)) then
    print*, 'not present'
  else
    p = loc(ws(1))
  end if
end subroutine

subroutine intrinsic_error_size(n)
  integer :: n, x
  real(8), device :: d(n,n)
  x = size(d,dim=1) ! ok
  x = sizeof(d) ! ok
end subroutine

subroutine intrinsic_error_skip_show_descriptor(n)
  use flang_debug
  real(8), allocatable, device :: d(:)
  call show_descriptor(d) ! ok, descriptor in managed memory
end subroutine

double complex function acc_routine_check(n, x, y)
  !$acc routine(acc_routine_check) vector
  implicit none
  integer :: n, i
  double complex, device, dimension(*) :: x, y
  double complex :: temp
  intrinsic dconjg
  
  !$acc loop vector reduction(+:temp)
  do i = 1, n
    ! Check that the error message is not triggered since the subprogram has
    ! an OpenACC routine directive.
    !   Actual argument x associated with host intrinsic conjg is on the device
    temp = temp + dconjg(x(i))*y(i)
  end do
  acc_routine_check = temp
  return
end function acc_routine_check