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