[gcc/devel/omp/gcc-11] openmp: Add omp_aligned_{, c}alloc and omp_{c, re}alloc for Fortran

Tobias Burnus burnus@gcc.gnu.org
Thu Sep 30 12:50:52 GMT 2021


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


More information about the Gcc-cvs mailing list