[gcc r16-333] OpenMP: Restore lost Fortran testcase for 'omp allocate'

[Sandra Loosemore via Gcc-cvs]

https://gcc.gnu.org/g:08ce1b9f6707e00089c4d77d2bb82963d531bb1d

commit r16-333-g08ce1b9f6707e00089c4d77d2bb82963d531bb1d
Author: Tobias Burnus <tob...@codesourcery.com>
Date:   Thu May 1 15:39:42 2025 +0000

    OpenMP: Restore lost Fortran testcase for 'omp allocate'
    
    This testcase, which is present on the OG13 and OG14 branches, was
    overlooked when the Fortran support for 'omp allocate' was added to
    mainline (commit d4b6d147920b93297e621124a99ed01e7e310d92 from
    December 2023).
    
    libgomp/ChangeLog
    
            * testsuite/libgomp.fortran/allocate-8a.f90: New test.

Diff:
---
 libgomp/testsuite/libgomp.fortran/allocate-8a.f90 | 45 +++++++++++++++++++++++
 1 file changed, 45 insertions(+)

diff --git a/libgomp/testsuite/libgomp.fortran/allocate-8a.f90 
b/libgomp/testsuite/libgomp.fortran/allocate-8a.f90
new file mode 100644
index 000000000000..5f6c8c1e2717
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/allocate-8a.f90
@@ -0,0 +1,45 @@
+! { 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" } }