1! { dg-do run }
2!
3! Test if, if_present clauses on host_data construct.
4!
5! Fortran variant of 'libgomp.oacc-c-c++-common/host_data-7.c'.
6!
7program main
8  use iso_c_binding
9  implicit none
10  real, target :: var, arr(100)
11  integer(c_intptr_t) :: host_p, host_parr
12  host_p = transfer(c_loc(var), host_p)
13  host_parr = transfer(c_loc(arr), host_parr)
14  call foo (var, arr, host_p, host_parr, .false.)
15  call foo (var, arr, host_p, host_parr, .true.)
16
17contains
18
19subroutine foo (p2, parr, host_p, host_parr, cond)
20  use openacc
21  implicit none
22  real, target, intent(in) :: parr(:), p2
23  integer(c_intptr_t), value, intent(in) :: host_p, host_parr
24  logical, value, intent(in) :: cond
25  real, pointer :: p
26  p => p2
27
28  if (host_p /= transfer(c_loc(p), host_p)) stop 1
29  if (host_parr /= transfer(c_loc(parr), host_parr)) stop 2
30#if !ACC_MEM_SHARED
31  if (acc_is_present(p, c_sizeof(p))) stop 3
32  if (acc_is_present(parr, 1)) stop 4
33#endif
34
35  !$acc data copyin(host_p, host_parr)
36#if !ACC_MEM_SHARED
37    if (acc_is_present(p, c_sizeof(p))) stop 5
38    if (acc_is_present(parr, 1)) stop 6
39#endif
40    !$acc host_data use_device(p, parr) if_present
41      ! not mapped yet, so it will be equal to the host pointer.
42      if (transfer(c_loc(p), host_p) /= host_p) stop 7
43      if (transfer(c_loc(parr), host_parr) /= host_parr) stop 8
44    !$acc end host_data
45#if !ACC_MEM_SHARED
46    if (acc_is_present(p, c_sizeof(p))) stop 9
47    if (acc_is_present(parr, 1)) stop 10
48#endif
49
50    !$acc data copy(p, parr)
51      if (.not. acc_is_present(p, c_sizeof(p))) stop 11
52      if (.not. acc_is_present(parr, 1)) stop 12
53      ! Not inside a host_data construct, so still the host pointer.
54      if (transfer(c_loc(p), host_p) /= host_p) stop 13
55      if (transfer(c_loc(parr), host_parr) /= host_parr) stop 14
56
57      !$acc host_data use_device(p, parr)
58#if ACC_MEM_SHARED
59        if (transfer(c_loc(p), host_p) /= host_p) stop 15
60        if (transfer(c_loc(parr), host_parr) /= host_parr) stop 16
61#else
62        ! The device address is different from host address.
63        if (transfer(c_loc(p), host_p) == host_p) stop 17
64        if (transfer(c_loc(parr), host_parr) == host_parr) stop 18
65#endif
66      !$acc end host_data
67
68      !$acc host_data use_device(p, parr) if_present
69#if ACC_MEM_SHARED
70        if (transfer(c_loc(p), host_p) /= host_p) stop 19
71        if (transfer(c_loc(parr), host_parr) /= host_parr) stop 20
72#else
73        ! is present now, so this is the same as above.
74        if (transfer(c_loc(p), host_p) == host_p) stop 21
75        if (transfer(c_loc(parr), host_parr) == host_parr) stop 22
76#endif
77      !$acc end host_data
78
79      !$acc host_data use_device(p, parr) if(cond)
80#if ACC_MEM_SHARED
81        if (transfer(c_loc(p), host_p) /= host_p) stop 23
82        if (transfer(c_loc(parr), host_parr) /= host_parr) stop 24
83#else
84        ! is the device pointer iff cond is true.
85        if ((transfer(c_loc(p), host_p) /= host_p) .neqv. cond) stop 25
86        if ((transfer(c_loc(parr), host_parr) /= host_parr) .neqv. cond) stop 26
87#endif
88      !$acc end host_data
89    !$acc end data
90  !$acc end data
91end subroutine foo
92end
93