From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: by sourceware.org (Postfix, from userid 1534) id 68E193858C39; Thu, 30 Sep 2021 12:50:52 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 68E193858C39 Content-Type: text/plain; charset="us-ascii" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit From: Tobias Burnus To: gcc-cvs@gcc.gnu.org Subject: [gcc/devel/omp/gcc-11] openmp: Add omp_aligned_{, c}alloc and omp_{c, re}alloc for Fortran X-Act-Checkin: gcc X-Git-Author: Tobias Burnus X-Git-Refname: refs/heads/devel/omp/gcc-11 X-Git-Oldrev: 9974875e87ef3f5726edcc262d160c39ca13d776 X-Git-Newrev: 695f503117a26d4b1f9ae292085a5a62d0174841 Message-Id: <20210930125052.68E193858C39@sourceware.org> Date: Thu, 30 Sep 2021 12:50:52 +0000 (GMT) X-BeenThere: gcc-cvs@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-cvs mailing list List-Unsubscribe: , List-Archive: List-Help: List-Subscribe: , X-List-Received-Date: Thu, 30 Sep 2021 12:50:52 -0000 https://gcc.gnu.org/g:695f503117a26d4b1f9ae292085a5a62d0174841 commit 695f503117a26d4b1f9ae292085a5a62d0174841 Author: Tobias Burnus 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 + + Backported from master: + 2021-09-30 Tobias Burnus + + * 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 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 + + Backported from master: + 2021-09-30 Tobias Burnus + + * 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 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