! { dg-do compile }
! { dg-options "-fcoarray=single -fmax-errors=40" }
!
!
! CO_BROADCAST/CO_REDUCE
!
program test
  implicit none
  intrinsic co_broadcast
  intrinsic co_reduce
  integer :: val, i
  integer :: vec(3), idx(3)
  character(len=30) :: errmsg
  integer(8) :: i8
  character(len=19, kind=4) :: msg4

  interface
    pure function red_f(a, b)
      integer :: a, b, red_f
      intent(in) :: a, b
    end function red_f
    impure function red_f2(a, b)
      integer :: a, b, red_f
      intent(in) :: a, b
    end function red_f2
  end interface

  call co_broadcast("abc") ! { dg-error "Missing actual argument 'source_image' in call to 'co_broadcast'" }
  call co_reduce("abc") ! { dg-error "Missing actual argument 'operation' in call to 'co_reduce'" }
  call co_broadcast(1, source_image=1) ! { dg-error "'a' argument of 'co_broadcast' intrinsic at .1. must be a variable" }
  call co_reduce(a=1, operation=red_f) ! { dg-error "'a' argument of 'co_reduce' intrinsic at .1. must be a variable" }
  call co_reduce(a=val, operation=red_f2) ! { dg-error "OPERATION argument at \\(1\\) must be a PURE function" }

  call co_broadcast(val, source_image=[1,2]) ! { dg-error "must be a scalar" }
  call co_broadcast(val, source_image=1.0) ! { dg-error "must be INTEGER" }
  call co_broadcast(val, 1, stat=[1,2]) ! { dg-error "must be a scalar" }
  call co_broadcast(val, 1, stat=1.0) ! { dg-error "must be INTEGER" }
  call co_broadcast(val, 1, stat=1) ! { dg-error "must be a variable" }
  call co_broadcast(val, stat=i, source_image=1) ! OK
  call co_broadcast(val, stat=i, errmsg=errmsg, source_image=1) ! OK
  call co_broadcast(val, stat=i, errmsg=[errmsg], source_image=1) ! { dg-error "must be a scalar" }
  call co_broadcast(val, stat=i, errmsg=5, source_image=1) ! { dg-error "must be CHARACTER" }
  call co_broadcast(val, 1, errmsg="abc") ! { dg-error "must be a variable" }
  call co_broadcast(val, 1, stat=i8) ! { dg-error "The stat= argument at .1. must be a kind=4 integer variable" }
  call co_broadcast(val, 1, errmsg=msg4) ! { dg-error "The errmsg= argument at .1. must be a default-kind character variable" }

  call co_reduce(val, red_f, result_image=[1,2]) ! { dg-error "must be a scalar" }
  call co_reduce(val, red_f, result_image=1.0) ! { dg-error "must be INTEGER" }
  call co_reduce(val, red_f, stat=[1,2]) ! { dg-error "must be a scalar" }
  call co_reduce(val, red_f, stat=1.0) ! { dg-error "must be INTEGER" }
  call co_reduce(val, red_f, stat=1) ! { dg-error "must be a variable" }
  call co_reduce(val, red_f, stat=i, result_image=1) ! OK
  call co_reduce(val, red_f, stat=i, errmsg=errmsg, result_image=1) ! OK
  call co_reduce(val, red_f, stat=i, errmsg=[errmsg], result_image=1) ! { dg-error "must be a scalar" }
  call co_reduce(val, red_f, stat=i, errmsg=5, result_image=1) ! { dg-error "must be CHARACTER" }
  call co_reduce(val, red_f, errmsg="abc") ! { dg-error "must be a variable" }
  call co_reduce(val, red_f, stat=i8) ! { dg-error "The stat= argument at .1. must be a kind=4 integer variable" }
  call co_reduce(val, red_f, errmsg=msg4) ! { dg-error "The errmsg= argument at .1. must be a default-kind character variable" }

  call co_broadcast(vec(idx), 1) ! { dg-error "Argument 'A' with INTENT\\(INOUT\\) at .1. of the intrinsic subroutine co_broadcast shall not have a vector subscript" }
  call co_reduce(vec([1,3,2]), red_f) ! { dg-error "Argument 'A' with INTENT\\(INOUT\\) at .1. of the intrinsic subroutine co_reduce shall not have a vector subscript" }
end program test