1! PR middle-end/99928
2! { dg-do compile }
3! { dg-options "-fopenmp -fdump-tree-gimple" }
4
5module m
6  implicit none
7  integer :: r00, r01, r02
8
9contains
10
11subroutine bar ()
12  integer :: i
13  ! { dg-final { scan-tree-dump-not "omp master\[^\n\r]*in_reduction\\(\\+:r00\\)" "gimple" } }
14  ! { dg-final { scan-tree-dump "omp taskloop\[^\n\r]*in_reduction\\(\\+:r00\\)" "gimple" } }
15  !$omp master taskloop in_reduction(+:r00)
16  do i = 1, 64
17    r00 = r00 + 1
18  end do
19  ! { dg-final { scan-tree-dump-not "omp master\[^\n\r]*in_reduction\\(\\+:r01\\)" "gimple" } }
20  ! { dg-final { scan-tree-dump "omp taskloop\[^\n\r]*in_reduction\\(\\+:r01\\)" "gimple" } }
21  ! { dg-final { scan-tree-dump-not "omp simd\[^\n\r]*in_reduction\\(\\+:r01\\)" "gimple" } }
22  !$omp master taskloop simd in_reduction(+:r01)
23  do i = 1, 64
24    r01 = r01 + 1
25  end do
26  ! { dg-final { scan-tree-dump "omp taskloop\[^\n\r]*in_reduction\\(\\+:r02\\)" "gimple" } }
27  ! { dg-final { scan-tree-dump-not "omp simd\[^\n\r]*in_reduction\\(\\+:r02\\)" "gimple" } }
28  !$omp taskloop simd in_reduction(+:r02)
29  do i = 1, 64
30    r02 = r02 + 1
31  end do
32  ! FIXME: We don't support in_reduction clause on target yet, once we do, should
33  ! add testcase coverage for all combined/composite constructs with target as leaf construct.
34end
35end module m
36