libgomp/testsuite/libgomp.fortran/allocators-1.f90

! { dg-additional-options "-fopenmp-allocators -fdump-tree-original" }
module m
  use omp_lib
  use iso_c_binding, only: c_intptr_t
  implicit none (type,external)
  integer(omp_allocator_handle_kind) :: handle  
  integer(c_intptr_t) :: iptr
end module m

subroutine scalar
  use m
  implicit none (type,external)
  integer :: i
  integer, allocatable :: SSS
  i = 5  ! required executive statement before 'omp allocators'
  !$omp allocate allocator(handle)
  allocate(SSS)
  if (mod (loc (sss), 64) /= 0) stop 1
  deallocate(SSS)
  allocate(SSS)
end
! { dg-final { scan-tree-dump-times "sss = \\(integer\\(kind=4\\) \\*\\) __builtin_GOMP_alloc \\(4, 4, D\\.\[0-9\]+\\);" 1 "original" } }
! { dg-final { scan-tree-dump-times "GOMP_add_alloc \\(sss\\);" 1 "original" } }
! { dg-final { scan-tree-dump-times "if \\(GOMP_is_alloc \\(sss\\)\\)" 2 "original" } }
! { dg-final { scan-tree-dump-times "__builtin_GOMP_free \\(sss, 0B\\);" 2 "original" } }

subroutine array
  use m
  implicit none (type,external)
  integer :: i
  integer, allocatable :: A(:)
  i = 5  ! required executive statement before 'omp allocators'
  !$omp allocate allocator(handle) align(512)
  allocate(A(5))
  if (mod (loc (A), 512) /= 0) stop 2
  A=[1]
  if (mod (loc (A), 64) /= 0) stop 3
  deallocate(A)
  A=[1]
  deallocate(A)
  call omp_set_default_allocator (handle)
  !$omp allocate
  allocate(A(7))
  if (mod (loc (A), 64) /= 0) stop 4
end
! { dg-final { scan-tree-dump-times "a.dtype = {.elem_len=4, .version=0, .rank=1, .type=1};" 5 "original" } }
! { dg-final { scan-tree-dump-times "\\.elem_len=4" 5 "original" } }
! { dg-final { scan-tree-dump-times "a.data = \\(void \\* restrict\\) __builtin_GOMP_alloc \\(512, 20, D\\.\[0-9\]+\\);" 1 "original" } }
! { dg-final { scan-tree-dump-times "a.data = \\(void \\* restrict\\) __builtin_GOMP_alloc \\(4, 28, 0B\\);" 1 "original" } }
! { dg-final { scan-tree-dump-times "a.dtype.version = 1;" 2 "original" } }
! { dg-final { scan-tree-dump-times "a.data = \\(void \\* restrict\\) \\(a.dtype.version == 1 \\? __builtin_omp_realloc \\(\\(void \\*\\) a.data, 4, 0B, 0B\\) : __builtin_realloc \\(\\(void \\*\\) a.data, 4\\)\\);" 2 "original" } }
! { dg-final { scan-tree-dump-times "if \\(a.dtype.version == 1\\)" 3 "original" } }
! { dg-final { scan-tree-dump-times "__builtin_GOMP_free \\(\\(integer\\(kind=4\\)\\\[0:\\\] \\* restrict\\) a.data, 0B\\);" 3 "original" } }
! { dg-final { scan-tree-dump-times "a.dtype.version = 0;" 3 "original" } }

program main
  use m
  implicit none (type,external)
  external :: scalar, array
  type (omp_alloctrait), parameter :: traits(*) &
      = [omp_alloctrait(omp_atk_sync_hint, omp_atv_contended), &
         omp_alloctrait(omp_atk_alignment, 64)]
  handle = omp_init_allocator (omp_high_bw_mem_alloc, size(traits), traits)
  call scalar
  call array
  call omp_destroy_allocator (handle)
end