76bb3c50dd
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.
62 lines
1.4 KiB
Fortran
62 lines
1.4 KiB
Fortran
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
|