(root)/
gcc-13.2.0/
libgomp/
testsuite/
libgomp.fortran/
refcount-1.f90
program main
  use omp_lib
  use iso_c_binding
  implicit none (type, external)

  integer :: d, id
  integer(kind=1), target :: a(4)
  integer(kind=1), pointer :: p, q

  d = omp_get_default_device ()
  id = omp_get_initial_device ()

  if (d < 0 .or. d >= omp_get_num_devices ()) &
    d = id

  a = transfer (int(z'cdcdcdcd'), mold=a)

  !$omp target enter data map (to:a)

  a = transfer (int(z'abababab'), mold=a)
  p => a(1)
  q => a(3)

  !$omp target enter data map (alloc:p, q)

  if (d /= id) then
    if (omp_target_is_present (c_loc(a), d) == 0) &
      stop 1
    if (omp_target_is_present (c_loc(p), d) == 0) &
      stop 2
    if (omp_target_is_present (c_loc(q), d) == 0) &
      stop 3
  end if

  !$omp target exit data map (release:a)

    if (d /= id) then
      if (omp_target_is_present (c_loc(a), d) == 0) &
        stop 4
      if (omp_target_is_present (c_loc(p), d) == 0) &
        stop 5
      if (omp_target_is_present (c_loc(q), d) == 0) &
        stop 6
    end if

  !$omp target exit data map (from:q)

    if (d /= id) then
      if (omp_target_is_present (c_loc(a), d) /= 0) &
        stop 7
      if (omp_target_is_present (c_loc(p), d) /= 0) &
        stop 8
      if (omp_target_is_present (c_loc(q), d) /= 0) &
        stop 9

      if (q /= int(z'cd', kind=1)) &
        stop 10
      if (p /= int(z'ab', kind=1)) &
        stop 11
    end if
end program main