1! { dg-do compile }
2! { dg-options "-fmax-errors=1000 -fopenmp" }
3
4module m
5contains
6  function fn1 (x, y)
7    integer, intent(in) :: x, y
8    integer :: fn1
9    fn1 = x + 2 * y
10  end function
11  subroutine sub1 (x, y)
12    integer, intent(in) :: y
13    integer, intent(out) :: x
14    x = y
15  end subroutine
16  function fn2 (x)
17    integer, intent(in) :: x
18    integer :: fn2
19    fn2 = x
20  end function
21  subroutine sub2 (x, y)
22    integer, intent(in) :: y
23    integer, intent(inout) :: x
24    x = x + y
25  end subroutine
26  function fn3 (x, y)
27    integer, intent(in) :: x(:), y(:)
28    integer :: fn3(lbound(x, 1):ubound(x, 1))
29    fn3 = x + 2 * y
30  end function
31  subroutine sub3 (x, y)
32    integer, intent(in) :: y(:)
33    integer, intent(out) :: x(:)
34    x = y
35  end subroutine
36  function fn4 (x)
37    integer, intent(in) :: x(:)
38    integer :: fn4(lbound(x, 1):ubound(x, 1))
39    fn4 = x
40  end function
41  subroutine sub4 (x, y)
42    integer, intent(in) :: y(:)
43    integer, intent(inout) :: x(:)
44    x = x + y
45  end subroutine
46  function fn5 (x, y)
47    integer, intent(in) :: x(10), y(10)
48    integer :: fn5(10)
49    fn5 = x + 2 * y
50  end function
51  subroutine sub5 (x, y)
52    integer, intent(in) :: y(10)
53    integer, intent(out) :: x(10)
54    x = y
55  end subroutine
56  function fn6 (x)
57    integer, intent(in) :: x(10)
58    integer :: fn6(10)
59    fn6 = x
60  end function
61  subroutine sub6 (x, y)
62    integer, intent(in) :: y(10)
63    integer, intent(inout) :: x(10)
64    x = x + y
65  end subroutine
66  function fn7 (x, y)
67    integer, allocatable, intent(in) :: x(:), y(:)
68    integer, allocatable :: fn7(:)
69    fn7 = x + 2 * y
70  end function
71  subroutine sub7 (x, y)
72    integer, allocatable, intent(in) :: y(:)
73    integer, allocatable, intent(out) :: x(:)
74    x = y
75  end subroutine
76  function fn8 (x)
77    integer, allocatable, intent(in) :: x(:)
78    integer, allocatable :: fn8(:)
79    fn8 = x
80  end function
81  subroutine sub8 (x, y)
82    integer, allocatable, intent(in) :: y(:)
83    integer, allocatable, intent(inout) :: x(:)
84    x = x + y
85  end subroutine
86end module
87subroutine test1
88  use m
89!$omp declare reduction (foo : integer : omp_out = omp_out + omp_in) initializer (omp_priv = 0)
90!$omp declare reduction (bar : integer : omp_out = fn1 (omp_out, omp_in)) & ! { dg-error "Rank mismatch in argument\[^\n\r]*scalar and rank-1" }
91!$omp & initializer (sub1 (omp_priv, omp_orig)) ! { dg-error "Rank mismatch in argument\[^\n\r]*scalar and rank-1" }
92!$omp declare reduction (baz : integer : sub2 (omp_out, omp_in)) & ! { dg-error "Rank mismatch in argument\[^\n\r]*scalar and rank-1" }
93!$omp initializer (omp_priv = fn2 (omp_orig)) ! { dg-error "Rank mismatch in argument\[^\n\r]*scalar and rank-1" }
94  integer :: a(10)
95!$omp parallel reduction (foo : a)
96!$omp end parallel
97!$omp parallel reduction (bar : a)
98!$omp end parallel
99!$omp parallel reduction (baz : a)
100!$omp end parallel
101end subroutine test1
102subroutine test2
103  use m
104!$omp declare reduction (foo : integer : omp_out = omp_out + omp_in) initializer (omp_priv = 0)
105!$omp declare reduction (bar : integer : omp_out = fn1 (omp_out, omp_in)) &
106!$omp & initializer (sub1 (omp_priv, omp_orig))
107!$omp declare reduction (baz : integer : sub2 (omp_out, omp_in)) &
108!$omp initializer (omp_priv = fn2 (omp_orig))
109  integer :: a
110!$omp parallel reduction (foo : a)
111!$omp end parallel
112!$omp parallel reduction (bar : a)
113!$omp end parallel
114!$omp parallel reduction (baz : a)
115!$omp end parallel
116end subroutine test2
117subroutine test3
118  use m
119!$omp declare reduction (foo : integer : omp_out = omp_out + omp_in) initializer (omp_priv = 0)
120!$omp declare reduction (bar : integer : omp_out = fn1 (omp_out, omp_in)) & ! { dg-error "Rank mismatch in argument\[^\n\r]*scalar and rank-1" }
121!$omp & initializer (sub1 (omp_priv, omp_orig)) ! { dg-error "Rank mismatch in argument\[^\n\r]*scalar and rank-1" }
122!$omp declare reduction (baz : integer : sub2 (omp_out, omp_in)) & ! { dg-error "Rank mismatch in argument\[^\n\r]*scalar and rank-1" }
123!$omp initializer (omp_priv = fn2 (omp_orig)) ! { dg-error "Rank mismatch in argument\[^\n\r]*scalar and rank-1" }
124  integer, allocatable :: a(:)
125  allocate (a(10))
126!$omp parallel reduction (foo : a)
127!$omp end parallel
128!$omp parallel reduction (bar : a)
129!$omp end parallel
130!$omp parallel reduction (baz : a)
131!$omp end parallel
132end subroutine test3
133subroutine test4
134  use m
135!$omp declare reduction (foo : integer : omp_out = omp_out + omp_in) initializer (omp_priv = 0)
136!$omp declare reduction (bar : integer : omp_out = fn1 (omp_out, omp_in)) &
137!$omp & initializer (sub1 (omp_priv, omp_orig))
138!$omp declare reduction (baz : integer : sub2 (omp_out, omp_in)) &
139!$omp initializer (omp_priv = fn2 (omp_orig))
140  integer, allocatable :: a
141  allocate (a)
142!$omp parallel reduction (foo : a)
143!$omp end parallel
144!$omp parallel reduction (bar : a)
145!$omp end parallel
146!$omp parallel reduction (baz : a)
147!$omp end parallel
148end subroutine test4
149subroutine test5
150  use m
151!$omp declare reduction (foo : integer : omp_out = omp_out + omp_in) initializer (omp_priv = 0)
152!$omp declare reduction (bar : integer : omp_out = fn3 (omp_out, omp_in)) &
153!$omp & initializer (sub3 (omp_priv, omp_orig))
154!$omp declare reduction (baz : integer : sub4 (omp_out, omp_in)) &
155!$omp initializer (omp_priv = fn4 (omp_orig))
156  integer :: a(10)
157!$omp parallel reduction (foo : a)
158!$omp end parallel
159!$omp parallel reduction (bar : a)
160!$omp end parallel
161!$omp parallel reduction (baz : a)
162!$omp end parallel
163end subroutine test5
164subroutine test6
165  use m
166!$omp declare reduction (foo : integer : omp_out = omp_out + omp_in) initializer (omp_priv = 0)
167!$omp declare reduction (bar : integer : omp_out = fn3 (omp_out, omp_in)) & ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar|Incompatible ranks 0 and 1 in assignment" }
168!$omp & initializer (sub3 (omp_priv, omp_orig)) ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar" }
169!$omp declare reduction (baz : integer : sub4 (omp_out, omp_in)) & ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar" }
170!$omp initializer (omp_priv = fn4 (omp_orig)) ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar|Incompatible ranks 0 and 1 in assignment" }
171  integer :: a
172!$omp parallel reduction (foo : a)
173!$omp end parallel
174!$omp parallel reduction (bar : a)
175!$omp end parallel
176!$omp parallel reduction (baz : a)
177!$omp end parallel
178end subroutine test6
179subroutine test7
180  use m
181!$omp declare reduction (foo : integer : omp_out = omp_out + omp_in) initializer (omp_priv = 0)
182!$omp declare reduction (bar : integer : omp_out = fn3 (omp_out, omp_in)) &
183!$omp & initializer (sub3 (omp_priv, omp_orig))
184!$omp declare reduction (baz : integer : sub4 (omp_out, omp_in)) &
185!$omp initializer (omp_priv = fn4 (omp_orig))
186  integer, allocatable :: a(:)
187  allocate (a(10))
188!$omp parallel reduction (foo : a)
189!$omp end parallel
190!$omp parallel reduction (bar : a)
191!$omp end parallel
192!$omp parallel reduction (baz : a)
193!$omp end parallel
194end subroutine test7
195subroutine test8
196  use m
197!$omp declare reduction (foo : integer : omp_out = omp_out + omp_in) initializer (omp_priv = 0)
198!$omp declare reduction (bar : integer : omp_out = fn3 (omp_out, omp_in)) & ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar|Incompatible ranks 0 and 1 in assignment" }
199!$omp & initializer (sub3 (omp_priv, omp_orig)) ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar" }
200!$omp declare reduction (baz : integer : sub4 (omp_out, omp_in)) & ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar" }
201!$omp initializer (omp_priv = fn4 (omp_orig)) ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar|Incompatible ranks 0 and 1 in assignment" }
202  integer, allocatable :: a
203  allocate (a)
204!$omp parallel reduction (foo : a)
205!$omp end parallel
206!$omp parallel reduction (bar : a)
207!$omp end parallel
208!$omp parallel reduction (baz : a)
209!$omp end parallel
210end subroutine test8
211subroutine test9
212  use m
213!$omp declare reduction (foo : integer : omp_out = omp_out + omp_in) initializer (omp_priv = 0)
214!$omp declare reduction (bar : integer : omp_out = fn5 (omp_out, omp_in)) &
215!$omp & initializer (sub5 (omp_priv, omp_orig))
216!$omp declare reduction (baz : integer : sub6 (omp_out, omp_in)) &
217!$omp initializer (omp_priv = fn6 (omp_orig))
218  integer :: a(10)
219!$omp parallel reduction (foo : a)
220!$omp end parallel
221!$omp parallel reduction (bar : a)
222!$omp end parallel
223!$omp parallel reduction (baz : a)
224!$omp end parallel
225end subroutine test9
226subroutine test10
227  use m
228!$omp declare reduction (foo : integer : omp_out = omp_out + omp_in) initializer (omp_priv = 0)
229!$omp declare reduction (bar : integer : omp_out = fn5 (omp_out, omp_in)) & ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar|Incompatible ranks 0 and 1 in assignment" }
230!$omp & initializer (sub5 (omp_priv, omp_orig)) ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar" }
231!$omp declare reduction (baz : integer : sub6 (omp_out, omp_in)) & ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar" }
232!$omp initializer (omp_priv = fn6 (omp_orig)) ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar|Incompatible ranks 0 and 1 in assignment" }
233  integer :: a
234!$omp parallel reduction (foo : a)
235!$omp end parallel
236!$omp parallel reduction (bar : a)
237!$omp end parallel
238!$omp parallel reduction (baz : a)
239!$omp end parallel
240end subroutine test10
241subroutine test11
242  use m
243!$omp declare reduction (foo : integer : omp_out = omp_out + omp_in) initializer (omp_priv = 0)
244!$omp declare reduction (bar : integer : omp_out = fn5 (omp_out, omp_in)) &
245!$omp & initializer (sub5 (omp_priv, omp_orig))
246!$omp declare reduction (baz : integer : sub6 (omp_out, omp_in)) &
247!$omp initializer (omp_priv = fn6 (omp_orig))
248  integer, allocatable :: a(:)
249  allocate (a(10))
250!$omp parallel reduction (foo : a)
251!$omp end parallel
252!$omp parallel reduction (bar : a)
253!$omp end parallel
254!$omp parallel reduction (baz : a)
255!$omp end parallel
256end subroutine test11
257subroutine test12
258  use m
259!$omp declare reduction (foo : integer : omp_out = omp_out + omp_in) initializer (omp_priv = 0)
260!$omp declare reduction (bar : integer : omp_out = fn5 (omp_out, omp_in)) & ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar|Incompatible ranks 0 and 1 in assignment" }
261!$omp & initializer (sub5 (omp_priv, omp_orig)) ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar" }
262!$omp declare reduction (baz : integer : sub6 (omp_out, omp_in)) & ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar" }
263!$omp initializer (omp_priv = fn6 (omp_orig)) ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar|Incompatible ranks 0 and 1 in assignment" }
264  integer, allocatable :: a
265  allocate (a)
266!$omp parallel reduction (foo : a)
267!$omp end parallel
268!$omp parallel reduction (bar : a)
269!$omp end parallel
270!$omp parallel reduction (baz : a)
271!$omp end parallel
272end subroutine test12
273subroutine test13
274  use m
275!$omp declare reduction (foo : integer : omp_out = omp_out + omp_in) initializer (omp_priv = 0)
276!$omp declare reduction (bar : integer : omp_out = & ! { dg-error "Different shape for array assignment at \[^\n\r]* on dimension 1 .9 and 10" }
277!$omp & fn5 (omp_out, omp_in)) & ! { dg-error "Actual argument contains too few elements for dummy argument \[^\n\r]* .9/10" }
278!$omp & initializer (sub5 (omp_priv, omp_orig)) ! { dg-error "Actual argument contains too few elements for dummy argument \[^\n\r]* .9/10" }
279!$omp declare reduction (baz : integer : sub6 (omp_out, omp_in)) & ! { dg-error "Actual argument contains too few elements for dummy argument \[^\n\r]* .9/10" }
280!$omp initializer (omp_priv = & ! { dg-error "Different shape for array assignment at \[^\n\r]* on dimension 1 .9 and 10" }
281!$omp & fn6 (omp_orig)) ! { dg-error "Actual argument contains too few elements for dummy argument \[^\n\r]* .9/10" }
282  integer :: a(9)
283!$omp parallel reduction (foo : a)
284!$omp end parallel
285!$omp parallel reduction (bar : a)
286!$omp end parallel
287!$omp parallel reduction (baz : a)
288!$omp end parallel
289end subroutine test13
290subroutine test14
291  use m
292!$omp declare reduction (foo : integer : omp_out = omp_out + omp_in) initializer (omp_priv = 0)
293!$omp declare reduction (bar : integer : omp_out = fn7 (omp_out, omp_in)) & ! { dg-error "Actual argument for \[^\n\r]* must be ALLOCATABLE" }
294!$omp & initializer (sub7 (omp_priv, omp_orig)) ! { dg-error "Actual argument for \[^\n\r]* must be ALLOCATABLE" }
295!$omp declare reduction (baz : integer : sub8 (omp_out, omp_in)) & ! { dg-error "Actual argument for \[^\n\r]* must be ALLOCATABLE" }
296!$omp initializer (omp_priv = fn8 (omp_orig)) ! { dg-error "Actual argument for \[^\n\r]* must be ALLOCATABLE" }
297  integer :: a(10)
298!$omp parallel reduction (foo : a)
299!$omp end parallel
300!$omp parallel reduction (bar : a)
301!$omp end parallel
302!$omp parallel reduction (baz : a)
303!$omp end parallel
304end subroutine test14
305subroutine test15
306  use m
307!$omp declare reduction (foo : integer : omp_out = omp_out + omp_in) initializer (omp_priv = 0)
308!$omp declare reduction (bar : integer : omp_out = fn7 (omp_out, omp_in)) & ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar|Incompatible ranks 0 and 1 in assignment" }
309!$omp & initializer (sub7 (omp_priv, omp_orig)) ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar" }
310!$omp declare reduction (baz : integer : sub8 (omp_out, omp_in)) & ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar" }
311!$omp initializer (omp_priv = fn8 (omp_orig)) ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar|Incompatible ranks 0 and 1 in assignment" }
312  integer :: a
313!$omp parallel reduction (foo : a)
314!$omp end parallel
315!$omp parallel reduction (bar : a)
316!$omp end parallel
317!$omp parallel reduction (baz : a)
318!$omp end parallel
319end subroutine test15
320subroutine test16
321  use m
322!$omp declare reduction (foo : integer : omp_out = omp_out + omp_in) initializer (omp_priv = 0)
323!$omp declare reduction (bar : integer : omp_out = fn7 (omp_out, omp_in)) &
324!$omp & initializer (sub7 (omp_priv, omp_orig))
325!$omp declare reduction (baz : integer : sub8 (omp_out, omp_in)) &
326!$omp initializer (omp_priv = fn8 (omp_orig))
327  integer, allocatable :: a(:)
328  allocate (a(10))
329!$omp parallel reduction (foo : a)
330!$omp end parallel
331!$omp parallel reduction (bar : a)
332!$omp end parallel
333!$omp parallel reduction (baz : a)
334!$omp end parallel
335end subroutine test16
336subroutine test17
337  use m
338!$omp declare reduction (foo : integer : omp_out = omp_out + omp_in) initializer (omp_priv = 0)
339!$omp declare reduction (bar : integer : omp_out = fn7 (omp_out, omp_in)) & ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar|Incompatible ranks 0 and 1 in assignment" }
340!$omp & initializer (sub7 (omp_priv, omp_orig)) ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar" }
341!$omp declare reduction (baz : integer : sub8 (omp_out, omp_in)) & ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar" }
342!$omp initializer (omp_priv = fn8 (omp_orig)) ! { dg-error "Rank mismatch in argument\[^\n\r]*rank-1 and scalar|Incompatible ranks 0 and 1 in assignment" }
343  integer, allocatable :: a
344  allocate (a)
345!$omp parallel reduction (foo : a)
346!$omp end parallel
347!$omp parallel reduction (bar : a)
348!$omp end parallel
349!$omp parallel reduction (baz : a)
350!$omp end parallel
351end subroutine test17
352