1! { dg-do compile }
2! { dg-options "-fcoarray=single -fmax-errors=40" }
3!
4!
5! CO_BROADCAST/CO_REDUCE
6!
7program test
8  implicit none
9  intrinsic co_broadcast
10  intrinsic co_reduce
11  integer :: val, i
12  integer :: vec(3), idx(3)
13  character(len=30) :: errmsg
14  integer(8) :: i8
15  character(len=19, kind=4) :: msg4
16
17  interface
18    pure function red_f(a, b)
19      integer :: a, b, red_f
20      intent(in) :: a, b
21    end function red_f
22    impure function red_f2(a, b)
23      integer :: a, b, red_f
24      intent(in) :: a, b
25    end function red_f2
26  end interface
27
28  call co_broadcast("abc") ! { dg-error "Missing actual argument 'source_image' in call to 'co_broadcast'" }
29  call co_reduce("abc") ! { dg-error "Missing actual argument 'operator' in call to 'co_reduce'" }
30  call co_broadcast(1, source_image=1) ! { dg-error "'a' argument of 'co_broadcast' intrinsic at .1. must be a variable" }
31  call co_reduce(a=1, operator=red_f) ! { dg-error "'a' argument of 'co_reduce' intrinsic at .1. must be a variable" }
32  call co_reduce(a=val, operator=red_f2) ! { dg-error "OPERATOR argument at \\(1\\) must be a PURE function" }
33
34  call co_broadcast(val, source_image=[1,2]) ! { dg-error "must be a scalar" }
35  call co_broadcast(val, source_image=1.0) ! { dg-error "must be INTEGER" }
36  call co_broadcast(val, 1, stat=[1,2]) ! { dg-error "must be a scalar" }
37  call co_broadcast(val, 1, stat=1.0) ! { dg-error "must be INTEGER" }
38  call co_broadcast(val, 1, stat=1) ! { dg-error "must be a variable" }
39  call co_broadcast(val, stat=i, source_image=1) ! OK
40  call co_broadcast(val, stat=i, errmsg=errmsg, source_image=1) ! OK
41  call co_broadcast(val, stat=i, errmsg=[errmsg], source_image=1) ! { dg-error "must be a scalar" }
42  call co_broadcast(val, stat=i, errmsg=5, source_image=1) ! { dg-error "must be CHARACTER" }
43  call co_broadcast(val, 1, errmsg="abc") ! { dg-error "must be a variable" }
44  call co_broadcast(val, 1, stat=i8) ! { dg-error "The stat= argument at .1. must be a kind=4 integer variable" }
45  call co_broadcast(val, 1, errmsg=msg4) ! { dg-error "The errmsg= argument at .1. must be a default-kind character variable" }
46
47  call co_reduce(val, red_f, result_image=[1,2]) ! { dg-error "must be a scalar" }
48  call co_reduce(val, red_f, result_image=1.0) ! { dg-error "must be INTEGER" }
49  call co_reduce(val, red_f, stat=[1,2]) ! { dg-error "must be a scalar" }
50  call co_reduce(val, red_f, stat=1.0) ! { dg-error "must be INTEGER" }
51  call co_reduce(val, red_f, stat=1) ! { dg-error "must be a variable" }
52  call co_reduce(val, red_f, stat=i, result_image=1) ! OK
53  call co_reduce(val, red_f, stat=i, errmsg=errmsg, result_image=1) ! OK
54  call co_reduce(val, red_f, stat=i, errmsg=[errmsg], result_image=1) ! { dg-error "must be a scalar" }
55  call co_reduce(val, red_f, stat=i, errmsg=5, result_image=1) ! { dg-error "must be CHARACTER" }
56  call co_reduce(val, red_f, errmsg="abc") ! { dg-error "must be a variable" }
57  call co_reduce(val, red_f, stat=i8) ! { dg-error "The stat= argument at .1. must be a kind=4 integer variable" }
58  call co_reduce(val, red_f, errmsg=msg4) ! { dg-error "The errmsg= argument at .1. must be a default-kind character variable" }
59
60  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" }
61  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" }
62end program test
63