1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
|
! { 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
|
