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.
55 lines
1.6 KiB
Fortran
55 lines
1.6 KiB
Fortran
program main
|
|
use omp_lib
|
|
use ISO_C_Binding
|
|
implicit none (external, type)
|
|
|
|
type (omp_alloctrait) :: traits(3)
|
|
integer (omp_allocator_handle_kind) :: a
|
|
|
|
traits = [omp_alloctrait (omp_atk_alignment, 64), &
|
|
omp_alloctrait (omp_atk_fallback, omp_atv_null_fb), &
|
|
omp_alloctrait (omp_atk_pool_size, 4096)]
|
|
a = omp_init_allocator (omp_default_mem_space, 3, traits)
|
|
if (a == omp_null_allocator) stop 1
|
|
|
|
!$omp parallel num_threads(4)
|
|
block
|
|
integer :: n
|
|
real(8) :: r
|
|
type(c_ptr) :: cp, cq
|
|
real(8), pointer, volatile :: p(:), q(:)
|
|
|
|
n = omp_get_thread_num ()
|
|
if (mod (n, 2) /= 0) then
|
|
call omp_set_default_allocator (a)
|
|
else
|
|
call omp_set_default_allocator (omp_default_mem_alloc)
|
|
endif
|
|
cp = omp_alloc (1696_c_size_t, omp_null_allocator)
|
|
if (.not. c_associated (cp)) stop 2
|
|
call c_f_pointer (cp, p, [1696 / c_sizeof (r)])
|
|
p(1) = 1.0
|
|
p(1696 / c_sizeof (r)) = 2.0
|
|
!$omp barrier
|
|
if (mod (n, 2) /= 0) then
|
|
call omp_set_default_allocator (omp_default_mem_alloc)
|
|
else
|
|
call omp_set_default_allocator (a)
|
|
endif
|
|
cq = omp_alloc (1696_c_size_t, omp_null_allocator)
|
|
if (mod (n, 2) /= 0) then
|
|
if (.not. c_associated (cq)) stop 3
|
|
call c_f_pointer (cq, q, [1696 / c_sizeof (r)])
|
|
q(1) = 3.0
|
|
q(1696 / c_sizeof (r)) = 4.0
|
|
else if (c_associated (cq)) then
|
|
stop 4
|
|
end if
|
|
!$omp barrier
|
|
call omp_free (cp, omp_null_allocator)
|
|
call omp_free (cq, omp_null_allocator)
|
|
call omp_set_default_allocator (omp_default_mem_alloc)
|
|
end block
|
|
!$omp end parallel
|
|
call omp_destroy_allocator (a)
|
|
end program main
|