libgomp/testsuite/libgomp.fortran/allocate-8a.f90

! { dg-additional-options "-fopenmp-allocators" }
! { dg-additional-options "-fdump-tree-omplower" }
program main
  use iso_c_binding
  use omp_lib
  implicit none (type, external)
  integer(omp_allocator_handle_kind):: alloc_h
  integer :: i, N
  integer(c_intptr_t) :: intptr
  integer, allocatable :: A(:)
  type(omp_alloctrait):: traits(1) = [omp_alloctrait(omp_atk_alignment, 128)]

  N = 10
  alloc_h = omp_init_allocator(omp_default_mem_space, 1, traits)

  !$omp allocate(A) allocator(alloc_h)
  allocate(A(N))
  a(:) = [(i, i=1,N)]
  if (mod (transfer (loc(a), intptr),128) /= 0) &
    stop 1
  if (any (a /= [(i, i=1,N)])) &
    stop 2
  deallocate(A)
  !$omp allocate(A) allocator(alloc_h) align(512)
  allocate(A(N))
  block
    integer, allocatable :: B(:)
    !$omp allocators allocate(allocator(alloc_h), align(256) : B)
    allocate(B(N))
    B(:) = [(2*i, i=1,N)]
    A(:) = B
    if (mod (transfer (loc(B), intptr), 256) /= 0) &
      stop 1
    ! end of scope deallocation
  end block
  if (mod (transfer (loc(a), intptr),512) /= 0) &
    stop 1
  if (any (a /= [(2*i, i=1,N)])) &
    stop 2
  deallocate(A) ! Must deallocate here - before deallocator is destroyed
  call omp_destroy_allocator(alloc_h)
  ! No auto dealloc of A because it is SAVE
end
! { dg-final { scan-tree-dump-times "__builtin_GOMP_alloc \\(" 3 "omplower" } }
! { dg-final { scan-tree-dump-times "__builtin_GOMP_free \\(" 3 "omplower" } }