1! { dg-do compile }
2! { dg-additional-options "-foffload=disable -fdump-tree-gimple" }
3! { dg-additional-options "-mavx512bw -mavx512vl" { target { i?86-*-* x86_64-*-* } } }
4
5program main
6  implicit none
7contains
8  subroutine f01 ()
9  end subroutine
10
11  subroutine f02 ()
12  end subroutine
13
14  subroutine f03 ()
15    !$omp declare variant (f01) match (device={isa(avx512f,"avx512vl")})
16    !$omp declare variant (f02) match (device={isa(avx512bw,avx512vl,"avx512f")})
17  end subroutine
18
19  subroutine f04 ()
20  end subroutine
21
22  subroutine f05 ()
23  end subroutine
24
25  subroutine f06 ()
26    !$omp declare variant (f04) match (device={isa(avx512f,avx512vl)})
27    !$omp declare variant (f05) match (device={isa(avx512bw,avx512vl,avx512f)})
28  end subroutine
29
30  subroutine f07 ()
31  end subroutine
32
33  subroutine f08 ()
34  end subroutine
35
36  subroutine f09 ()
37    !$omp declare variant (f07) match (device={isa(sse4,"sse4.1","sse4.2",sse3,"avx")})
38    !$omp declare variant (f08) match (device={isa("avx",sse3)})
39  end subroutine
40
41  subroutine f10 ()
42  end subroutine
43
44  subroutine f11 ()
45  end subroutine
46
47  subroutine f12 ()
48  end subroutine
49
50  subroutine f13 ()
51    !$omp declare variant (f10) match (device={isa("avx512f")})
52    !$omp declare variant (f11) match (user={condition(1)},device={isa(avx512f)},implementation={vendor(gnu)})
53    !$omp declare variant (f12) match (user={condition(2 + 1)},device={isa(avx512f)})
54  end subroutine
55
56  subroutine f14 ()
57  end subroutine
58
59  subroutine f15 ()
60  end subroutine
61
62  subroutine f16 ()
63  end subroutine
64
65  subroutine f17 ()
66  end subroutine
67
68  subroutine f18 ()
69    !$omp declare variant (f14) match (construct={teams,do})
70    !$omp declare variant (f15) match (construct={teams,parallel,do})
71    !$omp declare variant (f16) match (construct={do})
72    !$omp declare variant (f17) match (construct={parallel,do})
73  end subroutine
74
75  subroutine f19 ()
76  end subroutine
77
78  subroutine f20 ()
79  end subroutine
80
81  subroutine f21 ()
82  end subroutine
83
84  subroutine f22 ()
85  end subroutine
86
87  subroutine f23 ()
88    !$omp declare variant (f19) match (construct={teams,do})
89    !$omp declare variant (f20) match (construct={teams,parallel,do})
90    !$omp declare variant (f21) match (construct={do})
91    !$omp declare variant (f22) match (construct={parallel,do})
92  end subroutine
93
94  subroutine f24 ()
95  end subroutine
96
97  subroutine f25 ()
98  end subroutine
99
100  subroutine f26 ()
101  end subroutine
102
103  subroutine f27 ()
104    !$omp declare variant (f24) match (device={kind(cpu)})
105    !$omp declare variant (f25) match (device={kind(cpu),isa(avx512f),arch(x86_64)})
106    !$omp declare variant (f26) match (device={arch(x86_64),kind(cpu)})
107  end subroutine
108
109  subroutine test1
110    integer :: i
111    call f03 ()	! { dg-final { scan-tree-dump-times "f02 \\\(\\\);" 1 "gimple" { target i?86-*-* x86_64-*-* } } }
112		! { dg-final { scan-tree-dump-times "f03 \\\(\\\);" 1 "gimple" { target { ! { i?86-*-* x86_64-*-* } } } } }
113    call f09 ()	! { dg-final { scan-tree-dump-times "f07 \\\(\\\);" 1 "gimple" { target i?86-*-* x86_64-*-* } } }
114		! { dg-final { scan-tree-dump-times "f09 \\\(\\\);" 1 "gimple" { target { ! { i?86-*-* x86_64-*-* } } } } }
115    call f13 ()	! { dg-final { scan-tree-dump-times "f11 \\\(\\\);" 1 "gimple" { target i?86-*-* x86_64-*-* } } }
116		! { dg-final { scan-tree-dump-times "f13 \\\(\\\);" 1 "gimple" { target { ! { i?86-*-* x86_64-*-* } } } } }
117    !$omp teams distribute parallel do
118    do i = 1, 2
119      call f18 ()	! { dg-final { scan-tree-dump-times "f15 \\\(\\\);" 1 "gimple" } }
120    end do
121    !$omp end teams distribute parallel do
122
123    !$omp parallel do
124    do i = 1, 2
125      call f23 ()	! { dg-final { scan-tree-dump-times "f22 \\\(\\\);" 1 "gimple" } }
126    end do
127    !$omp end parallel do
128
129    call f27 ()	! { dg-final { scan-tree-dump-times "f25 \\\(\\\);" 1 "gimple" { target { { i?86-*-* x86_64-*-* } && lp64 } } } }
130		! { dg-final { scan-tree-dump-times "f24 \\\(\\\);" 1 "gimple" { target { { i?86-*-* x86_64-*-* } && { ! lp64 } } } } }
131		! { dg-final { scan-tree-dump-times "f24 \\\(\\\);" 1 "gimple" { target { ! { nvptx*-*-* amdgcn*-*-* i?86-*-* x86_64-*-* } } } } }
132		! { dg-final { scan-tree-dump-times "f27 \\\(\\\);" 1 "gimple" { target { nvptx*-*-* amdgcn*-*-* } } } }
133  end subroutine
134end program
135