Fix multiple issue in the testcase allocate-1.f90.

This is backport of patch posted in
https://gcc.gnu.org/pipermail/gcc-patches/2022-February/589928.html

1. Thomas reported in
https://gcc.gnu.org/pipermail/gcc-patches/2022-January/589039.html
that this testcase is randomly failing. The problem was fixed pool
size which was exhausted when there were a lot of threads. Fixed it
by removing pool_size trait which causes default pool size to be used
which should be big enough.

2. Array indices have been changed to check the last element in the
array.

3. Remove a redundant assignment and move some code to better match
C testcase.

libgomp/ChangeLog:

	* testsuite/libgomp.fortran/allocate-1.f90: Remove pool_size
	trait.  Test last index in w and v array.  Remove redundant
	assignment to V(1).  Move alignment checks at the end of
	parallel region.

diff --git a/libgomp/ChangeLog.omp b/libgomp/ChangeLog.omp
index b563e8899119aa5b16b8f01b647cb9c719116c03..0c13a8671d58ed3831c87b9b73990d7343bd10c4 100644 (file)
--- a/libgomp/ChangeLog.omp
+++ b/libgomp/ChangeLog.omp
@@ -1,3 +1,10 @@
+2022-03-08  Abid Qadeer  <abidh@codesourcery.com>
+
+       * testsuite/libgomp.fortran/allocate-1.f90: Remove pool_size
+       trait.  Test last index in w and v array.  Remove redundant
+       assignment to V(1).  Move alignment checks at the end of
+       parallel region.
+
 2022-03-08  Abid Qadeer  <abidh@codesourcery.com>
 
        Backported from master:

diff --git a/libgomp/testsuite/libgomp.fortran/allocate-1.f90 b/libgomp/testsuite/libgomp.fortran/allocate-1.f90
index 0a31d35d5ac19eaafe710a309ba6c2d100b687de..1547d2baeeff58b5c8136bdb57d60279325bcc81 100644 (file)
--- a/libgomp/testsuite/libgomp.fortran/allocate-1.f90
+++ b/libgomp/testsuite/libgomp.fortran/allocate-1.f90
@@ -74,31 +74,30 @@ subroutine foo (x, p, q, h, fl)
   if (x /= 42) then
     stop 1
   end if
-  v(1) = 7
-  if ( (and(fl, 2) /= 0) .and.          &
-       ((is_64bit_aligned(x) == 0) .or. &
-        (is_64bit_aligned(y) == 0) .or. &
-        (is_64bit_aligned(v(1)) == 0))) then
-      stop 2
-  end if
 
   !$omp barrier
   y = 1;
   x = x + 1
   v(1) = 7
-  v(41) = 8
+  v(42) = 8
   !$omp barrier
   if (x /= 43 .or. y /= 1) then
     stop 3
   end if
-  if (v(1) /= 7 .or. v(41) /= 8) then
+  if (v(1) /= 7 .or. v(42) /= 8) then
     stop 4
   end if
+  if ( (and(fl, 2) /= 0) .and.        &
+     ((is_64bit_aligned(x) == 0) .or. &
+      (is_64bit_aligned(y) == 0) .or. &
+      (is_64bit_aligned(v(1)) == 0))) then
+    stop 2
+  end if
   !$omp end parallel
   !$omp teams
   !$omp parallel private (y) firstprivate (x, w) allocate (h: x, y, w)
 
-  if (x /= 42 .or. w(17) /= 17 .or. w(41) /= 41) then
+  if (x /= 42 .or. w(17) /= 17 .or. w(42) /= 42) then
     stop 5
   end if
   !$omp barrier
@@ -314,13 +313,12 @@ program main
   integer, dimension(4) :: p
   integer, dimension(4) :: q
 
-  type (omp_alloctrait) :: traits(3)
+  type (omp_alloctrait) :: traits(2)
   integer (omp_allocator_handle_kind) :: a
 
   traits = [omp_alloctrait (omp_atk_alignment, 64), &
-            omp_alloctrait (omp_atk_fallback, omp_atv_null_fb), &
-            omp_alloctrait (omp_atk_pool_size, 8192)]
-  a = omp_init_allocator (omp_default_mem_space, 3, traits)
+            omp_alloctrait (omp_atk_fallback, omp_atv_null_fb)]
+  a = omp_init_allocator (omp_default_mem_space, 2, traits)
   if (a == omp_null_allocator) stop 1
 
   call omp_set_default_allocator (omp_default_mem_alloc);