1! { dg-do compile } 2! { dg-additional-options "-fdump-tree-gimple" } 3 4program main 5 !$omp requires atomic_default_mem_order(seq_cst) 6 !$omp declare target to (test3) 7contains 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 218end program 219