1! { dg-do compile { target vect_simd_clones } }
2! { dg-additional-options "-fdump-tree-gimple" }
3! { dg-additional-options "-mno-sse3" { target { i?86-*-* x86_64-*-* } } }
4
5program main
6  implicit none
7contains
8  integer function f01 (x)
9    integer, intent(in) :: x
10    f01 = x
11  end function
12
13  integer function f02 (x)
14    integer, intent(in) :: x
15    f02 = x
16  end function
17
18  integer function f03 (x)
19    integer, intent(in) :: x
20    f03 = x
21  end function
22
23  integer function f04 (x)
24    integer, intent(in) :: x
25    f04 = x
26  end function
27
28  integer function f05 (x)
29    integer, intent(in) :: x
30
31    !$omp declare variant (f01) match (device={isa("avx512f")}) ! 4 or 8
32    !$omp declare variant (f02) match (implementation={vendor(score(3):gnu)},device={kind(cpu)}) ! (1 or 2) + 3
33    !$omp declare variant (f03) match (user={condition(score(9):1)})
34    !$omp declare variant (f04) match (implementation={vendor(score(6):gnu)},device={kind(host)}) ! (1 or 2) + 6
35    f05 = x
36  end function
37
38  integer function test1 (x)
39    !$omp declare simd
40    integer, intent(in) :: x
41
42    ! 0 or 1 (the latter if in a declare simd clone) constructs in OpenMP context,
43    ! isa has score 2^2 or 2^3.  We can't decide on whether avx512f will match or
44    ! not, that also depends on whether it is a declare simd clone or not and which
45    ! one, but the f03 variant has a higher score anyway.  */
46    test1 = f05 (x)	! { dg-final { scan-tree-dump-times "f03 \\\(x" 1 "gimple" } }
47  end function
48end program
49