1program main
2  use omp_lib
3  use iso_c_binding
4  implicit none (type, external)
5
6  integer :: d, id
7  integer(kind=1), target :: a(4)
8  integer(kind=1), pointer :: p, q
9
10  d = omp_get_default_device ()
11  id = omp_get_initial_device ()
12
13  if (d < 0 .or. d >= omp_get_num_devices ()) &
14    d = id
15
16  a = transfer (int(z'cdcdcdcd'), mold=a)
17
18  !$omp target enter data map (to:a)
19
20  a = transfer (int(z'abababab'), mold=a)
21  p => a(1)
22  q => a(3)
23
24  !$omp target enter data map (alloc:p, q)
25
26  if (d /= id) then
27    if (omp_target_is_present (c_loc(a), d) == 0) &
28      stop 1
29    if (omp_target_is_present (c_loc(p), d) == 0) &
30      stop 2
31    if (omp_target_is_present (c_loc(q), d) == 0) &
32      stop 3
33  end if
34
35  !$omp target exit data map (release:a)
36
37    if (d /= id) then
38      if (omp_target_is_present (c_loc(a), d) == 0) &
39        stop 4
40      if (omp_target_is_present (c_loc(p), d) == 0) &
41        stop 5
42      if (omp_target_is_present (c_loc(q), d) == 0) &
43        stop 6
44    end if
45
46  !$omp target exit data map (from:q)
47
48    if (d /= id) then
49      if (omp_target_is_present (c_loc(a), d) /= 0) &
50        stop 7
51      if (omp_target_is_present (c_loc(p), d) /= 0) &
52        stop 8
53      if (omp_target_is_present (c_loc(q), d) /= 0) &
54        stop 9
55
56      if (q /= int(z'cd', kind=1)) &
57        stop 10
58      if (p /= int(z'ab', kind=1)) &
59        stop 11
60    end if
61end program main
62