libgomp/testsuite/libgomp.fortran/alloc-8.f90

   1 module m
   2   use omp_lib
   3   implicit none
   4
   5   type (omp_alloctrait), parameter :: traits(*) &
   6     = [ omp_alloctrait (omp_atk_alignment, 16), &
   7         omp_alloctrait (omp_atk_sync_hint, omp_atv_default), &
   8         omp_alloctrait (omp_atk_access, omp_atv_default), &
   9         omp_alloctrait (omp_atk_fallback, omp_atv_default_mem_fb), &
  10         omp_alloctrait (omp_atk_partition, omp_atv_environment)]
  11 end module m
  12
  13 program main
  14   use m
  15   use iso_c_binding
  16   implicit none (external, type)
  17   integer (omp_allocator_handle_kind) :: a
  18   type (c_ptr) :: p, q
  19   integer (c_size_t), volatile :: large_sz
  20   integer (c_ptrdiff_t) :: iptr
  21
  22   a = omp_init_allocator (omp_default_mem_space, size (traits), traits)
  23   if (a == omp_null_allocator) &
  24     stop 1
  25   p = omp_alloc (2048_c_size_t, a)
  26   if (mod (TRANSFER (p, iptr), 16) /= 0) &
  27     stop 2
  28   large_sz = NOT (1023_c_size_t)
  29   q = omp_alloc (large_sz, a)
  30   if (c_associated (q)) &
  31     stop 3
  32   q = omp_aligned_alloc (32_c_size_t, large_sz, a)
  33   if (c_associated (q)) &
  34     stop 4
  35   q = omp_calloc (large_sz / 4_c_size_t, 4_c_size_t, a)
  36   if (c_associated (q)) &
  37     stop 5
  38   q = omp_aligned_calloc (1_c_size_t, 2_c_size_t, large_sz / 2, a)
  39   if (c_associated (q)) &
  40     stop 6
  41   call omp_free (p, a)
  42   large_sz = NOT (0_c_size_t)
  43   large_sz = ISHFT (large_sz, -1)
  44   large_sz = large_sz + 1  ! signed integer overflow
  45   if (c_associated (omp_calloc (2_c_size_t, large_sz, a))) &
  46     stop 7
  47   if (c_associated (omp_calloc (large_sz, 1024_c_size_t, a))) &
  48     stop 8
  49   if (c_associated (omp_calloc (large_sz, large_sz, a))) &
  50     stop 9
  51   if (c_associated (omp_aligned_calloc (16_c_size_t, 2_c_size_t, large_sz, a))) &
  52     stop 10
  53   if (c_associated (omp_aligned_calloc (32_c_size_t, large_sz, 1024_c_size_t, a))) &
  54     stop 11
  55   if (c_associated (omp_aligned_calloc (64_c_size_t, large_sz, large_sz, a))) &
  56     stop 12
  57   call omp_destroy_allocator (a)
  58 end program main