From: Tobias Burnus <tobias@codesourcery.com>
Date: Thu, 1 May 2025 15:39:42 +0000 (+0000)
Subject: OpenMP: Restore lost Fortran testcase for 'omp allocate'
X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=08ce1b9f6707e00089c4d77d2bb82963d531bb1d;p=thirdparty%2Fgcc.git

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 --git a/libgomp/testsuite/libgomp.fortran/allocate-8a.f90 b/libgomp/testsuite/libgomp.fortran/allocate-8a.f90
new file mode 100644
index 00000000000..5f6c8c1e271
--- /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" } }