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.

diff --git a/gcc/omp-low.c b/gcc/omp-low.c
index 26c5c0261e93c6657f81d1f8664523b246fa3663..f7242dfbbca848486752c2700838447e2124b566 100644 (file)
--- 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 b3bab8feddf7195a9d2bb247bac7bd2b5be43ce2..02160f815623641cc7fdc873e762ae6a897441c0 100644 (file)
--- 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 a36a562612358ab136730ead71cf8f338be39362..1063eee0c947ee3e2d39f2a179c8b69b173453fe 100644 (file)
--- 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 1c2eacba5548ca3502c6064cc1f936507b91e54b..f40321c479bcf07b1bd3af6082668d5f6195e647 100644 (file)
--- 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 (file)
index 0000000..d26a83b
--- /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 (file)
index 0000000..59fd14d
--- /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 (file)
index 0000000..4d16d09
--- /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 (file)
index 0000000..b047b0e
--- /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 (file)
index 0000000..4bff4d6
--- /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 (file)
index 0000000..6458f35
--- /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