mirror of
https://github.com/autc04/Retro68.git
synced 2024-06-28 11:30:19 +00:00
147 lines
7.1 KiB
Fortran
147 lines
7.1 KiB
Fortran
! { dg-do compile }
|
|
! { dg-options "-fcoarray=single -fmax-errors=80" }
|
|
!
|
|
!
|
|
! CO_REDUCE (plus CO_MIN/MAX/SUM/BROADCAST)
|
|
!
|
|
program test
|
|
implicit none (external, type)
|
|
intrinsic co_reduce
|
|
intrinsic co_broadcast
|
|
intrinsic co_min
|
|
intrinsic co_max
|
|
intrinsic co_sum
|
|
intrinsic dprod
|
|
external ext
|
|
|
|
type t
|
|
procedure(), pointer, nopass :: ext
|
|
procedure(valid), pointer, nopass :: valid
|
|
procedure(sub), pointer, nopass :: sub
|
|
procedure(nonpure), pointer, nopass :: nonpure
|
|
procedure(arg1), pointer, nopass :: arg1
|
|
procedure(arg3), pointer, nopass :: arg3
|
|
procedure(elem), pointer, nopass :: elem
|
|
procedure(realo), pointer, nopass :: realo
|
|
procedure(int8), pointer, nopass :: int8
|
|
procedure(arr), pointer, nopass :: arr
|
|
procedure(ptr), pointer, nopass :: ptr
|
|
procedure(alloc), pointer, nopass :: alloc
|
|
procedure(opt), pointer, nopass :: opt
|
|
procedure(val), pointer, nopass :: val
|
|
procedure(async), pointer, nopass :: async
|
|
procedure(tgt), pointer, nopass :: tgt
|
|
procedure(char44), pointer, nopass :: char44
|
|
procedure(char34), pointer, nopass :: char34
|
|
end type t
|
|
|
|
type(t) :: dt
|
|
integer :: caf[*]
|
|
character(len=3) :: c3
|
|
character(len=4) :: c4
|
|
|
|
|
|
|
|
call co_min(caf[1]) ! { dg-error "shall not be coindexed" }
|
|
call co_max(caf[1]) ! { dg-error "shall not be coindexed" }
|
|
call co_sum(caf[1]) ! { dg-error "shall not be coindexed" }
|
|
call co_broadcast(caf[1], source_image=1) ! { dg-error "shall not be coindexed" }
|
|
call co_reduce(caf[1], valid) ! { dg-error "shall not be coindexed" }
|
|
|
|
call co_reduce(caf, valid) ! OK
|
|
call co_reduce(caf, dt%valid) ! OK
|
|
call co_reduce(caf, dprod) ! { dg-error "is not permitted for CO_REDUCE" }
|
|
call co_reduce(caf, ext) ! { dg-error "must be a PURE function" }
|
|
call co_reduce(caf, dt%ext) ! { dg-error "must be a PURE function" }
|
|
call co_reduce(caf, sub) ! { dg-error "must be a PURE function" }
|
|
call co_reduce(caf, dt%sub) ! { dg-error "must be a PURE function" }
|
|
call co_reduce(caf, nonpure) ! { dg-error "must be a PURE function" }
|
|
call co_reduce(caf, dt%nonpure) ! { dg-error "must be a PURE function" }
|
|
call co_reduce(caf, arg1) ! { dg-error "shall have two arguments" }
|
|
call co_reduce(caf, dt%arg1) ! { dg-error "shall have two arguments" }
|
|
call co_reduce(caf, arg3) ! { dg-error "shall have two arguments" }
|
|
call co_reduce(caf, dt%arg3) ! { dg-error "shall have two arguments" }
|
|
call co_reduce(caf, elem) ! { dg-error "ELEMENTAL non-INTRINSIC procedure 'elem' is not allowed as an actual argument" }
|
|
call co_reduce(caf, dt%elem) ! { dg-error "ELEMENTAL procedure pointer component 'elem' is not allowed as an actual argument" }
|
|
call co_reduce(caf, realo) ! { dg-error "A argument at .1. has type INTEGER.4. but the function passed as OPERATOR at .2. returns REAL.4." }
|
|
call co_reduce(caf, dt%realo) ! { dg-error "A argument at .1. has type INTEGER.4. but the function passed as OPERATOR at .2. returns REAL.4." }
|
|
call co_reduce(caf, int8) ! { dg-error "A argument at .1. has type INTEGER.4. but the function passed as OPERATOR at .2. returns INTEGER.8." }
|
|
call co_reduce(caf, dt%int8) ! { dg-error "A argument at .1. has type INTEGER.4. but the function passed as OPERATOR at .2. returns INTEGER.8." }
|
|
call co_reduce(caf, arr) ! { dg-error "scalar nonallocatable nonpointer arguments and return a nonallocatable nonpointer scalar" }
|
|
call co_reduce(caf, dt%arr) ! { dg-error "scalar nonallocatable nonpointer arguments and return a nonallocatable nonpointer scalar" }
|
|
call co_reduce(caf, ptr) ! { dg-error "scalar nonallocatable nonpointer arguments and return a nonallocatable nonpointer scalar" }
|
|
call co_reduce(caf, dt%ptr) ! { dg-error "scalar nonallocatable nonpointer arguments and return a nonallocatable nonpointer scalar" }
|
|
call co_reduce(caf, alloc) ! { dg-error "scalar nonallocatable nonpointer arguments and return a nonallocatable nonpointer scalar" }
|
|
call co_reduce(caf, dt%alloc) ! { dg-error "scalar nonallocatable nonpointer arguments and return a nonallocatable nonpointer scalar" }
|
|
call co_reduce(caf, opt) ! { dg-error "shall not have the OPTIONAL attribute for either of the arguments" }
|
|
call co_reduce(caf, dt%opt) ! { dg-error "shall not have the OPTIONAL attribute for either of the arguments" }
|
|
call co_reduce(caf, val) ! { dg-error "shall have the VALUE attribute either for none or both arguments" }
|
|
call co_reduce(caf, dt%val) ! { dg-error "shall have the VALUE attribute either for none or both arguments" }
|
|
call co_reduce(caf, async) ! { dg-error "shall have the ASYNCHRONOUS attribute either for none or both arguments" }
|
|
call co_reduce(caf, dt%async) ! { dg-error "shall have the ASYNCHRONOUS attribute either for none or both arguments" }
|
|
call co_reduce(caf, tgt) ! { dg-error "shall have the TARGET attribute either for none or both arguments" }
|
|
call co_reduce(caf, dt%tgt) ! { dg-error "shall have the TARGET attribute either for none or both arguments" }
|
|
call co_reduce(c4, char44) ! OK
|
|
call co_reduce(c4, dt%char44) ! OK
|
|
call co_reduce(c3, char34) ! { dg-error "character length of the A argument at .1. and of the arguments of the OPERATOR at .2. shall be the same" }
|
|
call co_reduce(c3, dt%char34) ! { dg-error "character length of the A argument at .1. and of the arguments of the OPERATOR at .2. shall be the same" }
|
|
call co_reduce(c4, char34) ! { dg-error "The character length of the A argument at .1. and of the function result of the OPERATOR at .2. shall be the same" }
|
|
call co_reduce(c4, dt%char34) ! { dg-error "The character length of the A argument at .1. and of the function result of the OPERATOR at .2. shall be the same" }
|
|
|
|
contains
|
|
pure integer function valid(x,y)
|
|
integer, value :: x, y
|
|
end function valid
|
|
impure integer function nonpure(x,y)
|
|
integer, value :: x, y
|
|
end function nonpure
|
|
pure subroutine sub()
|
|
end subroutine sub
|
|
pure integer function arg3(x, y, z)
|
|
integer, value :: x, y, z
|
|
end function arg3
|
|
pure integer function arg1(x)
|
|
integer, value :: x
|
|
end function arg1
|
|
pure elemental integer function elem(x,y)
|
|
integer, value :: x, y
|
|
end function elem
|
|
pure real function realo(x,y)
|
|
integer, value :: x, y
|
|
end function realo
|
|
pure integer(8) function int8(x,y)
|
|
integer, value :: x, y
|
|
end function int8
|
|
pure integer function arr(x,y)
|
|
integer, intent(in) :: x(:), y
|
|
end function arr
|
|
pure integer function ptr(x,y)
|
|
integer, intent(in), pointer :: x, y
|
|
end function ptr
|
|
pure integer function alloc(x,y)
|
|
integer, intent(in), allocatable :: x, y
|
|
end function alloc
|
|
pure integer function opt(x,y)
|
|
integer, intent(in) :: x, y
|
|
optional :: x, y
|
|
end function opt
|
|
pure integer function val(x,y)
|
|
integer, value :: x
|
|
integer, intent(in) :: y
|
|
end function val
|
|
pure integer function tgt(x,y)
|
|
integer, intent(in) :: x, y
|
|
target :: x
|
|
end function tgt
|
|
pure integer function async(x,y)
|
|
integer, intent(in) :: x, y
|
|
asynchronous :: y
|
|
end function async
|
|
pure character(4) function char44(x,y)
|
|
character(len=4), value :: x, y
|
|
end function char44
|
|
pure character(3) function char34(x,y)
|
|
character(len=4), value :: x, y
|
|
end function char34
|
|
end program test
|