From 70de20db232545daa2d6616e3581313476395ea3 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Thu, 30 Sep 2021 14:26:46 +0200 Subject: [PATCH] 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. --- gcc/omp-low.c | 8 +- libgomp/libgomp.texi | 2 +- libgomp/omp_lib.f90.in | 43 +++- libgomp/omp_lib.h.in | 46 +++- .../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 +++++++++++++++++ 10 files changed, 770 insertions(+), 5 deletions(-) create mode 100644 libgomp/testsuite/libgomp.fortran/alloc-10.f90 create mode 100644 libgomp/testsuite/libgomp.fortran/alloc-6.f90 create mode 100644 libgomp/testsuite/libgomp.fortran/alloc-7.c create mode 100644 libgomp/testsuite/libgomp.fortran/alloc-7.f90 create mode 100644 libgomp/testsuite/libgomp.fortran/alloc-8.f90 create mode 100644 libgomp/testsuite/libgomp.fortran/alloc-9.f90 diff --git a/gcc/omp-low.c b/gcc/omp-low.c index 26c5c0261e9..f7242dfbbca 100644 --- a/gcc/omp-low.c +++ b/gcc/omp-low.c @@ -3921,8 +3921,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/libgomp.texi b/libgomp/libgomp.texi index b3bab8feddf..02160f81562 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