Fortran: Support OpenMP's 'allocate' directive for stack vars

gcc/fortran/ChangeLog:

	* gfortran.h (ext_attr_t): Add omp_allocate flag.
	* match.cc (gfc_free_omp_namelist): Void deleting same
	u2.allocator multiple times now that a sequence can use
	the same one.
	* openmp.cc (gfc_match_omp_clauses, gfc_match_omp_allocate): Use
	same allocator expr multiple times.
	(is_predefined_allocator): Make static.
	(gfc_resolve_omp_allocate): Update/extend restriction checks;
	remove sorry message.
	(resolve_omp_clauses): Reject corarrays in allocate/allocators
	directive.
	* parse.cc (check_omp_allocate_stmt): Permit procedure pointers
	here (rejected later) for less misleading diagnostic.
	* trans-array.cc (gfc_trans_auto_array_allocation): Propagate
	size for GOMP_alloc and location to which it should be added to.
	* trans-decl.cc (gfc_trans_deferred_vars): Handle 'omp allocate'
	for stack variables; sorry for static variables/common blocks.
	* trans-openmp.cc (gfc_trans_omp_clauses): Evaluate 'allocate'
	clause's allocator only once; fix adding expressions to the
	block.
	(gfc_trans_omp_single): Pass a block to gfc_trans_omp_clauses.

gcc/ChangeLog:

	* gimplify.cc (gimplify_bind_expr): Handle Fortran's
	'omp allocate' for stack variables.

libgomp/ChangeLog:

	* libgomp.texi (OpenMP Impl. Status): Mention that Fortran now
	supports the allocate directive for stack variables.
	* testsuite/libgomp.fortran/allocate-5.f90: New test.
	* testsuite/libgomp.fortran/allocate-6.f90: New test.
	* testsuite/libgomp.fortran/allocate-7.f90: New test.
	* testsuite/libgomp.fortran/allocate-8.f90: New test.

gcc/testsuite/ChangeLog:

	* c-c++-common/gomp/allocate-14.c: Fix directive name.
	* c-c++-common/gomp/allocate-15.c: Likewise.
	* c-c++-common/gomp/allocate-9.c: Fix comment typo.
	* gfortran.dg/gomp/allocate-4.f90: Remove sorry dg-error.
	* gfortran.dg/gomp/allocate-7.f90: Likewise.
	* gfortran.dg/gomp/allocate-10.f90: New test.
	* gfortran.dg/gomp/allocate-11.f90: New test.
	* gfortran.dg/gomp/allocate-12.f90: New test.
	* gfortran.dg/gomp/allocate-13.f90: New test.
	* gfortran.dg/gomp/allocate-14.f90: New test.
	* gfortran.dg/gomp/allocate-15.f90: New test.
	* gfortran.dg/gomp/allocate-8.f90: New test.
	* gfortran.dg/gomp/allocate-9.f90: New test.

4 files changed, 651 insertions, 0 deletions

diff --git a/libgomp/testsuite/libgomp.fortran/allocate-5.f90 b/libgomp/testsuite/libgomp.fortran/allocate-5.f90
new file mode 100644
index 0000000..de9cd5a
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/allocate-5.f90
@@ -0,0 +1,87 @@
+! { dg-additional-options "-fdump-tree-gimple" }
+
+! { dg-final { scan-tree-dump-times "__builtin_GOMP_alloc \\(" 5 "gimple" } }
+! { dg-final { scan-tree-dump-times "__builtin_GOMP_free \\(" 5 "gimple" } }
+
+
+module m
+  use omp_lib
+  use iso_c_binding
+  implicit none (type, external)
+  integer(c_intptr_t) :: intptr
+contains
+
+integer function one ()
+  integer :: sum, i
+  !$omp allocate(sum)
+  ! { dg-final { scan-tree-dump-times "sum\\.\[0-9\]+ = __builtin_GOMP_alloc \\(4, 4, 0B\\);" 1 "gimple" } }
+  ! { dg-final { scan-tree-dump-times "__builtin_GOMP_free \\(sum\\.\[0-9\]+, 0B\\);" 1 "gimple" } }
+
+  ! NOTE: Initializer cannot be omp_init_allocator - as 'A' is
+  ! in the same scope and the auto-omp_free comes later than
+  ! any omp_destroy_allocator.
+  integer(omp_allocator_handle_kind) :: my_allocator = omp_low_lat_mem_alloc
+  integer :: n = 25
+  sum = 0
+ block
+  type(omp_alloctrait) :: traits(1) = [ omp_alloctrait(omp_atk_alignment, 64) ]
+  integer :: A(n)
+  !$omp allocate(A) align(128) allocator(my_allocator)
+  ! { dg-final { scan-tree-dump-times "a = __builtin_GOMP_alloc \\(128, D\\.\[0-9\]+, D\\.\[0-9\]+\\);" 1 "gimple" } }
+  ! { dg-final { scan-tree-dump-times "__builtin_GOMP_free \\(a, 0B\\);" 1 "gimple" } }
+
+  if (mod (transfer(loc(A), intptr), 128_c_intptr_t) /= 0) &
+    stop 2
+  do i = 1, n
+    A(i) = i
+  end do
+
+  my_allocator = omp_init_allocator(omp_low_lat_mem_space,1,traits)
+  block
+    integer B(n)
+    integer C(5)
+    !$omp allocate(B,C) allocator(my_allocator)
+    ! { dg-final { scan-tree-dump-times "b = __builtin_GOMP_alloc \\(\[0-9\]+, D\\.\[0-9\]+, D\\.\[0-9\]+\\);" 1 "gimple" } }
+    ! { dg-final { scan-tree-dump-times "c\\.\[0-9\]+ = __builtin_GOMP_alloc \\(\[0-9\]+, 20, D\\.\[0-9\]+\\);" 1 "gimple" } }
+    ! { dg-final { scan-tree-dump-times "__builtin_GOMP_free \\(b, 0B\\);" 1 "gimple" } }
+    ! { dg-final { scan-tree-dump-times "__builtin_GOMP_free \\(c\\.\[0-9\]+, 0B\\);" 1 "gimple" } }
+
+    integer :: D(5)
+    !$omp allocate(D) align(256)
+    ! { dg-final { scan-tree-dump-times "d\\.\[0-9\]+ = __builtin_GOMP_alloc \\(256, 20, 0B\\);" 1 "gimple" } }
+    ! { dg-final { scan-tree-dump-times "__builtin_GOMP_free \\(d\\.\[0-9\]+, 0B\\);" 1 "gimple" } }
+
+    B = 0
+    C = [1,2,3,4,5]
+    D = [11,22,33,44,55]
+
+    if (mod (transfer(loc(B), intptr), 64_c_intptr_t) /= 0) &
+      stop 3
+    if (mod (transfer(loc(C), intptr), 64_c_intptr_t) /= 0) &
+      stop 4
+    if (mod (transfer(loc(D), intptr), 256_c_intptr_t) /= 0) &
+      stop 5
+
+    do i = 1, 5
+      if (C(i) /= i) &
+        stop 6
+      if (D(i) /= i + 10*i) &
+        stop 7
+    end do
+
+    do i = 1, n
+      if (B(i) /= 0) &
+        stop 9
+      sum = sum + A(i)+B(i)+C(mod(i,5)+1)+D(mod(i,5)+1)
+    end do
+  end block
+  call omp_destroy_allocator (my_allocator)
+ end block
+ one = sum
+end
+end module
+
+use m
+if (one () /= 1225) &
+  stop 1
+end
diff --git a/libgomp/testsuite/libgomp.fortran/allocate-6.f90 b/libgomp/testsuite/libgomp.fortran/allocate-6.f90
new file mode 100644
index 0000000..5c32652
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/allocate-6.f90
@@ -0,0 +1,123 @@
+module m
+  use iso_c_binding
+  use omp_lib
+  implicit none (type, external)
+  integer(c_intptr_t) :: intptr
+
+! { dg-final { scan-tree-dump-not "__builtin_stack_save" "gimple" } }
+! { dg-final { scan-tree-dump-not "__builtin_alloca" "gimple" } }
+! { dg-final { scan-tree-dump-not "__builtin_stack_restore" "gimple" } }
+
+! { dg-final { scan-tree-dump-times "__builtin_GOMP_alloc \\(" 5 "gimple" } }
+! { dg-final { scan-tree-dump-times "__builtin_GOMP_free \\(" 5 "gimple" } }
+
+contains
+
+subroutine one ()
+  integer :: result, n, i
+  result = 0
+  n = 3
+  !$omp target map(tofrom: result) firstprivate(n)
+    block
+      integer :: var, var2(n)
+      !$omp allocate(var,var2) align(128) allocator(omp_low_lat_mem_alloc)
+      var = 5
+! { dg-final { scan-tree-dump-times "var\\.\[0-9\]+ = __builtin_GOMP_alloc \\(128, 4, 5\\);" 1 "gimple" } } */
+! { dg-final { scan-tree-dump-times "var2\\.\[0-9\]+ = __builtin_GOMP_alloc \\(128, D\\.\[0-9\]+, 5\\);" 1 "gimple" } } */
+
+! { dg-final { scan-tree-dump-times "__builtin_GOMP_free \\(var\\.\[0-9\]+, 0B\\);" 1 "gimple" } } */
+! { dg-final { scan-tree-dump-times "__builtin_GOMP_free \\(var2\\.\[0-9\]+, 0B\\);" 1 "gimple" } } */
+
+      if (mod(transfer(loc(var), intptr), 128_c_intptr_t) /= 0) &
+        stop 1
+      if (mod(transfer(loc(var2), intptr), 128_c_intptr_t) /= 0) &
+        stop 2
+      if (var /= 5) &
+        stop 3
+
+      !$omp parallel do
+      do i = 1, n
+        var2(i) = (i+32);
+      end do
+
+      !$omp parallel loop reduction(+:result)
+      do i = 1, n
+        result = result + var + var2(i)
+      end do
+    end block
+  if (result /= (3*5 + 33 + 34 + 35)) &
+    stop 4
+end
+
+subroutine two ()
+  type st
+    integer :: a, b
+  end type
+  integer :: scalar, array(5), i
+  type(st) s
+  !$omp allocate(scalar, array, s)
+! { dg-final { scan-tree-dump-times "scalar\\.\[0-9\]+ = __builtin_GOMP_alloc \\(4, 4, 0B\\);" 1 "gimple" } }
+! { dg-final { scan-tree-dump-times "array\\.\[0-9\]+ = __builtin_GOMP_alloc \\(4, 20, 0B\\);" 1 "gimple" } }
+! { dg-final { scan-tree-dump-times "s\\.\[0-9\]+ = __builtin_GOMP_alloc \\(4, 8, 0B\\);" 1 "gimple" } }
+! { dg-final { scan-tree-dump-times "__builtin_GOMP_free \\(scalar\\.\[0-9\]+, 0B\\);" 1 "gimple" } }
+! { dg-final { scan-tree-dump-times "__builtin_GOMP_free \\(array\\.\[0-9\]+, 0B\\);" 1 "gimple" } }
+! { dg-final { scan-tree-dump-times "__builtin_GOMP_free \\(s\\.\[0-9\]+, 0B\\);" 1 "gimple" } }
+
+  scalar = 44
+  array = [1,2,3,4,5]
+  s = st(a=11, b=56)
+
+  !$omp parallel firstprivate(scalar) firstprivate(array) firstprivate(s)
+    if (scalar /= 44) &
+      stop 5
+    scalar = 33;
+    if (any (array /= [1,2,3,4,5])) &
+      stop 6
+    array = [10,20,30,40,50]
+    if (s%a /= 11 .or. s%b /= 56) &
+      stop 7
+    s%a = 74
+    s%b = 674
+  !$omp end parallel
+
+  if (scalar /= 44) &
+    stop 8
+  if (any (array /= [1,2,3,4,5])) &
+    stop 9
+  if (s%a /= 11 .or. s%b /= 56) &
+    stop 10
+
+  !$omp target defaultmap(firstprivate : scalar) defaultmap(none : aggregate) defaultmap(none : pointer)
+    if (scalar /= 44) &
+      stop 11
+    scalar = 33;
+  !$omp end target
+
+  if (scalar /= 44) &
+    stop 12
+
+  !$omp target defaultmap(none : scalar) defaultmap(firstprivate : aggregate) defaultmap(none : pointer) private(i)
+    if (any (array /= [1,2,3,4,5])) &
+      stop 13
+    do i = 1, 5
+      array(i) = 10*i
+    end do
+  !$omp end target
+
+  if (any(array /= [1,2,3,4,5])) &
+    stop 13
+  !$omp target defaultmap(none : scalar) defaultmap(firstprivate : aggregate) defaultmap(none : pointer)
+    if (s%a /= 11 .or. s%b /= 56) &
+      stop 14
+    s%a = 74
+    s%b = 674
+  !$omp end target
+  if (s%a /= 11 .or. s%b /= 56) &
+    stop 15
+end
+end module
+
+use m
+  call one ()
+  call two ()
+end
diff --git a/libgomp/testsuite/libgomp.fortran/allocate-7.f90 b/libgomp/testsuite/libgomp.fortran/allocate-7.f90
new file mode 100644
index 0000000..83f3eab
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/allocate-7.f90
@@ -0,0 +1,342 @@
+! { dg-additional-options "-fdump-tree-omplower" }
+
+! For the 4 vars in omp_parallel, 4 in omp_target and 2 in no_alloc2_func.
+! { dg-final { scan-tree-dump-times "__builtin_GOMP_alloc \\(" 10 "omplower" } } 
+! { dg-final { scan-tree-dump-times "__builtin_GOMP_free \\(" 10 "omplower" } }
+
+module m
+  use iso_c_binding
+  use omp_lib
+  implicit none (type, external)
+  integer(c_intptr_t) :: intptr
+
+contains
+
+subroutine check_int (x, y)
+  integer :: x, y
+  value :: y
+  if (x /= y) &
+    stop 1
+end
+
+subroutine check_ptr (x, y)
+  type(c_ptr) :: x
+  integer(c_intptr_t), value :: y
+  if (transfer(x,intptr) /= y) &
+    stop 2
+end
+
+integer function no_alloc_func () result(res)
+  ! There is no __builtin_GOMP_alloc / __builtin_GOMP_free as
+  ! allocator == omp_default_mem_alloc (known at compile time.
+  integer :: no_alloc
+  !$omp allocate(no_alloc) allocator(omp_default_mem_alloc)
+  no_alloc = 7
+  res = no_alloc
+end
+
+integer function no_alloc2_func() result(res)
+  ! If no_alloc2 were TREE_UNUSED, there would be no
+  ! __builtin_GOMP_alloc / __builtin_GOMP_free
+  ! However, as the parser already marks no_alloc2
+  ! and is_alloc2 as used, the tree is generated for both vars.
+  integer :: no_alloc2, is_alloc2
+  !$omp allocate(no_alloc2, is_alloc2)
+  is_alloc2 = 7
+  res = is_alloc2
+end
+
+
+subroutine omp_parallel ()
+  integer :: i, n, iii, jjj(5)
+  type(c_ptr) :: ptr
+  !$omp allocate(iii, jjj, ptr)
+  n = 6
+  iii = 5
+  ptr = transfer (int(z'1234', c_intptr_t), ptr)
+ block
+  integer :: kkk(n)
+  !$omp allocate(kkk)
+
+  do i = 1, 5
+    jjj(i) = 3*i
+  end do
+  do i = 1, 6
+    kkk(i) = 7*i
+  end do
+
+  !$omp parallel default(none) firstprivate(iii, jjj, kkk, ptr) if(.false.)
+    if (iii /= 5) &
+      stop 3
+    iii = 7
+    call check_int (iii, 7)
+    do i = 1, 5
+      if (jjj(i) /= 3*i) &
+        stop 4
+    end do
+    do i = 1, 6
+      if (kkk(i) /= 7*i) &
+        stop 5
+    end do
+    do i = 1, 5
+      jjj(i) = 4*i
+    end do
+    do i = 1, 6
+      kkk(i) = 8*i
+    end do
+    do i = 1, 5
+      call check_int (jjj(i), 4*i)
+    end do
+    do i = 1, 6
+      call check_int (kkk(i), 8*i)
+    end do
+    if (transfer (ptr, intptr) /= int(z'1234', c_intptr_t)) &
+      stop 6
+    ptr = transfer (int(z'abcd', c_intptr_t), ptr)
+    if (transfer (ptr, intptr) /= int(z'abcd', c_intptr_t)) &
+      stop 7
+    call check_ptr (ptr,  int(z'abcd', c_intptr_t))
+  !$omp end parallel
+
+  if (iii /= 5) &
+    stop 8
+  call check_int (iii, 5)
+  do i = 1, 5
+    if (jjj(i) /= 3*i) &
+      stop 9
+    call check_int (jjj(i), 3*i)
+  end do
+  do i = 1, 6
+    if (kkk(i) /= 7*i) &
+      stop 10
+    call check_int (kkk(i), 7*i)
+  end do
+  if (transfer (ptr, intptr) /= int(z'1234', c_intptr_t)) &
+    stop 11
+  call check_ptr (ptr, int(z'1234', c_intptr_t))
+
+  !$omp parallel default(firstprivate) if(.false.)
+    if (iii /= 5) &
+      stop 12
+    iii = 7
+    call check_int (iii, 7)
+    do i = 1, 5
+      if (jjj(i) /= 3*i) &
+        stop 13
+    end do
+    do i = 1, 6
+      if (kkk(i) /= 7*i) &
+        stop 14
+    end do
+    do i = 1, 5
+      jjj(i) = 4*i
+    end do
+    do i = 1, 6
+      kkk(i) = 8*i
+    end do
+    do i = 1, 5
+      call check_int (jjj(i), 4*i)
+    end do
+    do i = 1, 6
+      call check_int (kkk(i), 8*i)
+    end do
+    if (transfer (ptr, intptr) /= int(z'1234', c_intptr_t)) &
+      stop 15
+    ptr = transfer (int (z'abcd', c_intptr_t), ptr)
+    if (transfer (ptr, intptr) /= int(z'abcd', c_intptr_t)) &
+      stop 16
+    call check_ptr (ptr, int (z'abcd', c_intptr_t))
+  !$omp end parallel
+  if (iii /= 5) &
+    stop 17
+  call check_int (iii, 5)
+  do i = 1, 5
+    if (jjj(i) /= 3*i) &
+      stop 18
+    call check_int (jjj(i), 3*i)
+  end do
+  do i = 1, 6
+    if (kkk(i) /= 7*i) &
+      stop 19
+    call check_int (kkk(i), 7*i)
+  end do
+  if (transfer (ptr, intptr) /= int(z'1234', c_intptr_t)) &
+    stop 20
+  call check_ptr (ptr, int (z'1234', c_intptr_t))
+ end block
+end
+
+subroutine omp_target ()
+  integer :: i, n, iii, jjj(5)
+  type(c_ptr) :: ptr
+  !$omp allocate(iii, jjj, ptr)
+  n = 6
+  iii = 5
+  ptr = transfer (int (z'1234', c_intptr_t), ptr)
+ block
+  integer :: kkk(n)
+  !$omp allocate(kkk)
+  do i = 1, 5
+    jjj(i) = 3*i
+  end do
+  do i = 1, 6
+    kkk(i) = 7*i
+  end do
+
+  !$omp target defaultmap(none) firstprivate(iii, jjj, kkk, ptr) private(i)
+    if (iii /= 5) &
+      stop 21
+    iii = 7
+    call check_int (iii, 7)
+    do i = 1, 5
+      if (jjj(i) /= 3*i) &
+        stop 22
+    end do
+    do i = 1, 6
+      if (kkk(i) /= 7*i) &
+        stop 23
+    end do
+    do i = 1, 5
+      jjj(i) = 4*i
+    end do
+    do i = 1, 6
+      kkk(i) = 8*i
+    end do
+    do i = 1, 5
+      call check_int (jjj(i), 4*i)
+    end do
+    do i = 1, 6
+      call check_int (kkk(i), 8*i)
+    end do
+    if (transfer (ptr, intptr) /= int(z'1234', c_intptr_t)) &
+      stop 24
+    ptr = transfer (int (z'abcd', c_intptr_t), ptr)
+    if (transfer (ptr, intptr) /= int(z'abcd', c_intptr_t)) &
+      stop 25
+    call check_ptr (ptr, int (z'abcd', c_intptr_t))
+  !$omp end target
+
+  if (iii /= 5) &
+    stop 26
+  call check_int (iii, 5)
+  do i = 1, 5
+    if (jjj(i) /= 3*i) &
+      stop 27
+    call check_int (jjj(i), 3*i)
+  end do
+  do i = 1, 6
+    if (kkk(i) /= 7*i) &
+      stop 28
+    call check_int (kkk(i), 7*i)
+  end do
+  if (transfer (ptr, intptr) /= int(z'1234', c_intptr_t)) &
+    stop 29
+  call check_ptr (ptr, int (z'1234', c_intptr_t))
+
+  !$omp target defaultmap(firstprivate)
+    if (iii /= 5) &
+      stop 30
+    iii = 7
+    call check_int (iii, 7)
+    do i = 1, 5
+      if (jjj(i) /= 3*i) &
+        stop 31
+    end do
+    do i = 1, 6
+      if (kkk(i) /= 7*i) &
+        stop 32
+    end do
+    do i = 1, 5
+      jjj(i) = 4*i
+    end do
+    do i = 1, 6
+      kkk(i) = 8*i
+    end do
+    do i = 1, 5
+      call check_int (jjj(i), 4*i)
+    end do
+    do i = 1, 6
+      call check_int (kkk(i), 8*i)
+    end do
+    if (transfer (ptr, intptr) /= int(z'1234', c_intptr_t)) &
+      stop 33
+    ptr = transfer (int (z'abcd', c_intptr_t), ptr)
+    if (transfer (ptr, intptr) /= int(z'abcd', c_intptr_t)) &
+      stop 34
+    call check_ptr (ptr, int (z'abcd', c_intptr_t))
+  !$omp end target
+  if (iii /= 5) &
+    stop 35
+  call check_int (iii, 5)
+  do i = 1, 5
+    if (jjj(i) /= 3*i) &
+      stop 36
+    call check_int (jjj(i), 3*i)
+  end do
+  do i = 1, 6
+    if (kkk(i) /= 7*i) &
+      stop 37
+    call check_int (kkk(i), 7*i)
+  end do
+  if (transfer (ptr, intptr) /= int(z'1234', c_intptr_t)) &
+    stop 38
+  call check_ptr (ptr, int (z'1234', c_intptr_t))
+
+  !$omp target defaultmap(tofrom)
+    if (iii /= 5) &
+      stop 39
+    iii = 7
+    call check_int (iii, 7)
+    do i = 1, 5
+      if (jjj(i) /= 3*i) &
+        stop 40
+    end do
+    do i = 1, 6
+      if (kkk(i) /= 7*i) &
+        stop 41
+    end do
+    do i = 1, 5
+      jjj(i) = 4*i
+    end do
+    do i = 1, 6
+      kkk(i) = 8*i
+    end do
+    do i = 1, 5
+      call check_int (jjj(i), 4*i)
+    end do
+    do i = 1, 6
+      call check_int (kkk(i), 8*i)
+    end do
+    if (transfer (ptr, intptr) /= int(z'1234', c_intptr_t)) &
+      stop 42
+    ptr = transfer (int(z'abcd',c_intptr_t), ptr)
+    if (transfer (ptr, intptr) /= int(z'abcd', c_intptr_t)) &
+      stop 43
+    call check_ptr (ptr, int (z'abcd', c_intptr_t))
+  !$omp end target
+
+  if (iii /= 7) &
+    stop 44
+  call check_int (iii, 7)
+  do i = 1, 5
+    if (jjj(i) /= 4*i) &
+      stop 45
+    call check_int (jjj(i), 4*i)
+  end do
+  do i = 1, 6
+    if (kkk(i) /= 8*i) &
+      stop 46
+    call check_int (kkk(i), 8*i)
+  end do
+  if (transfer (ptr, intptr) /= int(z'abcd', c_intptr_t)) &
+    stop 47
+  call check_ptr (ptr, int (z'abcd', c_intptr_t))
+ end block
+end
+end module
+
+
+use m
+  call omp_parallel ()
+  call omp_target ()
+end
diff --git a/libgomp/testsuite/libgomp.fortran/allocate-8.f90 b/libgomp/testsuite/libgomp.fortran/allocate-8.f90
new file mode 100644
index 0000000..b9dea6c
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/allocate-8.f90
@@ -0,0 +1,99 @@
+module m
+use omp_lib
+implicit none
+!!$omp requires dynamic_allocators
+
+integer :: final_count
+
+type t
+  integer :: i = 0
+  integer, allocatable :: A(:,:)
+contains
+  final :: count_finalization
+end type t
+
+contains
+
+elemental impure subroutine count_finalization(self)
+  type(t), intent(in) :: self
+  final_count = final_count + 1
+end
+
+subroutine test(allocator)
+integer(omp_allocator_handle_kind), optional, value :: allocator
+call zero_size(allocator)
+call finalization_test(allocator)
+end subroutine test
+
+subroutine finalization_test(allocator)
+integer(omp_allocator_handle_kind), optional, value :: allocator
+integer :: n = 5
+
+final_count = 0;
+block
+  type(t) :: A
+!  !$omp allocate(A) allocator(allocator)
+  A%i = 1
+end block
+if (final_count /= 1) &
+  stop 10
+
+final_count = 0;
+block
+  type(t) :: B(7)
+  !$omp allocate(B) allocator(allocator)
+  B(1)%i = 1
+end block
+if (final_count /= 7) stop 10
+
+final_count = 0;
+block
+  type(t) :: C(n)
+!  !$omp allocate(C) allocator(allocator)
+  C(1)%i = 1
+end block
+if (final_count /= 5) stop 10
+
+final_count = 0;
+block
+  type(t) :: D(0)
+!  !$omp allocate(D) allocator(allocator)
+  D(1:0)%i = 1
+end block
+if (final_count /= 0) stop 10
+end subroutine
+
+subroutine zero_size(allocator)
+integer(omp_allocator_handle_kind), optional, value :: allocator
+integer :: n
+n = -3
+
+block
+  integer :: A(n)
+  character(len=n) :: B
+!  !$omp allocate(A,b) allocator(allocator)
+  if (size(A) /= 0 .or. len(b) /= 0) &
+    stop 1
+  B(1:len(b)) ='A'
+end block
+
+!!$omp target
+block
+  integer :: A(n)
+  character(len=n) :: B
+!  !$omp allocate(A,b) allocator(allocator)
+  if (size(A) /= 0 .or. len(b) /= 0) &
+    stop 2
+  B(1:len(b)) ='A'
+end block
+end
+end module
+
+use m
+call test()
+call test(omp_default_mem_alloc)
+call test(omp_large_cap_mem_alloc)
+call test(omp_high_bw_mem_alloc)
+call test(omp_low_lat_mem_alloc)
+call test(omp_cgroup_mem_alloc)
+end