gcc/testsuite/gfortran.dg/gomp/declare-variant-8.f90

   1 ! { dg-do compile }
   2 ! { dg-additional-options "-fdump-tree-gimple" }
   3
   4 program main
   5   !$omp requires atomic_default_mem_order(seq_cst)
   6   !$omp declare target to (test3)
   7 contains
   8   subroutine f01 ()
   9   end subroutine
  10
  11   subroutine f02 ()
  12     !$omp declare variant (f01) match (user={condition(6 == 7)},implementation={vendor(gnu)})
  13   end subroutine
  14
  15   subroutine f03 ()
  16   end subroutine
  17
  18   subroutine f04 ()
  19     !$omp declare variant (f03) match (user={condition(6 == 6)},implementation={atomic_default_mem_order(seq_cst)})
  20   end subroutine
  21
  22   subroutine f05 ()
  23   end subroutine
  24
  25   subroutine f06 ()
  26     !$omp declare variant (f05) match (user={condition(1)},implementation={atomic_default_mem_order(relaxed)})
  27   end subroutine
  28
  29   subroutine f07 ()
  30   end subroutine
  31
  32   subroutine f08 ()
  33     !$omp declare variant (f07) match (construct={parallel,do},device={kind("any")})
  34   end subroutine
  35
  36   subroutine f09 ()
  37   end subroutine
  38
  39   subroutine f10 ()
  40     !$omp declare variant (f09) match (construct={parallel,do},implementation={vendor("gnu")})
  41   end subroutine
  42
  43   subroutine f11 ()
  44   end subroutine
  45
  46   subroutine f12 ()
  47     !$omp declare variant (f11) match (construct={parallel,do})
  48   end subroutine
  49
  50   subroutine f13 ()
  51   end subroutine
  52
  53   subroutine f14 ()
  54     !$omp declare variant (f13) match (construct={parallel,do})
  55   end subroutine
  56
  57   subroutine f15 ()
  58     !$omp declare target to (f13, f14)
  59   end subroutine
  60
  61   subroutine f16 ()
  62     !$omp declare variant (f15) match (implementation={vendor(llvm)})
  63   end subroutine
  64
  65   subroutine f17 ()
  66   end subroutine
  67
  68   subroutine f18 ()
  69     !$omp declare variant (f17) match (construct={target,parallel})
  70   end subroutine
  71
  72   subroutine f19 ()
  73   end subroutine
  74
  75   subroutine f20 ()
  76     !$omp declare variant (f19) match (construct={target,parallel})
  77   end subroutine
  78
  79   subroutine f22 ()
  80     !$omp declare variant (f21) match (construct={teams,parallel})
  81   end subroutine
  82
  83   subroutine f23 ()
  84   end subroutine
  85
  86   subroutine f24 ()
  87     !$omp declare variant (f23) match (construct={teams,parallel,do})
  88   end subroutine
  89
  90   subroutine f25 ()
  91   end subroutine
  92
  93   subroutine f27 ()
  94   end subroutine
  95
  96   subroutine f28 ()
  97     !$omp declare variant (f27) match (construct={teams,parallel,do})
  98   end subroutine
  99
 100   subroutine f30 ()
 101     !$omp declare variant (f29) match (implementation={vendor(gnu)})
 102   end subroutine
 103
 104   subroutine f31 ()
 105   end subroutine
 106
 107   subroutine f32 ()
 108     !$omp declare variant (f31) match (construct={teams,parallel,do})
 109   end subroutine
 110
 111   subroutine f33 ()
 112   end subroutine
 113
 114   subroutine f34 ()
 115     !$omp declare variant (f33) match (device={kind("any\0any")})       ! { dg-warning "unknown property '.any..0any.' of 'kind' selector" }
 116   end subroutine
 117
 118   subroutine f35 ()
 119   end subroutine
 120
 121   subroutine f36 ()
 122     !$omp declare variant (f35) match (implementation={vendor("gnu\0")})        ! { dg-warning "unknown property '.gnu..0.' of 'vendor' selector" }
 123   end subroutine
 124
 125   subroutine test1 ()
 126     integer :: i
 127
 128     call f02 () ! { dg-final { scan-tree-dump-times "f02 \\\(\\\);" 1 "gimple" } }
 129     call f04 () ! { dg-final { scan-tree-dump-times "f03 \\\(\\\);" 1 "gimple" } }
 130     call f06 () ! { dg-final { scan-tree-dump-times "f06 \\\(\\\);" 1 "gimple" } }
 131
 132     !$omp parallel
 133       !$omp do
 134       do i = 1, 2
 135         call f08 ()             ! { dg-final { scan-tree-dump-times "f07 \\\(\\\);" 1 "gimple" } }
 136       end do
 137       !$omp end do
 138     !$omp end parallel
 139
 140     !$omp parallel do
 141       do i = 1, 2
 142         call f10 ()             ! { dg-final { scan-tree-dump-times "f09 \\\(\\\);" 1 "gimple" } }
 143       end do
 144     !$omp end parallel do
 145
 146     !$omp do
 147       do i = 1, 2
 148         !$omp parallel
 149           call f12 ()   ! { dg-final { scan-tree-dump-times "f12 \\\(\\\);" 1 "gimple" } }
 150         !$omp end parallel
 151       end do
 152     !$omp end do
 153
 154     !$omp parallel
 155       !$omp target
 156         !$omp do
 157         do i = 1, 2
 158           call f14 ()           ! { dg-final { scan-tree-dump-times "f14 \\\(\\\);" 1 "gimple" } }
 159         end do
 160         !$omp end do
 161       !$omp end target
 162     !$omp end parallel
 163
 164     call f16 () ! { dg-final { scan-tree-dump-times "f16 \\\(\\\);" 1 "gimple" } }
 165     call f34 () ! { dg-final { scan-tree-dump-times "f34 \\\(\\\);" 1 "gimple" } }
 166     call f36 () ! { dg-final { scan-tree-dump-times "f36 \\\(\\\);" 1 "gimple" } }
 167   end subroutine
 168
 169   subroutine test2 ()
 170     ! OpenMP 5.0 specifies that the 'target' trait should be added for
 171     ! functions within a declare target block, but Fortran does not have
 172     ! the notion of a declare target _block_, so the variant is not used here.
 173     ! This may change in later versions of OpenMP.
 174
 175     !$omp declare target
 176     !$omp parallel
 177       call f18 ()       ! { dg-final { scan-tree-dump-times "f18 \\\(\\\);" 1 "gimple" } }
 178     !$omp end parallel
 179   end subroutine
 180
 181   subroutine test3 ()
 182     ! In the C version, this test was used to check that the
 183     ! 'declare target to' form of the directive did not result in the variant
 184     ! being used.
 185     !$omp parallel
 186       call f20 ()       ! { dg-final { scan-tree-dump-times "f20 \\\(\\\);" 1 "gimple" } }
 187     !$omp end parallel
 188   end subroutine
 189
 190   subroutine f21 ()
 191     integer :: i
 192     !$omp do
 193       do i = 1, 2
 194         call f24 ()     ! { dg-final { scan-tree-dump-times "f23 \\\(\\\);" 1 "gimple" } }
 195       end do
 196     !$omp end do
 197   end subroutine
 198
 199   subroutine f26 ()
 200     !$omp declare variant (f25) match (construct={teams,parallel})
 201
 202     integer :: i
 203     !$omp do
 204       do i = 1, 2
 205         call f28 ()     ! { dg-final { scan-tree-dump-times "f28 \\\(\\\);" 1 "gimple" } }
 206       end do
 207     !$omp end do
 208   end subroutine
 209
 210   subroutine f29 ()
 211     integer :: i
 212     !$omp do
 213       do i = 1, 2
 214         call f32 ()     ! { dg-final { scan-tree-dump-times "f32 \\\(\\\);" 1 "gimple" } }
 215       end do
 216     !$omp end do
 217   end subroutine
 218 end program