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
6 implicit none (type, external)
7 integer, allocatable :: a_w, a_x(:)
8 integer, pointer :: p_w, p_x(:)
9
10 nullify (p_w, p_x)
11 call foo()
12
13 ! unallocated/disassociated actual arguments to nonallocatable, nonpointer
14 ! dummy arguments are regarded as absent
15 call foo (w=a_w, x=a_x)
16 call foo (w=p_w, x=p_x)
17
18contains
19
20  subroutine foo(v, w, x, y, z, cptr, cptr_in)
21    integer, target, optional, value :: v
22    integer, target, optional :: w
23    integer, target, optional :: x(:)
24    integer, target, optional, allocatable :: y
25    integer, target, optional, allocatable :: z(:)
26    type(c_ptr), target, optional, value :: cptr
27    type(c_ptr), target, optional, value, intent(in) :: cptr_in
28    integer :: d
29
30    ! Need to map per-VALUE arguments, if present
31    if (present(v)) then
32      !$omp target enter data map(to:v)
33      stop 1  ! – but it shall not be present in this test case.
34    end if
35    if (present(cptr)) then
36      !$omp target enter data map(to:cptr)
37      stop 2  ! – but it shall not be present in this test case.
38    end if
39    if (present(cptr_in)) then
40      !$omp target enter data map(to:cptr_in)
41      stop 3  ! – but it shall not be present in this test case.
42    end if
43
44    !$omp target data map(d) use_device_addr(v, w, x, y, z, cptr, cptr_in)
45      if (present(v)) then; v    = 5; stop 11; endif
46      if (present(w)) then; w    = 5; stop 12; endif
47      if (present(x)) then; x(1) = 5; stop 13; endif
48      if (present(y)) then; y    = 5; stop 14; endif
49      if (present(z)) then; z(1) = 5; stop 15; endif
50      if (present(cptr)) then; cptr = c_loc(v); stop 16; endif
51      if (present(cptr_in)) then
52        if (c_associated(cptr_in, c_loc(x))) stop 17
53        stop 18
54      endif
55    !$omp end target data
56
57! Using 'v' in use_device_ptr gives an ICE
58! TODO: Find out what the OpenMP spec permits for use_device_ptr
59
60    !$omp target data map(d) use_device_ptr(w, x, y, z, cptr, cptr_in)
61      if (present(w)) then; w    = 5; stop 21; endif
62      if (present(x)) then; x(1) = 5; stop 22; endif
63      if (present(y)) then; y    = 5; stop 23; endif
64      if (present(z)) then; z(1) = 5; stop 24; endif
65      if (present(cptr)) then; cptr = c_loc(x); stop 25; endif
66      if (present(cptr_in)) then
67        if (c_associated(cptr_in, c_loc(x))) stop 26
68        stop 27
69      endif
70    !$omp end target data
71  end subroutine foo
72end program main
73