1! { dg-do run }
2! Check whether absent optional arguments are properly
3! handled with use_device_{addr,ptr}.
4program main
5  use iso_c_binding, only: c_ptr, c_loc, c_associated, c_f_pointer
6  implicit none (type, external)
7
8  integer, target :: u
9  integer, target :: v
10  integer, target :: w
11  integer, target :: x(4)
12  integer, target, allocatable :: y
13  integer, target, allocatable :: z(:)
14  type(c_ptr), target :: cptr
15  type(c_ptr), target :: cptr_in
16  integer :: dummy
17
18  u = 42
19  v = 5
20  w = 7
21  x = [3,4,6,2]
22  y = 88
23  z = [1,2,3]
24
25  !$omp target enter data map(to:u)
26  !$omp target data map(to:dummy) use_device_addr(u)
27   cptr_in = c_loc(u) ! Has to be outside 'foo' due to 'intent(in)'
28  !$omp end target data
29
30  call foo (u, v, w, x, y, z, cptr, cptr_in)
31  deallocate (y, z)
32contains
33  subroutine foo (u, v, w, x, y, z, cptr, cptr_in)
34    integer, target, optional, value :: v
35    integer, target, optional :: u, w
36    integer, target, optional :: x(:)
37    integer, target, optional, allocatable :: y
38    integer, target, optional, allocatable :: z(:)
39    type(c_ptr), target, optional, value :: cptr
40    type(c_ptr), target, optional, value, intent(in) :: cptr_in
41    integer :: d
42
43    type(c_ptr) :: p_u, p_v, p_w, p_x, p_y, p_z, p_cptr, p_cptr_in
44
45    !$omp target enter data map(to:w, x, y, z)
46    !$omp target data map(dummy) use_device_addr(x)
47      cptr = c_loc(x)
48    !$omp end target data
49
50    ! Need to map per-VALUE arguments, if present
51    if (present(v)) then
52      !$omp target enter data map(to:v)
53    else
54      stop 1
55    end if
56    if (present(cptr)) then
57      !$omp target enter data map(to:cptr)
58    else
59      stop 2
60    end if
61    if (present(cptr_in)) then
62      !$omp target enter data map(to:cptr_in)
63    else
64      stop 3
65    end if
66
67    !$omp target data map(d) use_device_addr(u, v, w, x, y, z)
68    !$omp target data map(d) use_device_addr(cptr, cptr_in)
69      if (.not. present(u)) stop 10
70      if (.not. present(v)) stop 11
71      if (.not. present(w)) stop 12
72      if (.not. present(x)) stop 13
73      if (.not. present(y)) stop 14
74      if (.not. present(z)) stop 15
75      if (.not. present(cptr)) stop 16
76      if (.not. present(cptr_in)) stop 17
77      p_u = c_loc(u)
78      p_v = c_loc(v)
79      p_w = c_loc(w)
80      p_x = c_loc(x)
81      p_y = c_loc(y)
82      p_z = c_loc(z)
83      p_cptr = c_loc(cptr)
84      p_cptr_in = c_loc(cptr_in)
85    !$omp end target data
86    !$omp end target data
87    call check(p_u, p_v, p_w, p_x, p_y, p_z, p_cptr, p_cptr_in, size(x), size(z))
88  end subroutine foo
89
90  subroutine check(p_u, p_v, p_w, p_x, p_y, p_z, p_cptr, p_cptr_in, Nx, Nz)
91    type(c_ptr), value :: p_u, p_v, p_w, p_x, p_y, p_z, p_cptr, p_cptr_in
92    integer, value :: Nx, Nz
93    integer, pointer :: c_u(:), c_v(:), c_w(:), c_x(:), c_y(:), c_z(:)
94    type(c_ptr), pointer :: c_cptr(:), c_cptr_in(:)
95
96    ! As is_device_ptr does not handle scalars, we map them to a size-1 array
97    call c_f_pointer(p_u, c_u, shape=[1])
98    call c_f_pointer(p_v, c_v, shape=[1])
99    call c_f_pointer(p_w, c_w, shape=[1])
100    call c_f_pointer(p_x, c_x, shape=[Nx])
101    call c_f_pointer(p_y, c_y, shape=[1])
102    call c_f_pointer(p_z, c_z, shape=[Nz])
103    call c_f_pointer(p_cptr, c_cptr, shape=[1])
104    call c_f_pointer(p_cptr_in, c_cptr_in, shape=[1])
105    call run_target(c_u, c_v, c_w, c_x, c_y, c_z, c_cptr, c_cptr_in, Nx, Nz)
106  end subroutine check
107
108  subroutine run_target(c_u, c_v, c_w, c_x, c_y, c_z, c_cptr, c_cptr_in, Nx, Nz)
109    integer, target :: c_u(:), c_v(:), c_w(:), c_x(:), c_y(:), c_z(:)
110    type(c_ptr) :: c_cptr(:), c_cptr_in(:)
111    integer, value :: Nx, Nz
112    !$omp target is_device_ptr(c_u, c_v, c_w, c_x, c_y, c_z, c_cptr, c_cptr_in) map(to:Nx, Nz)
113      call target_fn(c_u(1), c_v(1), c_w(1), c_x, c_y(1), c_z, c_cptr(1), c_cptr_in(1), Nx, Nz)
114    !$omp end target
115  end subroutine run_target
116
117  subroutine target_fn(c_u, c_v, c_w, c_x, c_y, c_z, c_cptr, c_cptr_in, Nx, Nz)
118    !$omp declare target
119    integer, target :: c_u, c_v, c_w, c_x(:), c_y, c_z(:)
120    type(c_ptr), value :: c_cptr, c_cptr_in
121    integer, value :: Nx, Nz
122    integer, pointer :: u, x(:)
123    if (c_u /= 42) stop 30
124    if (c_v /= 5) stop 31
125    if (c_w /= 7) stop 32
126    if (Nx /= 4) stop 33
127    if (any (c_x /= [3,4,6,2])) stop 34
128    if (c_y /= 88) stop 35
129    if (Nz /= 3) stop 36
130    if (any (c_z /= [1,2,3])) stop 37
131    if (.not. c_associated (c_cptr)) stop 38
132    if (.not. c_associated (c_cptr_in)) stop 39
133    if (.not. c_associated (c_cptr, c_loc(c_x))) stop 40
134    if (.not. c_associated (c_cptr_in, c_loc(c_u))) stop 41
135    call c_f_pointer(c_cptr_in, u)
136    call c_f_pointer(c_cptr, x, shape=[Nx])
137    if (u /= c_u .or. u /= 42)  stop 42
138    if (any (x /= c_x))  stop 43
139    if (any (x /= [3,4,6,2]))  stop 44
140  end subroutine target_fn
141end program main
142