gcc/libgomp/testsuite/libgomp.oacc-fortran/declare-5.f90

! { dg-do run }
! { dg-xfail-run-if "PR92790 - acc declare device_resident - Fortran common blocks not handled" { *-*-* } { "*" } { "-DACC_DEVICE_TYPE_host=1" } }

module vars
  implicit none
  real b
  !$acc declare device_resident (b)

  integer :: x, y, z
  common /block/ x, y, z
  !$acc declare device_resident (/block/)
end module vars

subroutine set()
  use openacc
  implicit none
  integer :: a(5), b(1), c, vals(7)
  common /another/ a, b, c
  !$acc declare device_resident (/another/)
  if (.not. acc_is_present (a)) stop 10
  if (.not. acc_is_present (b)) stop 11
  if (.not. acc_is_present (c)) stop 12

  vals = 99
  ! NOTE: The current (Nov 2019) implementation requires the 'present'
  ! as it tries to otherwises map the device_resident variables;
  ! following OpenMP 4.0 semantic: 'a' + 'b' are 'copy' (map fromto) and
  ! 'c' is firstprivate.
  !$acc parallel copyout(vals) present(a, b, c)
    a = [11,12,13,14,15]
    b = 16
    c = 47
    vals(1:5) = a
    vals(6:6) = b
    vals(7) = c
  !$acc end parallel

  if (.not. acc_is_present (a)) stop 13
  if (.not. acc_is_present (b)) stop 14
  if (.not. acc_is_present (c)) stop 15

  if (any (vals /= [11,12,13,14,15,16,47])) stop 16
end subroutine set

subroutine check()
  use openacc
  implicit none
  integer :: g, h(3), i(3)
  common /another/ g, h, i
  integer :: val(7)
  !$acc declare device_resident (/another/)
  if (.not. acc_is_present (g)) stop 20
  if (.not. acc_is_present (h)) stop 21
  if (.not. acc_is_present (i)) stop 22

  val = 99
  !$acc parallel copyout(val) present(g, h, i)
    val(5:7) = i
    val(1) = g
    val(2:4) = h
  !$acc end parallel

  if (.not. acc_is_present (g)) stop 23
  if (.not. acc_is_present (h)) stop 24
  if (.not. acc_is_present (i)) stop 25


  !print *, val
  if (any (val /= [11,12,13,14,15,16,47])) stop 26
end subroutine check


program test
  use vars
  use openacc
  implicit none
  real a
  integer :: k

  call set()
  call check()

  if (.not. acc_is_present (b)) stop 1
  if (.not. acc_is_present (x)) stop 2
  if (.not. acc_is_present (y)) stop 3
  if (.not. acc_is_present (z)) stop 4

  a = 2.0
  k = 42

  !$acc parallel copy (a, k)
    b = a
    a = 1.0
    a = a + b
    x = k
    y = 7*k - 2*x
    z = 3*y
    k = k - z + y
   !$acc end parallel

  if (.not. acc_is_present (b)) stop 5
  if (.not. acc_is_present (x)) stop 6
  if (.not. acc_is_present (y)) stop 7
  if (.not. acc_is_present (z)) stop 8

  if (a /= 3.0) stop 30
  if (k /= -378) stop 31
end program test