gcc/libgomp/testsuite/libgomp.oacc-fortran/dynamic-pointer-1.f90

! Verify that a 'enter data'ed 'pointer' object creates a persistent, visible device copy

! { dg-do run }
! { dg-skip-if "" { *-*-* } { "*" } { "-DACC_MEM_SHARED=0" } }

module m
  implicit none
contains

  subroutine verify_a (a_ref, a)
    implicit none
    integer, dimension (:, :, :), allocatable :: a_ref
    integer, dimension (:, :, :), pointer :: a

    !$acc routine seq

    if (any (lbound (a) /= lbound (a_ref))) stop 101
    if (any (ubound (a) /= ubound (a_ref))) stop 102
    if (size (a) /= size (a_ref)) stop 103
  end subroutine verify_a

end module m

program main
  use m
  use openacc
  implicit none
  integer, parameter :: n = 30
  integer, dimension (:, :, :), allocatable, target :: a1, a2
  integer, dimension (:, :, :), pointer :: p

  allocate (a1(1:n, 0:n-1, 10:n/2))
  !$acc enter data create(a1)
  allocate (a2(3:n/3, 10:n, n-10:n+10))
  !$acc enter data create(a2)

  p => a1
  call verify_a(a1, p)

  ! 'p' object isn't present on the device.
  !$acc parallel ! Implicit 'copy(p)'; creates 'p' object...
  call verify_a(a1, p)
  !$acc end parallel ! ..., and deletes it again.

  p => a2
  call verify_a(a2, p)

  ! 'p' object isn't present on the device.
  !$acc parallel ! Implicit 'copy(p)'; creates 'p' object...
  call verify_a(a2, p)
  !$acc end parallel ! ..., and deletes it again.

  p => a1

  !$acc enter data create(p)
  ! 'p' object is now present on the device (visible device copy).
  !TODO PR96080 if (.not. acc_is_present (p)) stop 1

  !$acc parallel
  ! On the device, got created as 'p => a1'.
  call verify_a(a1, p)
  !$acc end parallel
  call verify_a(a1, p)

  !$acc parallel
  p => a2
  ! On the device, 'p => a2' is now set.
  call verify_a(a2, p)
  !$acc end parallel
  ! On the host, 'p => a1' persists.
  call verify_a(a1, p)

  !$acc parallel
  ! On the device, 'p => a2' persists.
  call verify_a(a2, p)
  !$acc end parallel
  ! On the host, 'p => a1' still persists.
  call verify_a(a1, p)

  p => a2

  !$acc parallel
  p => a1
  ! On the device, 'p => a1' is now set.
  call verify_a(a1, p)
  !$acc end parallel
  ! On the host, 'p => a2' persists.
  call verify_a(a2, p)

  !$acc parallel
  ! On the device, 'p => a1' persists.
  call verify_a(a1, p)
  !$acc end parallel
  ! On the host, 'p => a2' still persists.
  call verify_a(a2, p)

end program main