Fortran/OpenMP: Add memory routines existing for C/C++

This patch adds the Fortran interface for omp_alloc/omp_free
and the omp_target_* memory routines, which were added in
OpenMP 5.0 for C/C++ but only OpenMP 5.1 added them for Fortran.

Those functions use BIND(C), i.e. on the libgomp side, the same
interface as for C/C++ is used.

Note: By using BIND(C) in omp_lib.h, files including this file
no longer compiler with -std=f95 but require at least -std=f2003.

libgomp/ChangeLog:

	* omp_lib.f90.in (omp_alloc, omp_free, omp_target_alloc,
	omp_target_free. omp_target_is_present, omp_target_memcpy,
	omp_target_memcpy_rect, omp_target_associate_ptr,
	omp_target_disassociate_ptr): Add interface.
	* omp_lib.h.in (omp_alloc, omp_free, omp_target_alloc,
	omp_target_free. omp_target_is_present, omp_target_memcpy,
	omp_target_memcpy_rect, omp_target_associate_ptr,
	omp_target_disassociate_ptr): Add interface.
	* testsuite/libgomp.fortran/alloc-1.F90: Remove local
	interface block for omp_alloc + omp_free.
	* testsuite/libgomp.fortran/alloc-4.f90: Likewise.
	* testsuite/libgomp.fortran/refcount-1.f90: New test.
	* testsuite/libgomp.fortran/target-12.f90: New test.

 libgomp/omp_lib.f90.in                           |  94 +++++++++++++++
 libgomp/omp_lib.h.in                             |  97 +++++++++++++++
 libgomp/testsuite/libgomp.fortran/alloc-1.F90    |  16 ---
 libgomp/testsuite/libgomp.fortran/alloc-4.f90    |  16 ---
 libgomp/testsuite/libgomp.fortran/refcount-1.f90 |  61 ++++++++++
 libgomp/testsuite/libgomp.fortran/target-12.f90  | 147 +++++++++++++++++++++++
 6 files changed, 399 insertions(+), 32 deletions(-)

diff --git a/libgomp/omp_lib.f90.in b/libgomp/omp_lib.f90.in
index 6394e65bbf7..a36a5626123 100644
--- a/libgomp/omp_lib.f90.in
+++ b/libgomp/omp_lib.f90.in
@@ -670,6 +670,100 @@
           end subroutine omp_display_env_8
         end interface
 
+        interface
+          function omp_alloc (size, allocator) bind(c)
+            use, intrinsic :: iso_c_binding, only : c_ptr, c_size_t
+            import :: omp_allocator_handle_kind
+            type(c_ptr) :: omp_alloc
+            integer(c_size_t), value :: size
+            integer(omp_allocator_handle_kind), value :: allocator
+          end function omp_alloc
+        end interface
+
+        interface
+          subroutine omp_free(ptr, allocator) bind(c)
+            use, intrinsic :: iso_c_binding, only : c_ptr
+            import :: omp_allocator_handle_kind
+            type(c_ptr), value :: ptr
+            integer(omp_allocator_handle_kind), value :: allocator
+          end subroutine
+        end interface
+
+        interface
+          function omp_target_alloc (size, device_num) bind(c)
+            use, intrinsic :: iso_c_binding, only : c_ptr, c_size_t, c_int
+            type(c_ptr) :: omp_target_alloc
+            integer(c_size_t), value :: size
+            integer(c_int), value :: device_num
+          end function omp_target_alloc
+        end interface
+
+        interface
+          subroutine omp_target_free (device_ptr, device_num) bind(c)
+            use, intrinsic :: iso_c_binding, only : c_ptr, c_int
+            type(c_ptr), value :: device_ptr
+            integer(c_int), value :: device_num
+          end subroutine omp_target_free
+        end interface
+
+        interface
+          function omp_target_is_present (ptr, device_num) bind(c)
+            use, intrinsic :: iso_c_binding, only : c_ptr, c_int
+            integer(c_int) :: omp_target_is_present
+            type(c_ptr), value :: ptr
+            integer(c_int), value :: device_num
+          end function omp_target_is_present
+        end interface
+
+        interface
+          function omp_target_memcpy (dst, src, length, dst_offset, &
+                                      src_offset, dst_device_num, &
+                                      src_device_num) bind(c)
+            use, intrinsic :: iso_c_binding, only : c_ptr, c_int, c_size_t
+            integer(c_int) :: omp_target_memcpy
+            type(c_ptr), value :: dst, src
+            integer(c_size_t), value :: length, dst_offset, src_offset
+            integer(c_int), value :: dst_device_num, src_device_num
+          end function omp_target_memcpy
+        end interface
+
+        interface
+          function omp_target_memcpy_rect (dst,src,element_size, num_dims, &
+                                           volume, dst_offsets, src_offsets, &
+                                           dst_dimensions, src_dimensions, &
+                                           dst_device_num, src_device_num) &
+              bind(c)
+            use, intrinsic :: iso_c_binding, only : c_ptr, c_int, c_size_t
+            integer(c_int) :: omp_target_memcpy_rect
+            type(c_ptr), value :: dst, src
+            integer(c_size_t), value :: element_size
+            integer(c_int), value :: num_dims, dst_device_num, src_device_num
+            integer(c_size_t), intent(in) :: volume(*), dst_offsets(*),  &
+                                             src_offsets(*), dst_dimensions(*), &
+                                             src_dimensions(*)
+          end function omp_target_memcpy_rect
+        end interface
+
+        interface
+          function omp_target_associate_ptr (host_ptr, device_ptr, size, &
+                                             device_offset, device_num) bind(c)
+            use, intrinsic :: iso_c_binding, only : c_ptr, c_size_t, c_int
+            integer(c_int) :: omp_target_associate_ptr
+            type(c_ptr), value :: host_ptr, device_ptr
+            integer(c_size_t), value :: size, device_offset
+            integer(c_int), value :: device_num
+          end function omp_target_associate_ptr
+        end interface
+
+        interface
+          function omp_target_disassociate_ptr (ptr, device_num) bind(c)
+            use, intrinsic :: iso_c_binding, only : c_ptr, c_int
+            integer(c_int) :: omp_target_disassociate_ptr
+            type(c_ptr), value :: ptr
+            integer(c_int), value :: device_num
+          end function omp_target_disassociate_ptr
+        end interface
+
 #if _OPENMP >= 201811
 !GCC$ ATTRIBUTES DEPRECATED :: omp_get_nested, omp_set_nested
 #endif
diff --git a/libgomp/omp_lib.h.in b/libgomp/omp_lib.h.in
index f2ad445f924..1c2eacba554 100644
--- a/libgomp/omp_lib.h.in
+++ b/libgomp/omp_lib.h.in
@@ -271,3 +271,100 @@
       integer (omp_allocator_handle_kind) omp_get_default_allocator
 
       external omp_display_env
+
+      interface
+        function omp_alloc (size, allocator) bind(c)
+          use, intrinsic :: iso_c_binding, only : c_ptr, c_size_t
+          use, intrinsic :: omp_lib_kinds
+          type(c_ptr) :: omp_alloc
+          integer(c_size_t), value :: size
+          integer(omp_allocator_handle_kind), value :: allocator
+        end function omp_alloc
+      end interface
+
+      interface
+        subroutine omp_free(ptr, allocator) bind(c)
+          use, intrinsic :: iso_c_binding, only : c_ptr
+          use, intrinsic :: omp_lib_kinds
+          type(c_ptr), value :: ptr
+          integer(omp_allocator_handle_kind), value :: allocator
+        end subroutine
+      end interface
+
+      interface
+        function omp_target_alloc (size, device_num) bind(c)
+          use, intrinsic :: iso_c_binding, only : c_ptr, c_size_t, c_int
+          type(c_ptr) :: omp_target_alloc
+          integer(c_size_t), value :: size
+          integer(c_int), value :: device_num
+        end function omp_target_alloc
+      end interface
+
+      interface
+        subroutine omp_target_free (device_ptr, device_num) bind(c)
+          use, intrinsic :: iso_c_binding, only : c_ptr, c_int
+          type(c_ptr), value :: device_ptr
+          integer(c_int), value :: device_num
+        end subroutine omp_target_free
+      end interface
+
+      interface
+        function omp_target_is_present (ptr, device_num) bind(c)
+          use, intrinsic :: iso_c_binding, only : c_ptr, c_int
+          integer(c_int) :: omp_target_is_present
+          type(c_ptr), value :: ptr
+          integer(c_int), value :: device_num
+        end function omp_target_is_present
+      end interface
+
+      interface
+        function omp_target_memcpy (dst, src, length, dst_offset,          &
+     &                              src_offset, dst_device_num,            &
+     &                              src_device_num) bind(c)
+          use, intrinsic :: iso_c_binding, only : c_ptr, c_int, c_size_t
+          integer(c_int) :: omp_target_memcpy
+          type(c_ptr), value :: dst, src
+          integer(c_size_t), value :: length, dst_offset, src_offset
+          integer(c_int), value :: dst_device_num, src_device_num
+        end function omp_target_memcpy
+      end interface
+
+      interface
+        function omp_target_memcpy_rect (dst,src,element_size, num_dims,   &
+     &                                   volume, dst_offsets,              &
+     &                                   src_offsets, dst_dimensions,      &
+     &                                   src_dimensions, dst_device_num,   &
+     &                                   src_device_num) bind(c)
+          use, intrinsic :: iso_c_binding, only : c_ptr, c_int, c_size_t
+          integer(c_int) :: omp_target_memcpy_rect
+          type(c_ptr), value :: dst, src
+          integer(c_size_t), value :: element_size
+          integer(c_int), value :: num_dims
+          integer(c_int), value :: dst_device_num, src_device_num
+          integer(c_size_t), intent(in) :: volume(*), dst_offsets(*)
+          integer(c_size_t), intent(in) :: src_offsets(*)
+          integer(c_size_t), intent(in) :: dst_dimensions(*)
+          integer(c_size_t), intent(in) :: src_dimensions(*)
+        end function omp_target_memcpy_rect
+      end interface
+
+      interface
+        function omp_target_associate_ptr (host_ptr, device_ptr, size,     &
+     &                                     device_offset, device_num)      &
+     &      bind(c)
+          use, intrinsic :: iso_c_binding, only : c_ptr, c_size_t, c_int
+          integer(c_int) :: omp_target_associate_ptr
+          type(c_ptr), value :: host_ptr, device_ptr
+          integer(c_size_t), value :: size, device_offset
+          integer(c_int), value :: device_num
+        end function omp_target_associate_ptr
+      end interface
+
+      interface
+        function omp_target_disassociate_ptr (ptr, device_num) bind(c)
+          use, intrinsic :: iso_c_binding, only : c_ptr, c_int
+          integer(c_int) :: omp_target_disassociate_ptr
+          type(c_ptr), value :: ptr
+          integer(c_int), value :: device_num
+        end function omp_target_disassociate_ptr
+      end interface
diff --git a/libgomp/testsuite/libgomp.fortran/alloc-1.F90 b/libgomp/testsuite/libgomp.fortran/alloc-1.F90
index 178ce771d45..e6365831984 100644
--- a/libgomp/testsuite/libgomp.fortran/alloc-1.F90
+++ b/libgomp/testsuite/libgomp.fortran/alloc-1.F90
@@ -36,22 +36,6 @@
 
         type (omp_alloctrait), allocatable :: traits(:), traits5(:)
 
-        interface
-          ! omp_alloc + omp_free part of OpenMP for C/C++
-          ! but not (yet) in the OpenMP spec for Fortran
-          type(c_ptr) function omp_alloc (size, handle) bind(C)
-            import
-            integer (c_size_t), value :: size
-            integer (omp_allocator_handle_kind), value :: handle
-          end function
-
-          subroutine omp_free (ptr, handle) bind(C)
-            import
-            type (c_ptr), value :: ptr
-            integer (omp_allocator_handle_kind), value :: handle
-          end subroutine
-        end interface
-
         type(c_ptr), volatile :: cp, cq, cr
         integer :: i
         integer(c_intptr_t) :: intptr
diff --git a/libgomp/testsuite/libgomp.fortran/alloc-4.f90 b/libgomp/testsuite/libgomp.fortran/alloc-4.f90
index ce353b55eb0..87b6adda645 100644
--- a/libgomp/testsuite/libgomp.fortran/alloc-4.f90
+++ b/libgomp/testsuite/libgomp.fortran/alloc-4.f90
@@ -3,22 +3,6 @@ program main
   use ISO_C_Binding
   implicit none (external, type)
 
-  interface
-    ! omp_alloc + omp_free part of OpenMP for C/C++
-    ! but not (yet) in the OpenMP spec for Fortran
-    type(c_ptr) function omp_alloc (size, handle) bind(C)
-      import
-      integer (c_size_t), value :: size
-      integer (omp_allocator_handle_kind), value :: handle
-    end function
-
-    subroutine omp_free (ptr, handle) bind(C)
-      import
-      type (c_ptr), value :: ptr
-      integer (omp_allocator_handle_kind), value :: handle
-    end subroutine
-  end interface
-
   type (omp_alloctrait) :: traits(3)
   integer (omp_allocator_handle_kind) :: a
 
diff --git a/libgomp/testsuite/libgomp.fortran/refcount-1.f90 b/libgomp/testsuite/libgomp.fortran/refcount-1.f90
new file mode 100644
index 00000000000..e3b9d04af81
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/refcount-1.f90
@@ -0,0 +1,61 @@
+program main
+  use omp_lib
+  use iso_c_binding
+  implicit none (type, external)
+
+  integer :: d, id
+  integer(kind=1), target :: a(4)
+  integer(kind=1), pointer :: p, q
+
+  d = omp_get_default_device ()
+  id = omp_get_initial_device ()
+
+  if (d < 0 .or. d >= omp_get_num_devices ()) &
+    d = id
+
+  a = transfer (int(z'cdcdcdcd'), mold=a)
+
+  !$omp target enter data map (to:a)
+
+  a = transfer (int(z'abababab'), mold=a)
+  p => a(1)
+  q => a(3)
+
+  !$omp target enter data map (alloc:p, q)
+
+  if (d /= id) then
+    if (omp_target_is_present (c_loc(a), d) == 0) &
+      stop 1
+    if (omp_target_is_present (c_loc(p), d) == 0) &
+      stop 2
+    if (omp_target_is_present (c_loc(q), d) == 0) &
+      stop 3
+  end if
+
+  !$omp target exit data map (release:a)
+
+    if (d /= id) then
+      if (omp_target_is_present (c_loc(a), d) == 0) &
+        stop 4
+      if (omp_target_is_present (c_loc(p), d) == 0) &
+        stop 5
+      if (omp_target_is_present (c_loc(q), d) == 0) &
+        stop 6
+    end if
+
+  !$omp target exit data map (from:q)
+
+    if (d /= id) then
+      if (omp_target_is_present (c_loc(a), d) /= 0) &
+        stop 7
+      if (omp_target_is_present (c_loc(p), d) /= 0) &
+        stop 8
+      if (omp_target_is_present (c_loc(q), d) /= 0) &
+        stop 9
+
+      if (q /= int(z'cd', kind=1)) &
+        stop 10
+      if (p /= int(z'ab', kind=1)) &
+        stop 11
+    end if
+end program main
diff --git a/libgomp/testsuite/libgomp.fortran/target-12.f90 b/libgomp/testsuite/libgomp.fortran/target-12.f90
new file mode 100644
index 00000000000..17c78f18f9b
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/target-12.f90
@@ -0,0 +1,147 @@
+program main
+  use omp_lib
+  use iso_c_binding
+  implicit none (external, type)
+  integer :: d, id, i, j, k, l
+  logical :: err
+  integer, target :: q(0:127)
+  type(c_ptr) :: p
+
+  integer(kind=c_size_t) :: volume(0:2)
+  integer(kind=c_size_t) :: dst_offsets(0:2)
+  integer(kind=c_size_t) :: src_offsets(0:2)
+  integer(kind=c_size_t) :: dst_dimensions(0:2)
+  integer(kind=c_size_t) :: src_dimensions(0:2)
+  integer(kind=c_size_t) :: empty(1:0)
+
+  err = .false.
+  d = omp_get_default_device ()
+  id = omp_get_initial_device ()
+
+  if (d < 0 .or. d >= omp_get_num_devices ()) &
+    d = id
+
+  q = [(i, i = 0, 127)]
+  p = omp_target_alloc (130 * c_sizeof (q), d)
+  if (.not. c_associated (p)) &
+    stop 0  ! okay
+
+  if (omp_target_memcpy_rect (C_NULL_PTR, C_NULL_PTR, 0_c_size_t, 0, &
+                              empty, empty, empty, empty,  empty, d, id) < 3 &
+      .or. omp_target_memcpy_rect (C_NULL_PTR, C_NULL_PTR, 0_c_size_t, 0, &
+                                   empty, empty, empty, empty, empty, &
+                                   id, d) < 3 &
+      .or. omp_target_memcpy_rect (C_NULL_PTR, C_NULL_PTR, 0_c_size_t, 0, &
+                                   empty, empty, empty, empty, empty, &
+                                   id, id) < 3) &
+    stop 1
+
+  if (omp_target_associate_ptr (c_loc (q), p, 128 * c_sizeof (q(0)), &
+                                c_sizeof (q(0)), d) == 0) then
+    volume = [ 128, 0, 0 ]
+    dst_offsets = [ 0, 0, 0 ]
+    src_offsets = [ 1, 0, 0 ]
+    dst_dimensions = [ 128, 0, 0 ]
+    src_dimensions = [ 128, 0, 0 ]
+
+
+    if (omp_target_associate_ptr (c_loc (q), p, 128 * sizeof (q(0)), &
+                                  sizeof (q(0)), d) /= 0) &
+      stop 2
+
+    if (omp_target_is_present (c_loc (q), d) /= 1 &
+        .or. omp_target_is_present (c_loc (q(32)), d) /= 1 &
+        .or. omp_target_is_present (c_loc (q(127)), d) /= 1) &
+      stop 3
+
+    if (omp_target_memcpy (p, c_loc (q), 128 * sizeof (q(0)), sizeof (q(0)), &
+                           0_c_size_t, d, id) /= 0) &
+      stop 4
+
+    i = 0
+    if (d >= 0) i = d
+    !$omp target if (d >= 0) device (i) map(alloc:q(0:31)) map(from:err)
+      err = .false.
+      do j = 0, 127
+        if (q(j) /= j) then
+          err = .true.
+        else
+          q(j) = q(j) + 4
+        end if
+      end do
+    !$omp end target
+
+    if (err) &
+      stop 5
+
+    if (omp_target_memcpy_rect (c_loc (q), p, sizeof (q(0)), 1, volume, &
+                                dst_offsets, src_offsets, dst_dimensions, &
+                                src_dimensions, id, d) /= 0) &
+      stop 6
+
+    do i = 0, 127
+      if (q(i) /= i + 4) &
+        stop 7
+    end do
+
+    volume(2) = 2
+    volume(1) = 3
+    volume(0) = 6
+    dst_offsets(2) = 1
+    dst_offsets(1) = 0
+    dst_offsets(0) = 0
+    src_offsets(2) = 1
+    src_offsets(1) = 0
+    src_offsets(0) = 3
+    dst_dimensions(2) = 2
+    dst_dimensions(1) = 3
+    dst_dimensions(0) = 6
+    src_dimensions(2) = 3
+    src_dimensions(1) = 4
+    src_dimensions(0) = 6
+
+    if (omp_target_memcpy_rect (p, c_loc (q), sizeof (q(0)), 3, volume, &
+                                dst_offsets, src_offsets, dst_dimensions, &
+                                src_dimensions, d, id) /= 0) &
+      stop 8
+
+    i = 0
+    if (d >= 0) i = d
+    !$omp target if (d >= 0) device (i) map(alloc:q(1:32)) map(from:err)
+      err = .false.
+      do j = 0, 5
+        do k = 0, 2
+          do l = 0, 1
+            if (q(j * 6 + k * 2 + l) /= 3 * 12 + 4 + 1 + l + k * 3 + j * 12) &
+              err = .true.
+          end do
+        end do
+      end do
+    !$omp end target
+
+    if (err) &
+      stop 9
+ 
+    if (omp_target_memcpy (p, p, 10 * sizeof (q(1)), 51 * sizeof (q(1)), &
+                           111 * sizeof (q(1)), d, d) /= 0) &
+      stop 10
+
+    i = 0
+    if (d >= 0) i = d
+    !$omp target if (d >= 0) device (i) map(alloc:q(0:31)) map(from:err)
+      err = .false.
+      do j = 1, 9
+        if (q(50+j) /= q(110 + j)) & 
+          err = .true.
+      end do
+    !$omp end target
+
+    if (err) &
+      stop 11
+
+    if (omp_target_disassociate_ptr (c_loc (q), d) /= 0) &
+      stop 12
+  end if
+
+  call omp_target_free (p, d)
+end program main
