public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc/devel/omp/gcc-11] openmp: Add omp_aligned_{, c}alloc and omp_{c, re}alloc for Fortran
@ 2021-09-30 12:50 Tobias Burnus
0 siblings, 0 replies; only message in thread
From: Tobias Burnus @ 2021-09-30 12:50 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:695f503117a26d4b1f9ae292085a5a62d0174841
commit 695f503117a26d4b1f9ae292085a5a62d0174841
Author: Tobias Burnus <tobias@codesourcery.com>
Date: Thu Sep 30 14:30:28 2021 +0200
openmp: Add omp_aligned_{,c}alloc and omp_{c,re}alloc for Fortran
gcc/ChangeLog:
* omp-low.c (omp_runtime_api_call): Add omp_aligned_{,c}alloc and
omp_{c,re}alloc, fix omp_alloc/omp_free.
libgomp/ChangeLog:
* libgomp.texi (OpenMP 5.1): Set implementation status to Y for
omp_aligned_{,c}alloc and omp_{c,re}alloc routines.
* omp_lib.f90.in (omp_aligned_alloc, omp_aligned_calloc, omp_calloc,
omp_realloc): Add.
* omp_lib.h.in (omp_aligned_alloc, omp_aligned_calloc, omp_calloc,
omp_realloc): Add.
* testsuite/libgomp.fortran/alloc-10.f90: New test.
* testsuite/libgomp.fortran/alloc-6.f90: New test.
* testsuite/libgomp.fortran/alloc-7.c: New test.
* testsuite/libgomp.fortran/alloc-7.f90: New test.
* testsuite/libgomp.fortran/alloc-8.f90: New test.
* testsuite/libgomp.fortran/alloc-9.f90: New test.
(cherry picked from commit 70de20db232545daa2d6616e3581313476395ea3)
Diff:
---
gcc/ChangeLog.omp | 8 +
gcc/omp-low.c | 8 +-
libgomp/ChangeLog.omp | 18 +++
libgomp/libgomp.texi | 2 +-
libgomp/omp_lib.f90.in | 43 +++++-
libgomp/omp_lib.h.in | 46 +++++-
libgomp/testsuite/libgomp.fortran/alloc-10.f90 | 198 +++++++++++++++++++++++++
libgomp/testsuite/libgomp.fortran/alloc-6.f90 | 45 ++++++
libgomp/testsuite/libgomp.fortran/alloc-7.c | 5 +
libgomp/testsuite/libgomp.fortran/alloc-7.f90 | 174 ++++++++++++++++++++++
libgomp/testsuite/libgomp.fortran/alloc-8.f90 | 58 ++++++++
libgomp/testsuite/libgomp.fortran/alloc-9.f90 | 196 ++++++++++++++++++++++++
12 files changed, 796 insertions(+), 5 deletions(-)
diff --git a/gcc/ChangeLog.omp b/gcc/ChangeLog.omp
index f0e787d8dd2..ec76feb2829 100644
--- a/gcc/ChangeLog.omp
+++ b/gcc/ChangeLog.omp
@@ -1,3 +1,11 @@
+2021-09-30 Tobias Burnus <tobias@codesourcery.com>
+
+ Backported from master:
+ 2021-09-30 Tobias Burnus <tobias@codesourcery.com>
+
+ * omp-low.c (omp_runtime_api_call): Add omp_aligned_{,c}alloc and
+ omp_{c,re}alloc, fix omp_alloc/omp_free.
+
2021-09-29 Tobias Burnus <tobias@codesourcery.com>
Backported from master:
diff --git a/gcc/omp-low.c b/gcc/omp-low.c
index 1eeb6dbebcf..0fc6df6ed41 100644
--- a/gcc/omp-low.c
+++ b/gcc/omp-low.c
@@ -4220,8 +4220,12 @@ omp_runtime_api_call (const_tree fndecl)
{
/* This array has 3 sections. First omp_* calls that don't
have any suffixes. */
- "omp_alloc",
- "omp_free",
+ "aligned_alloc",
+ "aligned_calloc",
+ "alloc",
+ "calloc",
+ "free",
+ "realloc",
"target_alloc",
"target_associate_ptr",
"target_disassociate_ptr",
diff --git a/libgomp/ChangeLog.omp b/libgomp/ChangeLog.omp
index 692bef056db..beabd3c5e9b 100644
--- a/libgomp/ChangeLog.omp
+++ b/libgomp/ChangeLog.omp
@@ -1,3 +1,21 @@
+2021-09-30 Tobias Burnus <tobias@codesourcery.com>
+
+ Backported from master:
+ 2021-09-30 Tobias Burnus <tobias@codesourcery.com>
+
+ * libgomp.texi (OpenMP 5.1): Set implementation status to Y for
+ omp_aligned_{,c}alloc and omp_{c,re}alloc routines.
+ * omp_lib.f90.in (omp_aligned_alloc, omp_aligned_calloc, omp_calloc,
+ omp_realloc): Add.
+ * omp_lib.h.in (omp_aligned_alloc, omp_aligned_calloc, omp_calloc,
+ omp_realloc): Add.
+ * testsuite/libgomp.fortran/alloc-10.f90: New test.
+ * testsuite/libgomp.fortran/alloc-6.f90: New test.
+ * testsuite/libgomp.fortran/alloc-7.c: New test.
+ * testsuite/libgomp.fortran/alloc-7.f90: New test.
+ * testsuite/libgomp.fortran/alloc-8.f90: New test.
+ * testsuite/libgomp.fortran/alloc-9.f90: New test.
+
2021-09-30 Tobias Burnus <tobias@codesourcery.com>
Backported from master:
diff --git a/libgomp/libgomp.texi b/libgomp/libgomp.texi
index 687837ec964..e852ae37bea 100644
--- a/libgomp/libgomp.texi
+++ b/libgomp/libgomp.texi
@@ -315,7 +315,7 @@ The OpenMP 4.5 specification is fully supported.
runtime routines @tab N @tab
@item @code{omp_get_mapped_ptr} runtime routine @tab N @tab
@item @code{omp_calloc}, @code{omp_realloc}, @code{omp_aligned_alloc} and
- @code{omp_aligned_calloc} runtime routines @tab N @tab
+ @code{omp_aligned_calloc} runtime routines @tab Y @tab
@item @code{omp_alloctrait_key_t} enum: @code{omp_atv_serialized} added,
@code{omp_atv_default} changed @tab Y @tab
@item @code{omp_display_env} runtime routine @tab P
diff --git a/libgomp/omp_lib.f90.in b/libgomp/omp_lib.f90.in
index a36a5626123..1063eee0c94 100644
--- a/libgomp/omp_lib.f90.in
+++ b/libgomp/omp_lib.f90.in
@@ -680,13 +680,54 @@
end function omp_alloc
end interface
+ interface
+ function omp_aligned_alloc (alignment, size, allocator) bind(c)
+ use, intrinsic :: iso_c_binding, only : c_ptr, c_size_t
+ import :: omp_allocator_handle_kind
+ type(c_ptr) :: omp_aligned_alloc
+ integer(c_size_t), value :: alignment, size
+ integer(omp_allocator_handle_kind), value :: allocator
+ end function omp_aligned_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 subroutine omp_free
+ end interface
+
+ interface
+ function omp_calloc (nmemb, size, allocator) bind(c)
+ use, intrinsic :: iso_c_binding, only : c_ptr, c_size_t
+ import :: omp_allocator_handle_kind
+ type(c_ptr) :: omp_calloc
+ integer(c_size_t), value :: nmemb, size
+ integer(omp_allocator_handle_kind), value :: allocator
+ end function omp_calloc
+ end interface
+
+ interface
+ function omp_aligned_calloc (alignment, nmemb, size, allocator) bind(c)
+ use, intrinsic :: iso_c_binding, only : c_ptr, c_size_t
+ import :: omp_allocator_handle_kind
+ type(c_ptr) :: omp_aligned_calloc
+ integer(c_size_t), value :: alignment, nmemb, size
+ integer(omp_allocator_handle_kind), value :: allocator
+ end function omp_aligned_calloc
+ end interface
+
+ interface
+ function omp_realloc (ptr, size, allocator, free_allocator) bind(c)
+ use, intrinsic :: iso_c_binding, only : c_ptr, c_size_t
+ import :: omp_allocator_handle_kind
+ type(c_ptr) :: omp_realloc
+ type(c_ptr), value :: ptr
+ integer(c_size_t), value :: size
+ integer(omp_allocator_handle_kind), value :: allocator, free_allocator
+ end function omp_realloc
end interface
interface
diff --git a/libgomp/omp_lib.h.in b/libgomp/omp_lib.h.in
index 1c2eacba554..f40321c479b 100644
--- a/libgomp/omp_lib.h.in
+++ b/libgomp/omp_lib.h.in
@@ -282,13 +282,57 @@
end function omp_alloc
end interface
+ interface
+ function omp_aligned_alloc (alignment, size, allocator) bind(c)
+ use, intrinsic :: iso_c_binding, only : c_ptr, c_size_t
+ use, intrinsic :: omp_lib_kinds
+ type(c_ptr) :: omp_aligned_alloc
+ integer(c_size_t), value :: alignment, size
+ integer(omp_allocator_handle_kind), value :: allocator
+ end function omp_aligned_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 subroutine omp_free
+ end interface
+
+ interface
+ function omp_calloc (nmemb, size, allocator) bind(c)
+ use, intrinsic :: iso_c_binding, only : c_ptr, c_size_t
+ use, intrinsic :: omp_lib_kinds
+ type(c_ptr) :: omp_calloc
+ integer(c_size_t), value :: nmemb, size
+ integer(omp_allocator_handle_kind), value :: allocator
+ end function omp_calloc
+ end interface
+
+ interface
+ function omp_aligned_calloc (alignment, nmemb, size, allocator) &
+ & bind(c)
+ use, intrinsic :: iso_c_binding, only : c_ptr, c_size_t
+ use, intrinsic :: omp_lib_kinds
+ type(c_ptr) :: omp_aligned_calloc
+ integer(c_size_t), value :: alignment, nmemb, size
+ integer(omp_allocator_handle_kind), value :: allocator
+ end function omp_aligned_calloc
+ end interface
+
+ interface
+ function omp_realloc (ptr, size, allocator, free_allocator) &
+ & bind(c)
+ use, intrinsic :: iso_c_binding, only : c_ptr, c_size_t
+ use, intrinsic :: omp_lib_kinds
+ type(c_ptr) :: omp_realloc
+ type(c_ptr), value :: ptr
+ integer(c_size_t), value :: size
+ integer(omp_allocator_handle_kind), value :: allocator
+ integer(omp_allocator_handle_kind), value :: free_allocator
+ end function omp_realloc
end interface
interface
diff --git a/libgomp/testsuite/libgomp.fortran/alloc-10.f90 b/libgomp/testsuite/libgomp.fortran/alloc-10.f90
new file mode 100644
index 00000000000..d26a83b216a
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/alloc-10.f90
@@ -0,0 +1,198 @@
+! { dg-additional-sources alloc-7.c }
+module m
+ use omp_lib
+ use iso_c_binding
+ implicit none
+
+ type (omp_alloctrait), parameter :: traits2(*) &
+ = [ omp_alloctrait (omp_atk_alignment, 16), &
+ omp_alloctrait (omp_atk_sync_hint, omp_atv_default), &
+ omp_alloctrait (omp_atk_access, omp_atv_default), &
+ omp_alloctrait (omp_atk_pool_size, 1024), &
+ omp_alloctrait (omp_atk_fallback, omp_atv_default_mem_fb), &
+ omp_alloctrait (omp_atk_partition, omp_atv_environment)]
+ type (omp_alloctrait) :: traits3(7) &
+ = [ omp_alloctrait (omp_atk_sync_hint, omp_atv_uncontended), &
+ omp_alloctrait (omp_atk_alignment, 32), &
+ omp_alloctrait (omp_atk_access, omp_atv_all), &
+ omp_alloctrait (omp_atk_pool_size, 512), &
+ omp_alloctrait (omp_atk_fallback, omp_atv_allocator_fb), &
+ omp_alloctrait (omp_atk_fb_data, 0), &
+ omp_alloctrait (omp_atk_partition, omp_atv_default)]
+ type (omp_alloctrait), parameter :: traits4(*) &
+ = [ omp_alloctrait (omp_atk_alignment, 128), &
+ omp_alloctrait (omp_atk_pool_size, 1024), &
+ omp_alloctrait (omp_atk_fallback, omp_atv_null_fb)]
+
+ interface
+ integer(c_int) function get__alignof_int () bind(C)
+ import :: c_int
+ end
+ end interface
+end module m
+
+program main
+ use m
+ implicit none (external, type)
+ type(c_ptr) :: p, q, r
+ integer, pointer, contiguous :: ip(:), iq(:), ir(:)
+ type (omp_alloctrait) :: traits(3)
+ integer (omp_allocator_handle_kind) :: a, a2
+ integer (c_ptrdiff_t) :: iptr
+ integer :: i
+
+ traits = [ omp_alloctrait (omp_atk_alignment, 64), &
+ omp_alloctrait (omp_atk_fallback, omp_atv_null_fb), &
+ omp_alloctrait (omp_atk_pool_size, 4096)]
+
+ p = omp_aligned_calloc (c_sizeof (0), 3_c_size_t, c_sizeof (0), omp_default_mem_alloc)
+ call c_f_pointer (p, ip, [3])
+ if (mod (TRANSFER (p, iptr), get__alignof_int ()) /= 0 &
+ .or. ip(1) /= 0 .or. ip(2) /= 0 .or. ip(3) /= 0) &
+ stop 1
+ ip(1) = 1
+ ip(2) = 2
+ ip(3) = 3
+ call omp_free (p, omp_default_mem_alloc)
+ p = omp_aligned_calloc (2 * c_sizeof (0), 1_c_size_t, 2 * c_sizeof (0), omp_default_mem_alloc)
+ call c_f_pointer (p, ip, [2])
+ if (mod (TRANSFER (p, iptr), 2 * c_sizeof (0)) /= 0 &
+ .or. ip(1) /= 0 .or. ip(2) /= 0) &
+ stop 2
+ ip(1) = 1
+ ip(2) = 2
+ call omp_free (p, omp_null_allocator)
+ call omp_set_default_allocator (omp_default_mem_alloc)
+ p = omp_aligned_calloc (1_c_size_t, 1_c_size_t, c_sizeof (0), omp_null_allocator)
+ call c_f_pointer (p, ip, [1])
+ if (mod (TRANSFER (p, iptr), get__alignof_int ()) /= 0 &
+ .or. ip(1) /= 0) &
+ stop 3
+ ip(1) = 3
+ call omp_free (p, omp_get_default_allocator ())
+
+ a = omp_init_allocator (omp_default_mem_space, 3, traits)
+ if (a == omp_null_allocator) &
+ stop 4
+ p = omp_aligned_calloc (32_c_size_t, 3_c_size_t, 1024_c_size_t, a)
+ call c_f_pointer (p, ip, [3072 / c_sizeof (0)])
+ if (mod (TRANSFER (p, iptr), 64) /= 0) &
+ stop 5
+ do i = 1, 3072 / c_sizeof (0)
+ if (ip(i) /= 0) &
+ stop 6
+ end do
+ ip(1) = 1
+ ip(3072 / c_sizeof (0)) = 2
+ if (c_associated (omp_aligned_calloc (8_c_size_t, 192_c_size_t, 16_c_size_t, a))) &
+ stop 7
+ call omp_free (p, a)
+ p = omp_aligned_calloc (128_c_size_t, 6_c_size_t, 512_c_size_t, a)
+ call c_f_pointer (p, ip, [3072 / c_sizeof (0)])
+ if (mod (TRANSFER (p, iptr), 128) /= 0) &
+ stop 8
+ do i = 1, 3072 / c_sizeof (0)
+ if (ip(i) /= 0) &
+ stop 9
+ end do
+ ip(1) = 3
+ ip(3072 / c_sizeof (0)) = 4
+ call omp_free (p, omp_null_allocator)
+ call omp_set_default_allocator (a)
+ if (omp_get_default_allocator () /= a) &
+ stop 10
+ p = omp_aligned_calloc (64_c_size_t, 12_c_size_t, 256_c_size_t, omp_null_allocator)
+ call c_f_pointer (p, ip, [3072 / c_sizeof (0)])
+ do i = 1, 3072 / c_sizeof (0)
+ if (ip(i) /= 0) &
+ stop 11
+ end do
+ if (c_associated (omp_aligned_calloc (8_c_size_t, 128_c_size_t, 24_c_size_t, omp_null_allocator))) &
+ stop 12
+ call omp_free (p, a)
+ call omp_destroy_allocator (a)
+
+ a = omp_init_allocator (omp_default_mem_space, size (traits2), traits2)
+ if (a == omp_null_allocator) &
+ stop 13
+ if (traits3(6)%key /= omp_atk_fb_data) &
+ stop 14
+ traits3(6)%value = a
+ a2 = omp_init_allocator (omp_default_mem_space, size (traits3), traits3)
+ if (a2 == omp_null_allocator) &
+ stop 15
+ p = omp_aligned_calloc (4_c_size_t, 5_c_size_t, 84_c_size_t, a2)
+ call c_f_pointer (p, ip, [420 / c_sizeof (0)])
+ do i = 1, 420 / c_sizeof (0)
+ if (ip(i) /= 0) &
+ stop 16
+ end do
+ if (mod (TRANSFER (p, iptr), 32) /= 0) &
+ stop 17
+ ip(1) = 5
+ ip(420 / c_sizeof (0)) = 6
+ q = omp_aligned_calloc (8_c_size_t, 24_c_size_t, 32_c_size_t, a2)
+ call c_f_pointer (q, iq, [768 / c_sizeof (0)])
+ if (mod (TRANSFER (p, iptr), 16) /= 0) &
+ stop 18
+ do i = 1, 768 / c_sizeof (0)
+ if (iq(i) /= 0) &
+ stop 19
+ end do
+ iq(1) = 7
+ iq(768 / c_sizeof (0)) = 8
+ r = omp_aligned_calloc (8_c_size_t, 64_c_size_t, 8_c_size_t, a2)
+ call c_f_pointer (r, ir, [512 / c_sizeof (0)])
+ if (mod (TRANSFER (p, iptr), 8) /= 0) &
+ stop 20
+ do i = 1, 512 / c_sizeof (0)
+ if (ir(i) /= 0) &
+ stop 21
+ end do
+ ir(1) = 9
+ ir(512 / c_sizeof (0)) = 10
+ call omp_free (p, omp_null_allocator)
+ call omp_free (q, a2)
+ call omp_free (r, omp_null_allocator)
+ call omp_destroy_allocator (a2)
+ call omp_destroy_allocator (a)
+
+ a = omp_init_allocator (omp_default_mem_space, size (traits4), traits4)
+ if (a == omp_null_allocator) &
+ stop 22
+ if (traits3(6)%key /= omp_atk_fb_data) &
+ stop 23
+ traits3(6)%value = a
+ a2 = omp_init_allocator (omp_default_mem_space, size (traits3), traits3)
+ if (a2 == omp_null_allocator) &
+ stop 24
+ call omp_set_default_allocator (a2)
+ p = omp_aligned_calloc (4_c_size_t, 21_c_size_t, 20_c_size_t, omp_null_allocator)
+ call c_f_pointer (p, ip, [420 / c_sizeof (0)])
+ if (mod (TRANSFER (p, iptr), 32) /= 0) &
+ stop 25
+ do i = 1, 420 / c_sizeof (0)
+ if (ip(i) /= 0) &
+ stop 26
+ end do
+ ip(1) = 5
+ ip(420 / c_sizeof (0)) = 6
+ q = omp_aligned_calloc (64_c_size_t, 12_c_size_t, 64_c_size_t, omp_null_allocator)
+ call c_f_pointer (q, iq, [768 / c_sizeof (0)])
+ if (mod (TRANSFER (q, iptr), 128) /= 0) &
+ stop 27
+ do i = 1, 768 / c_sizeof (0)
+ if (iq(i) /= 0) &
+ stop 28
+ end do
+ iq(1) = 7
+ iq(768 / c_sizeof (0)) = 8
+ if (c_associated (omp_aligned_calloc (8_c_size_t, 24_c_size_t, 32_c_size_t, omp_null_allocator))) &
+ stop 29
+ call omp_free (p, omp_null_allocator)
+ call omp_free (q, omp_null_allocator)
+ call omp_free (c_null_ptr, omp_null_allocator)
+ call omp_free (c_null_ptr, omp_null_allocator)
+ call omp_destroy_allocator (a2)
+ call omp_destroy_allocator (a)
+end program main
diff --git a/libgomp/testsuite/libgomp.fortran/alloc-6.f90 b/libgomp/testsuite/libgomp.fortran/alloc-6.f90
new file mode 100644
index 00000000000..59fd14da600
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/alloc-6.f90
@@ -0,0 +1,45 @@
+module m
+ use omp_lib
+ implicit none
+
+ type (omp_alloctrait), parameter :: traits(*) &
+ = [ omp_alloctrait (omp_atk_pool_size, 1), &
+ omp_alloctrait (omp_atk_fallback, omp_atv_abort_fb) ]
+end module m
+
+program main
+ use m
+ use iso_c_binding
+ implicit none (external, type)
+ integer (omp_allocator_handle_kind) :: a
+ integer(c_size_t), parameter :: zero = 0_c_size_t
+
+ if (c_associated (omp_alloc (zero, omp_null_allocator))) &
+ stop 1
+ if (c_associated (omp_aligned_alloc (64_c_size_t, zero, omp_null_allocator))) &
+ stop 2
+ if (c_associated (omp_calloc (zero, zero, omp_null_allocator)) &
+ .or. c_associated (omp_calloc (32_c_size_t, zero, omp_null_allocator)) &
+ .or. c_associated (omp_calloc (zero, 64_c_size_t, omp_null_allocator))) &
+ stop 3
+ if (c_associated (omp_aligned_calloc (32_c_size_t, zero, zero, omp_null_allocator)) &
+ .or. c_associated (omp_aligned_calloc (64_c_size_t, 32_c_size_t, zero, omp_null_allocator)) &
+ .or. c_associated (omp_aligned_calloc (16_c_size_t, zero, 64_c_size_t, omp_null_allocator))) &
+ stop 4
+ a = omp_init_allocator (omp_default_mem_space, 2, traits)
+ if (a /= omp_null_allocator) then
+ if (c_associated (omp_alloc (zero, a)) &
+ .or. c_associated (omp_alloc (zero, a)) &
+ .or. c_associated (omp_alloc (zero, a)) &
+ .or. c_associated (omp_aligned_alloc (16_c_size_t, zero, a)) &
+ .or. c_associated (omp_aligned_alloc (128_c_size_t, zero, a)) &
+ .or. c_associated (omp_calloc (zero, zero, a)) &
+ .or. c_associated (omp_calloc (32_c_size_t, zero, a)) &
+ .or. c_associated (omp_calloc (zero, 64_c_size_t, a)) &
+ .or. c_associated (omp_aligned_calloc (32_c_size_t, zero, zero, a)) &
+ .or. c_associated (omp_aligned_calloc (64_c_size_t, 32_c_size_t, zero, a)) &
+ .or. c_associated (omp_aligned_calloc (16_c_size_t, zero, 64_c_size_t, a))) &
+ stop 5
+ call omp_destroy_allocator (a)
+ end if
+end program main
diff --git a/libgomp/testsuite/libgomp.fortran/alloc-7.c b/libgomp/testsuite/libgomp.fortran/alloc-7.c
new file mode 100644
index 00000000000..4d16d095150
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/alloc-7.c
@@ -0,0 +1,5 @@
+int
+get__alignof_int ()
+{
+ return __alignof (int);
+}
diff --git a/libgomp/testsuite/libgomp.fortran/alloc-7.f90 b/libgomp/testsuite/libgomp.fortran/alloc-7.f90
new file mode 100644
index 00000000000..b047b0e4d10
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/alloc-7.f90
@@ -0,0 +1,174 @@
+! { dg-additional-sources alloc-7.c }
+module m
+ use omp_lib
+ use iso_c_binding
+ implicit none
+
+ type (omp_alloctrait), parameter :: traits2(*) &
+ = [ omp_alloctrait (omp_atk_alignment, 16), &
+ omp_alloctrait (omp_atk_sync_hint, omp_atv_default), &
+ omp_alloctrait (omp_atk_access, omp_atv_default), &
+ omp_alloctrait (omp_atk_pool_size, 1024), &
+ omp_alloctrait (omp_atk_fallback, omp_atv_default_mem_fb), &
+ omp_alloctrait (omp_atk_partition, omp_atv_environment)]
+
+ type (omp_alloctrait) :: traits3(7) &
+ = [ omp_alloctrait (omp_atk_sync_hint, omp_atv_uncontended), &
+ omp_alloctrait (omp_atk_alignment, 32), &
+ omp_alloctrait (omp_atk_access, omp_atv_all), &
+ omp_alloctrait (omp_atk_pool_size, 512), &
+ omp_alloctrait (omp_atk_fallback, omp_atv_allocator_fb), &
+ omp_alloctrait (omp_atk_fb_data, 0), &
+ omp_alloctrait (omp_atk_partition, omp_atv_default)]
+
+ type (omp_alloctrait), parameter :: traits4(*) &
+ = [ omp_alloctrait (omp_atk_alignment, 128), &
+ omp_alloctrait (omp_atk_pool_size, 1024), &
+ omp_alloctrait (omp_atk_fallback, omp_atv_null_fb)]
+
+ interface
+ integer(c_int) function get__alignof_int () bind(C)
+ import :: c_int
+ end
+ end interface
+end module m
+
+program main
+ use m
+ implicit none (external, type)
+ integer(c_ptrdiff_t) :: iptr
+ type (c_ptr), volatile :: p, q, r
+ integer, pointer, volatile, contiguous :: ip(:), iq(:), ir(:)
+ type (omp_alloctrait) :: traits(3)
+ integer (omp_allocator_handle_kind) :: a, a2
+ traits = [ omp_alloctrait (omp_atk_alignment, 64), &
+ omp_alloctrait (omp_atk_fallback, omp_atv_null_fb), &
+ omp_alloctrait (omp_atk_pool_size, 4096)]
+
+ p = omp_aligned_alloc (c_sizeof (0), 3 * c_sizeof (0), omp_default_mem_alloc)
+ call c_f_pointer (p, ip, [3])
+ if (mod (TRANSFER (p, iptr), get__alignof_int ()) /= 0) &
+ stop 1
+ ip(0) = 1
+ ip(1) = 2
+ ip(2) = 3
+ call omp_free (p, omp_default_mem_alloc)
+
+ p = omp_aligned_alloc (2 * c_sizeof (0), 2 * c_sizeof (0), omp_default_mem_alloc)
+ call c_f_pointer (p, ip, [2])
+ if (mod (TRANSFER (p, iptr), 2 * c_sizeof (0)) /= 0) &
+ stop 2
+ ip(0) = 1
+ ip(1) = 2
+ call omp_free (p, omp_null_allocator)
+
+ call omp_set_default_allocator (omp_default_mem_alloc)
+ p = omp_aligned_alloc (1_c_size_t, 2 * c_sizeof (0), omp_null_allocator)
+ call c_f_pointer (p, ip, [2])
+ if (mod (TRANSFER (p, iptr), get__alignof_int ()) /= 0) &
+ stop 3
+ ip(0) = 3
+ call omp_free (p, omp_get_default_allocator ())
+
+ a = omp_init_allocator (omp_default_mem_space, 3, traits)
+ if (a == omp_null_allocator) &
+ stop 4
+ p = omp_aligned_alloc (32_c_size_t, 3072_c_size_t, a)
+ call c_f_pointer (p, ip, [3072/c_sizeof (0)])
+ if (mod (TRANSFER (p, iptr), 64) /= 0) &
+ stop 5
+ ip(1) = 1
+ ip(3072 / c_sizeof (0)) = 2
+
+ if (c_associated (omp_aligned_alloc (8_c_size_t, 3072_c_size_t, a))) &
+ stop 6
+
+ call omp_free (p, a)
+
+ p = omp_aligned_alloc (128_c_size_t, 3072_c_size_t, a)
+ call c_f_pointer (p, ip, [3072/c_sizeof (0)])
+ if (mod (TRANSFER (p, iptr), 128) /= 0) &
+ stop 7
+ ip(1) = 3
+ ip(3072 / c_sizeof (0)) = 4
+ call omp_free (p, omp_null_allocator)
+
+ call omp_set_default_allocator (a)
+ if (omp_get_default_allocator () /= a) &
+ stop 8
+ p = omp_aligned_alloc (64_c_size_t, 3072_c_size_t, omp_null_allocator)
+ call c_f_pointer (p, ip, [3072/c_sizeof (0)])
+ if (c_associated (omp_aligned_alloc (8_c_size_t, 3072_c_size_t, omp_null_allocator))) &
+ stop 9
+ call omp_free (p, a)
+ call omp_destroy_allocator (a)
+
+ a = omp_init_allocator (omp_default_mem_space, size (traits2), traits2)
+ if (a == omp_null_allocator) &
+ stop 9
+ if (traits3(6)%key /= omp_atk_fb_data) &
+ stop 10
+ traits3(6)%value = a
+ a2 = omp_init_allocator (omp_default_mem_space, size (traits3), traits3)
+ if (a2 == omp_null_allocator) &
+ stop 11
+
+ p = omp_aligned_alloc (4_c_size_t, 420_c_size_t, a2)
+ call c_f_pointer (p, ip, [420/c_sizeof (0)])
+ if (mod (TRANSFER (p, iptr), 32) /= 0) &
+ stop 12
+ ip(1) = 5
+ ip(420 / c_sizeof (0)) = 6
+
+ q = omp_aligned_alloc (8_c_size_t, 768_c_size_t, a2)
+ call c_f_pointer (q, iq, [768/c_sizeof (0)])
+ if (mod (TRANSFER (q, iptr), 16) /= 0) &
+ stop 13
+ iq(1) = 7
+ iq(768 / c_sizeof (0)) = 8
+
+ r = omp_aligned_alloc (8_c_size_t, 512_c_size_t, a2)
+ call c_f_pointer (r, ir, [512/c_sizeof (0)])
+ if (mod (TRANSFER (r, iptr), 8) /= 0) &
+ stop 14
+ ir(1) = 9
+ ir(512 / c_sizeof (0)) = 10
+ call omp_free (p, omp_null_allocator)
+ call omp_free (q, a2)
+ call omp_free (r, omp_null_allocator)
+ call omp_destroy_allocator (a2)
+ call omp_destroy_allocator (a)
+
+ a = omp_init_allocator (omp_default_mem_space, size (traits4), traits4)
+ if (a == omp_null_allocator) &
+ stop 15
+ if (traits3(6)%key /= omp_atk_fb_data) &
+ stop 16
+ traits3(6)%value = a
+ a2 = omp_init_allocator (omp_default_mem_space, size (traits3), traits3)
+ if (a2 == omp_null_allocator) &
+ stop 17
+ call omp_set_default_allocator (a2)
+
+ p = omp_aligned_alloc (4_c_size_t, 420_c_size_t, omp_null_allocator)
+ call c_f_pointer (p, ip, [420/c_sizeof (0)])
+ if (mod (TRANSFER (p, iptr), 32) /= 0) &
+ stop 18
+ ip(0) = 5
+ ip(420 / c_sizeof (0)) = 6
+
+ q = omp_aligned_alloc (64_c_size_t, 768_c_size_t, omp_null_allocator)
+ call c_f_pointer (q, iq, [768/c_sizeof (0)])
+ if (mod (TRANSFER (q, iptr), 128) /= 0) &
+ stop 19
+ iq(1) = 7
+ iq(768 / c_sizeof (0)) = 8
+ if (c_associated (omp_aligned_alloc (8_c_size_t, 768_c_size_t, omp_null_allocator))) &
+ stop 20
+ call omp_free (p, omp_null_allocator)
+ call omp_free (q, omp_null_allocator)
+ call omp_free (c_null_ptr, omp_null_allocator)
+ call omp_free (c_null_ptr, omp_null_allocator)
+ call omp_destroy_allocator (a2)
+ call omp_destroy_allocator (a)
+end program main
diff --git a/libgomp/testsuite/libgomp.fortran/alloc-8.f90 b/libgomp/testsuite/libgomp.fortran/alloc-8.f90
new file mode 100644
index 00000000000..4bff4d6ea29
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/alloc-8.f90
@@ -0,0 +1,58 @@
+module m
+ use omp_lib
+ implicit none
+
+ type (omp_alloctrait), parameter :: traits(*) &
+ = [ omp_alloctrait (omp_atk_alignment, 16), &
+ omp_alloctrait (omp_atk_sync_hint, omp_atv_default), &
+ omp_alloctrait (omp_atk_access, omp_atv_default), &
+ omp_alloctrait (omp_atk_fallback, omp_atv_default_mem_fb), &
+ omp_alloctrait (omp_atk_partition, omp_atv_environment)]
+end module m
+
+program main
+ use m
+ use iso_c_binding
+ implicit none (external, type)
+ integer (omp_allocator_handle_kind) :: a
+ type (c_ptr) :: p, q
+ integer (c_size_t), volatile :: large_sz
+ integer (c_ptrdiff_t) :: iptr
+
+ a = omp_init_allocator (omp_default_mem_space, size (traits), traits)
+ if (a == omp_null_allocator) &
+ stop 1
+ p = omp_alloc (2048_c_size_t, a)
+ if (mod (TRANSFER (p, iptr), 16) /= 0) &
+ stop 2
+ large_sz = NOT (1023_c_size_t)
+ q = omp_alloc (large_sz, a)
+ if (c_associated (q)) &
+ stop 3
+ q = omp_aligned_alloc (32_c_size_t, large_sz, a)
+ if (c_associated (q)) &
+ stop 4
+ q = omp_calloc (large_sz / 4_c_size_t, 4_c_size_t, a)
+ if (c_associated (q)) &
+ stop 5
+ q = omp_aligned_calloc (1_c_size_t, 2_c_size_t, large_sz / 2, a)
+ if (c_associated (q)) &
+ stop 6
+ call omp_free (p, a)
+ large_sz = NOT (0_c_size_t)
+ large_sz = ISHFT (large_sz, -1)
+ large_sz = large_sz + 1
+ if (c_associated (omp_calloc (2_c_size_t, large_sz, a))) &
+ stop 7
+ if (c_associated (omp_calloc (large_sz, 1024_c_size_t, a))) &
+ stop 8
+ if (c_associated (omp_calloc (large_sz, large_sz, a))) &
+ stop 9
+ if (c_associated (omp_aligned_calloc (16_c_size_t, 2_c_size_t, large_sz, a))) &
+ stop 10
+ if (c_associated (omp_aligned_calloc (32_c_size_t, large_sz, 1024_c_size_t, a))) &
+ stop 11
+ if (c_associated (omp_aligned_calloc (64_c_size_t, large_sz, large_sz, a))) &
+ stop 12
+ call omp_destroy_allocator (a)
+end program main
diff --git a/libgomp/testsuite/libgomp.fortran/alloc-9.f90 b/libgomp/testsuite/libgomp.fortran/alloc-9.f90
new file mode 100644
index 00000000000..6458f35fd1f
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/alloc-9.f90
@@ -0,0 +1,196 @@
+! { dg-additional-sources alloc-7.c }
+module m
+ use omp_lib
+ use iso_c_binding
+ implicit none
+
+ type (omp_alloctrait), parameter :: traits2(*) &
+ = [ omp_alloctrait (omp_atk_alignment, 16), &
+ omp_alloctrait (omp_atk_sync_hint, omp_atv_default), &
+ omp_alloctrait (omp_atk_access, omp_atv_default), &
+ omp_alloctrait (omp_atk_pool_size, 1024), &
+ omp_alloctrait (omp_atk_fallback, omp_atv_default_mem_fb), &
+ omp_alloctrait (omp_atk_partition, omp_atv_environment)]
+ type (omp_alloctrait) :: traits3(7) &
+ = [ omp_alloctrait (omp_atk_sync_hint, omp_atv_uncontended), &
+ omp_alloctrait (omp_atk_alignment, 32), &
+ omp_alloctrait (omp_atk_access, omp_atv_all), &
+ omp_alloctrait (omp_atk_pool_size, 512), &
+ omp_alloctrait (omp_atk_fallback, omp_atv_allocator_fb), &
+ omp_alloctrait (omp_atk_fb_data, 0), &
+ omp_alloctrait (omp_atk_partition, omp_atv_default)]
+ type (omp_alloctrait), parameter :: traits4(*) &
+ = [ omp_alloctrait (omp_atk_alignment, 128), &
+ omp_alloctrait (omp_atk_pool_size, 1024), &
+ omp_alloctrait (omp_atk_fallback, omp_atv_null_fb)]
+
+ interface
+ integer(c_int) function get__alignof_int () bind(C)
+ import :: c_int
+ end
+ end interface
+end module m
+
+program main
+ use m
+ implicit none (external, type)
+ type(c_ptr), volatile :: p, q, r
+ integer, pointer, contiguous, volatile :: ip(:), iq(:), ir(:)
+ type (omp_alloctrait) :: traits(3)
+ integer (omp_allocator_handle_kind) :: a, a2
+ integer (c_ptrdiff_t) :: iptr
+ integer :: i
+
+ traits = [ omp_alloctrait (omp_atk_alignment, 64), &
+ omp_alloctrait (omp_atk_fallback, omp_atv_null_fb), &
+ omp_alloctrait (omp_atk_pool_size, 4096)]
+
+ p = omp_calloc (3_c_size_t, sizeof (0), omp_default_mem_alloc)
+ call c_f_pointer (p, ip, [3])
+ if (mod (TRANSFER (p, iptr), get__alignof_int ()) /= 0 &
+ .or. ip(1) /= 0 .or. ip(2) /= 0 .or. ip(3) /= 0) &
+ stop 1
+ ip(1) = 1
+ ip(2) = 2
+ ip(3) = 3
+ call omp_free (p, omp_default_mem_alloc)
+ p = omp_calloc (2_c_size_t, sizeof (0), omp_default_mem_alloc)
+ call c_f_pointer (p, ip, [2])
+ if (mod (TRANSFER (p, iptr), get__alignof_int ()) /= 0 &
+ .or. ip(1) /= 0 .or. ip(2) /= 0) &
+ stop 2
+ ip(1) = 1
+ ip(2) = 2
+ call omp_free (p, omp_null_allocator)
+ call omp_set_default_allocator (omp_default_mem_alloc)
+ p = omp_calloc (1_c_size_t, sizeof (0), omp_null_allocator)
+ call c_f_pointer (p, ip, [1])
+ if (mod (TRANSFER (p, iptr), get__alignof_int ()) /= 0 &
+ .or. ip(1) /= 0) &
+ stop 3
+ ip(1) = 3
+ call omp_free (p, omp_get_default_allocator ())
+
+ a = omp_init_allocator (omp_default_mem_space, 3, traits)
+ if (a == omp_null_allocator) &
+ stop 4
+ p = omp_calloc (3_c_size_t, 1024_c_size_t, a)
+ call c_f_pointer (p, ip, [3072 / c_sizeof (0)])
+ if (mod (TRANSFER (p, iptr), 64) /= 0) &
+ stop 5
+ do i = 1, 3072 / c_sizeof (0)
+ if (ip(i) /= 0) &
+ stop 6
+ end do
+ ip(1) = 1
+ ip(3072 / c_sizeof (0)) = 2
+ if (c_associated (omp_calloc (1024_c_size_t, 3_c_size_t, a))) &
+ stop 7
+ call omp_free (p, a)
+ p = omp_calloc (512_c_size_t, 6_c_size_t, a)
+ call c_f_pointer (p, ip, [3072 / c_sizeof (0)])
+ do i = 1, 3072 / c_sizeof (0)
+ if (ip(i) /= 0) &
+ stop 8
+ end do
+ ip(1) = 3
+ ip(3072 / c_sizeof (0)) = 4
+ call omp_free (p, omp_null_allocator)
+ call omp_set_default_allocator (a)
+ if (omp_get_default_allocator () /= a) &
+ stop 9
+ p = omp_calloc (12_c_size_t, 256_c_size_t, omp_null_allocator)
+ call c_f_pointer (p, ip, [3072 / c_sizeof (0)])
+ do i = 1, 3072 / c_sizeof (0)
+ if (ip(i) /= 0) &
+ stop 10
+ end do
+ if (c_associated (omp_calloc (128_c_size_t, 24_c_size_t, omp_null_allocator))) &
+ stop 11
+ call omp_free (p, a)
+ call omp_destroy_allocator (a)
+
+ a = omp_init_allocator (omp_default_mem_space, size (traits2), traits2)
+ if (a == omp_null_allocator) &
+ stop 12
+ if (traits3(6)%key /= omp_atk_fb_data) &
+ stop 13
+ traits3(6)%value = a
+ a2 = omp_init_allocator (omp_default_mem_space, size (traits3), traits3)
+ if (a2 == omp_null_allocator) &
+ stop 14
+ p = omp_calloc (10_c_size_t, 42_c_size_t, a2)
+ call c_f_pointer (p, ip, [420 / c_sizeof (0)])
+ do i = 1, 420 / c_sizeof (0)
+ if (ip(i) /= 0) &
+ stop 15
+ end do
+ if (mod (TRANSFER (p, iptr), 32) /= 0) &
+ stop 16
+ ip(1) = 5
+ ip(420 / c_sizeof (0)) = 6
+ q = omp_calloc (24_c_size_t, 32_c_size_t, a2)
+ call c_f_pointer (q, iq, [768 / c_sizeof (0)])
+ if (mod (TRANSFER (q, iptr), 16) /= 0) &
+ stop 17
+ do i = 1, 768 / c_sizeof (0)
+ if (iq(i) /= 0) &
+ stop 18
+ end do
+ iq(1) = 7
+ iq(768 / c_sizeof (0)) = 8
+ r = omp_calloc (128_c_size_t, 4_c_size_t, a2)
+ call c_f_pointer (r, ir, [512 / c_sizeof (0)])
+ if (mod (TRANSFER (r, iptr), get__alignof_int ()) /= 0) &
+ stop 19
+ do i = 1, 512 / c_sizeof (0)
+ if (ir(i) /= 0) &
+ stop 20
+ end do
+ ir(1) = 9
+ ir(512 / c_sizeof (0)) = 10
+ call omp_free (p, omp_null_allocator)
+ call omp_free (q, a2)
+ call omp_free (r, omp_null_allocator)
+ call omp_destroy_allocator (a2)
+ call omp_destroy_allocator (a)
+
+ a = omp_init_allocator (omp_default_mem_space, size (traits4), traits4)
+ if (a == omp_null_allocator) &
+ stop 21
+ if (traits3(6)%key /= omp_atk_fb_data) &
+ stop 22
+ traits3(6)%value = a
+ a2 = omp_init_allocator (omp_default_mem_space, size (traits3), traits3)
+ if (a2 == omp_null_allocator) &
+ stop 23
+ call omp_set_default_allocator (a2)
+ p = omp_calloc (42_c_size_t, 10_c_size_t, omp_null_allocator)
+ call c_f_pointer (p, ip, [420 / c_sizeof (0)])
+ if (mod (TRANSFER (p, iptr), 32) /= 0) &
+ stop 24
+ do i = 1, 420 / c_sizeof (0)
+ if (ip(i) /= 0) &
+ stop 25
+ end do
+ ip(1) = 5
+ ip(420 / c_sizeof (0)) = 6
+ q = omp_calloc (32_c_size_t, 24_c_size_t, omp_null_allocator)
+ call c_f_pointer (q, iq, [768 / c_sizeof (0)])
+ if (mod (TRANSFER (q, iptr), 128) /= 0) &
+ stop 26
+ do i = 1, 768 / c_sizeof (0)
+ if (iq(i) /= 0) &
+ stop 27
+ end do
+ iq(1) = 7
+ iq(768 / c_sizeof (0)) = 8
+ if (c_associated (omp_calloc (24_c_size_t, 32_c_size_t, omp_null_allocator))) &
+ stop 28
+ call omp_free (p, omp_null_allocator)
+ call omp_free (q, omp_null_allocator)
+ call omp_free (c_null_ptr, omp_null_allocator)
+ call omp_free (c_null_ptr, omp_null_allocator)
+ call omp_destroy_allocator (a2)
+ call omp_destroy_allocator (a)
+end program main
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2021-09-30 12:50 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2021-09-30 12:50 [gcc/devel/omp/gcc-11] openmp: Add omp_aligned_{, c}alloc and omp_{c, re}alloc for Fortran Tobias Burnus
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).