Fortran] OpenMP/OpenACC – fix more issues with OPTIONAL

        gcc/fortran/
        * trans-openmp.c (gfc_omp_check_optional_argument): Always return a
        Boolean expression; handle unallocated/disassociated actual arguments
        as absent if passed to nonallocatable/nonpointer dummy array arguments.
        (gfc_build_cond_assign): Change to assume a Boolean expr not a pointer.
        (gfc_omp_finish_clause, gfc_trans_omp_clauses): Assign NULL to generated
        array-data variable if the argument is absent. Simplify code as
        'present' is now a Boolean expression.

        libgomp/
        * testsuite/libgomp.fortran/optional-map.f90: Add test for
        unallocated/disassociated actual arguments to nonallocatable/nonpointer
        dummy arguments; those are/shall be regarded as absent arguments.
        * testsuite/libgomp.fortran/use_device_ptr-optional-2.f90: Ditto.
        * testsuite/libgomp.fortran/use_device_ptr-optional-3.f90: New.

From-SVN: r279858

4 files changed, 172 insertions, 0 deletions

diff --git a/libgomp/ChangeLog b/libgomp/ChangeLog
index 4f9133125ac..a204585d7b8 100644
--- a/libgomp/ChangeLog
+++ b/libgomp/ChangeLog
@@ -1,3 +1,11 @@
+2020-01-03  Tobias Burnus  <tobias@codesourcery.com>
+
+	* testsuite/libgomp.fortran/optional-map.f90: Add test for
+	unallocated/disassociated actual arguments to nonallocatable/nonpointer
+	dummy arguments; those are/shall be regarded as absent arguments.
+	* testsuite/libgomp.fortran/use_device_ptr-optional-2.f90: Ditto.
+	* testsuite/libgomp.fortran/use_device_ptr-optional-3.f90: New.
+
 2020-01-01  Jakub Jelinek  <jakub@redhat.com>
 
 	Update copyright years.
diff --git a/libgomp/testsuite/libgomp.fortran/optional-map.f90 b/libgomp/testsuite/libgomp.fortran/optional-map.f90
index eebe58cc45c..b06efcc90d1 100644
--- a/libgomp/testsuite/libgomp.fortran/optional-map.f90
+++ b/libgomp/testsuite/libgomp.fortran/optional-map.f90
@@ -1,11 +1,24 @@
 ! { dg-do run }
 !
 implicit none (type, external)
+integer, allocatable :: a_ii, a_ival, a_iarr(:)
+integer, pointer :: p_ii, p_ival, p_iarr(:)
+
+nullify (p_ii, p_ival, p_iarr)
+
 call sub()
 call sub2()
 call call_present_1()
 call call_present_2()
 
+! unallocated/disassociated actual arguments to nonallocatable, nonpointer
+! dummy arguments are regarded as absent
+! Skipping 'ival' dummy argument due to PR fortran/92887
+call sub(ii=a_ii, iarr=a_iarr)
+call sub(ii=p_ii, iarr=p_iarr)
+call sub2(ii=a_ii, iarr=a_iarr)
+call sub2(ii=p_ii, iarr=p_iarr)
+
 contains
 
 subroutine call_present_1()
diff --git a/libgomp/testsuite/libgomp.fortran/use_device_ptr-optional-2.f90 b/libgomp/testsuite/libgomp.fortran/use_device_ptr-optional-2.f90
index d33b7d1cce0..641ebd98962 100644
--- a/libgomp/testsuite/libgomp.fortran/use_device_ptr-optional-2.f90
+++ b/libgomp/testsuite/libgomp.fortran/use_device_ptr-optional-2.f90
@@ -3,8 +3,19 @@
 program main
  use iso_c_binding, only: c_ptr, c_loc, c_associated
  implicit none (type, external)
+ integer, allocatable :: a_w, a_x(:)
+ integer, pointer :: p_w, p_x(:)
+
+ nullify (p_w, p_x)
  call foo()
+
+ ! unallocated/disassociated actual arguments to nonallocatable, nonpointer
+ ! dummy arguments are regarded as absent
+ call foo (w=a_w, x=a_x)
+ call foo (w=p_w, x=p_x)
+
 contains
+
   subroutine foo(v, w, x, y, z, cptr, cptr_in)
     integer, target, optional, value :: v
     integer, target, optional :: w
diff --git a/libgomp/testsuite/libgomp.fortran/use_device_ptr-optional-3.f90 b/libgomp/testsuite/libgomp.fortran/use_device_ptr-optional-3.f90
new file mode 100644
index 00000000000..f2e1a60757f
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/use_device_ptr-optional-3.f90
@@ -0,0 +1,140 @@
+! Check whether absent optional arguments are properly
+! handled with use_device_{addr,ptr}.
+program main
+  use iso_c_binding, only: c_ptr, c_loc, c_associated, c_f_pointer
+  implicit none (type, external)
+
+  integer, target :: u
+  integer, target :: v
+  integer, target :: w
+  integer, target :: x(4)
+  integer, target, allocatable :: y
+  integer, target, allocatable :: z(:)
+  type(c_ptr), target :: cptr
+  type(c_ptr), target :: cptr_in
+  integer :: dummy
+
+  u = 42
+  v = 5
+  w = 7
+  x = [3,4,6,2]
+  y = 88
+  z = [1,2,3]
+
+  !$omp target enter data map(to:u)
+  !$omp target data map(to:dummy) use_device_addr(u)
+   cptr_in = c_loc(u) ! Has to be outside 'foo' due to 'intent(in)'
+  !$omp end target data
+
+  call foo (u, v, w, x, y, z, cptr, cptr_in)
+  deallocate (y, z)
+contains
+  subroutine foo (u, v, w, x, y, z, cptr, cptr_in)
+    integer, target, optional, value :: v
+    integer, target, optional :: u, w
+    integer, target, optional :: x(:)
+    integer, target, optional, allocatable :: y
+    integer, target, optional, allocatable :: z(:)
+    type(c_ptr), target, optional, value :: cptr
+    type(c_ptr), target, optional, value, intent(in) :: cptr_in
+    integer :: d
+
+    type(c_ptr) :: p_u, p_v, p_w, p_x, p_y, p_z, p_cptr, p_cptr_in
+
+    !$omp target enter data map(to:w, x, y, z)
+    !$omp target data map(dummy) use_device_addr(x)
+      cptr = c_loc(x)
+    !$omp end target data
+
+    ! Need to map per-VALUE arguments, if present
+    if (present(v)) then
+      !$omp target enter data map(to:v)
+    else
+      stop 1
+    end if
+    if (present(cptr)) then
+      !$omp target enter data map(to:cptr)
+    else
+      stop 2
+    end if
+    if (present(cptr_in)) then
+      !$omp target enter data map(to:cptr_in)
+    else
+      stop 3
+    end if
+
+    !$omp target data map(d) use_device_addr(u, v, w, x, y, z)
+    !$omp target data map(d) use_device_addr(cptr, cptr_in)
+      if (.not. present(u)) stop 10
+      if (.not. present(v)) stop 11
+      if (.not. present(w)) stop 12
+      if (.not. present(x)) stop 13
+      if (.not. present(y)) stop 14
+      if (.not. present(z)) stop 15
+      if (.not. present(cptr)) stop 16
+      if (.not. present(cptr_in)) stop 17
+      p_u = c_loc(u)
+      p_v = c_loc(v)
+      p_w = c_loc(w)
+      p_x = c_loc(x)
+      p_y = c_loc(y)
+      p_z = c_loc(z)
+      p_cptr = c_loc(cptr)
+      p_cptr_in = c_loc(cptr_in)
+    !$omp end target data
+    !$omp end target data
+    call check(p_u, p_v, p_w, p_x, p_y, p_z, p_cptr, p_cptr_in, size(x), size(z))
+  end subroutine foo
+
+  subroutine check(p_u, p_v, p_w, p_x, p_y, p_z, p_cptr, p_cptr_in, Nx, Nz)
+    type(c_ptr), value :: p_u, p_v, p_w, p_x, p_y, p_z, p_cptr, p_cptr_in
+    integer, value :: Nx, Nz
+    integer, pointer :: c_u(:), c_v(:), c_w(:), c_x(:), c_y(:), c_z(:)
+    type(c_ptr), pointer :: c_cptr(:), c_cptr_in(:)
+
+    ! As is_device_ptr does not handle scalars, we map them to a size-1 array
+    call c_f_pointer(p_u, c_u, shape=[1])
+    call c_f_pointer(p_v, c_v, shape=[1])
+    call c_f_pointer(p_w, c_w, shape=[1])
+    call c_f_pointer(p_x, c_x, shape=[Nx])
+    call c_f_pointer(p_y, c_y, shape=[1])
+    call c_f_pointer(p_z, c_z, shape=[Nz])
+    call c_f_pointer(p_cptr, c_cptr, shape=[1])
+    call c_f_pointer(p_cptr_in, c_cptr_in, shape=[1])
+    call run_target(c_u, c_v, c_w, c_x, c_y, c_z, c_cptr, c_cptr_in, Nx, Nz)
+  end subroutine check
+
+  subroutine run_target(c_u, c_v, c_w, c_x, c_y, c_z, c_cptr, c_cptr_in, Nx, Nz)
+    integer, target :: c_u(:), c_v(:), c_w(:), c_x(:), c_y(:), c_z(:)
+    type(c_ptr) :: c_cptr(:), c_cptr_in(:)
+    integer, value :: Nx, Nz
+    !$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)
+      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)
+    !$omp end target
+  end subroutine run_target
+
+  subroutine target_fn(c_u, c_v, c_w, c_x, c_y, c_z, c_cptr, c_cptr_in, Nx, Nz)
+    !$omp declare target
+    integer, target :: c_u, c_v, c_w, c_x(:), c_y, c_z(:)
+    type(c_ptr), value :: c_cptr, c_cptr_in
+    integer, value :: Nx, Nz
+    integer, pointer :: u, x(:)
+    if (c_u /= 42) stop 30
+    if (c_v /= 5) stop 31
+    if (c_w /= 7) stop 32
+    if (Nx /= 4) stop 33
+    if (any (c_x /= [3,4,6,2])) stop 34
+    if (c_y /= 88) stop 35
+    if (Nz /= 3) stop 36
+    if (any (c_z /= [1,2,3])) stop 37
+    if (.not. c_associated (c_cptr)) stop 38
+    if (.not. c_associated (c_cptr_in)) stop 39
+    if (.not. c_associated (c_cptr, c_loc(c_x))) stop 40
+    if (.not. c_associated (c_cptr_in, c_loc(c_u))) stop 41
+    call c_f_pointer(c_cptr_in, u)
+    call c_f_pointer(c_cptr, x, shape=[Nx])
+    if (u /= c_u .or. u /= 42)  stop 42
+    if (any (x /= c_x))  stop 43
+    if (any (x /= [3,4,6,2]))  stop 44
+  end subroutine target_fn
+end program main