Add support for allocate clause (OpenMP 5.0).

This patch adds support for OpenMP 5.0 allocate clause for fortran. It does not
yet support the allocator-modifier as specified in OpenMP 5.1. The allocate
clause is already supported in C/C++.

gcc/fortran/ChangeLog:

	* dump-parse-tree.c (show_omp_clauses): Handle OMP_LIST_ALLOCATE.
	* gfortran.h (OMP_LIST_ALLOCATE): New enum value.
	* openmp.c (enum omp_mask1): Add OMP_CLAUSE_ALLOCATE.
	(gfc_match_omp_clauses): Handle OMP_CLAUSE_ALLOCATE
	(OMP_PARALLEL_CLAUSES, OMP_DO_CLAUSES, OMP_SECTIONS_CLAUSES)
	(OMP_TASK_CLAUSES, OMP_TASKLOOP_CLAUSES, OMP_TARGET_CLAUSES)
	(OMP_TEAMS_CLAUSES, OMP_DISTRIBUTE_CLAUSES)
	(OMP_SINGLE_CLAUSES): Add OMP_CLAUSE_ALLOCATE.
	(OMP_TASKGROUP_CLAUSES): New.
	(gfc_match_omp_taskgroup): Use OMP_TASKGROUP_CLAUSES instead of
	OMP_CLAUSE_TASK_REDUCTION.
	(resolve_omp_clauses): Handle OMP_LIST_ALLOCATE.
	(resolve_omp_do): Avoid warning when loop iteration variable is
	in allocate clause.
	* trans-openmp.c (gfc_trans_omp_clauses): Handle translation of
	allocate clause.
	(gfc_split_omp_clauses): Update for OMP_LIST_ALLOCATE.

gcc/testsuite/ChangeLog:

	* gfortran.dg/gomp/allocate-1.f90: New test.
	* gfortran.dg/gomp/allocate-2.f90: New test.
	* gfortran.dg/gomp/allocate-3.f90: New test.
	* gfortran.dg/gomp/collapse1.f90: Update error message.
	* gfortran.dg/gomp/openmp-simd-4.f90: Likewise.
	* gfortran.dg/gomp/clauses-1.f90: Uncomment allocate clause.

libgomp/ChangeLog:

	* testsuite/libgomp.fortran/allocate-1.c: New test.
	* testsuite/libgomp.fortran/allocate-1.f90: New test.
	* libgomp.texi: Remove string that says that allocate clause
	support is for C/C++ only.

3 files changed, 341 insertions, 1 deletions

diff --git a/libgomp/libgomp.texi b/libgomp/libgomp.texi
index e07a66d965d..3be9de51f11 100644
--- a/libgomp/libgomp.texi
+++ b/libgomp/libgomp.texi
@@ -219,7 +219,7 @@ The OpenMP 4.5 specification is fully supported.
       @tab Y @tab Some are only stubs
 @item Memory management routines @tab Y @tab
 @item @code{allocate} directive @tab N @tab
-@item @code{allocate} clause @tab P @tab initial support in C/C++ only
+@item @code{allocate} clause @tab P @tab initial support
 @item @code{use_device_addr} clause on @code{target data} @tab Y @tab
 @item @code{ancestor} modifier on @code{device} clause
       @tab P @tab Reverse offload unsupported
diff --git a/libgomp/testsuite/libgomp.fortran/allocate-1.c b/libgomp/testsuite/libgomp.fortran/allocate-1.c
new file mode 100644
index 00000000000..d33acc6feef
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/allocate-1.c
@@ -0,0 +1,7 @@
+#include <stdint.h>
+
+int
+is_64bit_aligned_ (uintptr_t a)
+{
+  return ( (a & 0x3f) == 0);
+}
diff --git a/libgomp/testsuite/libgomp.fortran/allocate-1.f90 b/libgomp/testsuite/libgomp.fortran/allocate-1.f90
new file mode 100644
index 00000000000..35d1750b878
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/allocate-1.f90
@@ -0,0 +1,333 @@
+! { dg-do run }
+! { dg-additional-sources allocate-1.c }
+! { dg-prune-output "command-line option '-fintrinsic-modules-path=.*' is valid for Fortran but not for C" }
+
+module m
+  use omp_lib
+  use iso_c_binding
+  implicit none
+
+  interface
+    integer(c_int) function is_64bit_aligned (a) bind(C)
+      import :: c_int
+      integer  :: a
+    end
+  end interface
+end module m
+
+subroutine foo (x, p, q, px, h, fl)
+  use omp_lib
+  use iso_c_binding
+  integer  :: x
+  integer, dimension(4) :: p
+  integer, dimension(4) :: q
+  integer  :: px
+  integer (kind=omp_allocator_handle_kind) :: h
+  integer  :: fl
+
+  integer  :: y
+  integer  :: r, i, i1, i2, i3, i4, i5
+  integer  :: l, l3, l4, l5, l6
+  integer  :: n, n1, n2, n3, n4
+  integer  :: j2, j3, j4
+  integer, dimension(4) :: l2
+  integer, dimension(4) :: r2
+  integer, target  :: xo
+  integer, target  :: yo
+  integer, dimension(x) :: v
+  integer, dimension(x) :: w
+
+  type s_type
+    integer      :: a
+    integer      :: b
+  end type
+
+  type (s_type) :: s
+  s%a = 27
+  s%b = 29
+  y = 0
+  r = 0
+  n = 8
+  n2 = 9
+  n3 = 10
+  n4 = 11
+  xo = x
+  yo = y
+
+  do i = 1, 4
+    r2(i) = 0;
+  end do
+
+  do i = 1, 4
+    p(i) = 0;
+  end do
+
+  do i = 1, 4
+    q(i) = 0;
+  end do
+
+  do i = 1, x
+    w(i) = i
+  end do
+
+  !$omp parallel private (y, v) firstprivate (x) allocate (x, y, v)
+  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
+  !$omp barrier
+  if (x /= 43 .or. y /= 1) then
+    stop 3
+  end if
+  if (v(1) /= 7 .or. v(41) /= 8) then
+    stop 4
+  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
+    stop 5
+  end if
+  !$omp barrier
+  y = 1;
+  x = x + 1
+  w(19) = w(19) + 1
+  !$omp barrier
+  if (x /= 43 .or. y /= 1 .or. w(19) /= 20) then
+    stop 6
+  end if
+  if ( (and(fl, 1) /= 0) .and.          &
+       ((is_64bit_aligned(x) == 0) .or. &
+        (is_64bit_aligned(y) == 0) .or. &
+        (is_64bit_aligned(w(1)) == 0))) then
+    stop 7
+  end if
+  !$omp end parallel
+  !$omp end teams
+
+  !$omp parallel do private (y) firstprivate (x)  reduction(+: r) allocate (h: x, y, r, l, n) lastprivate (l)  linear (n: 16)
+  do i = 0, 63
+    if (x /= 42) then
+      stop 8
+    end if
+    y = 1;
+    l = i;
+    n = n + y + 15;
+    r = r + i;
+    if ( (and(fl, 1) /= 0) .and.          &
+         ((is_64bit_aligned(x) == 0) .or. &
+          (is_64bit_aligned(y) == 0) .or. &
+          (is_64bit_aligned(r) == 0) .or. &
+          (is_64bit_aligned(l) == 0) .or. &
+          (is_64bit_aligned(n) == 0))) then
+      stop 9
+    end if
+  end do
+  !$omp end parallel do
+
+  !$omp parallel
+    !$omp do lastprivate (l2) private (i1) allocate (h: l2, l3, i1) lastprivate (conditional: l3)
+    do i1 = 0, 63
+      l2(1) = i1
+      l2(2) = i1 + 1
+      l2(3) = i1 + 2
+      l2(4) = i1 + 3
+      if (i1 < 37) then
+        l3 = i1
+      end if
+      if ( (and(fl, 1) /= 0) .and.          &
+           ((is_64bit_aligned(l2(1)) == 0) .or. &
+            (is_64bit_aligned(l3) == 0) .or. &
+            (is_64bit_aligned(i1) == 0))) then
+	stop 10
+      end if
+    end do
+
+    !$omp do collapse(2) lastprivate(l4, i2, j2) linear (n2:17) allocate (h: n2, l4, i2, j2)
+    do i2 = 3, 4
+      do j2 = 17, 22, 2
+	n2 = n2 + 17
+	l4 = i2 * 31 + j2
+	if ( (and(fl, 1) /= 0) .and.          &
+	  ((is_64bit_aligned(l4) == 0) .or. &
+	  (is_64bit_aligned(n2) == 0) .or. &
+	  (is_64bit_aligned(i2) == 0) .or. &
+	  (is_64bit_aligned(j2) == 0))) then
+	  stop 11
+	end if
+      end do
+    end do
+
+    !$omp do collapse(2) lastprivate(l5, i3, j3) linear (n3:17) schedule (static, 3) allocate (n3, l5, i3, j3)
+    do i3 = 3, 4
+      do j3 = 17, 22, 2
+	  n3 = n3 + 17
+	  l5 = i3 * 31 + j3
+	  if ( (and(fl, 2) /= 0) .and.      &
+	  ((is_64bit_aligned(l5) == 0) .or. &
+	  (is_64bit_aligned(n3) == 0) .or. &
+	  (is_64bit_aligned(i3) == 0) .or. &
+	  (is_64bit_aligned(j3) == 0))) then
+	  stop 12
+	end if
+      end do
+    end do
+
+    !$omp do collapse(2) lastprivate(l6, i4, j4) linear (n4:17) schedule (dynamic) allocate (h: n4, l6, i4, j4)
+    do i4 = 3, 4
+      do j4 = 17, 22,2
+	  n4 = n4 + 17;
+	  l6 = i4 * 31 + j4;
+	if ( (and(fl, 1) /= 0) .and.          &
+	  ((is_64bit_aligned(l6) == 0) .or. &
+	  (is_64bit_aligned(n4) == 0) .or. &
+	  (is_64bit_aligned(i4) == 0) .or. &
+	  (is_64bit_aligned(j4) == 0))) then
+	  stop 13
+	end if
+      end do
+    end do
+
+    !$omp do lastprivate (i5) allocate (i5)
+    do i5 = 1, 17, 3
+      if ( (and(fl, 2) /= 0) .and.          &
+	   (is_64bit_aligned(i5) == 0)) then
+	stop 14
+      end if
+    end do
+
+    !$omp do reduction(+:p, q, r2) allocate(h: p, q, r2)
+    do i = 0, 31
+	p(3) = p(3) +  i;
+	p(4) = p(4) + (2 * i)
+	q(1) = q(1) + (3 * i)
+	q(3) = q(3) + (4 * i)
+	r2(1) = r2(1) + (5 * i)
+	r2(4) = r2(4) + (6 * i)
+	if ( (and(fl, 1) /= 0) .and.          &
+	  ((is_64bit_aligned(q(1)) == 0) .or. &
+	  (is_64bit_aligned(p(1)) == 0) .or. &
+	  (is_64bit_aligned(r2(1)) == 0) )) then
+	  stop 15
+	end if
+    end do
+
+    !$omp task private(y) firstprivate(x) allocate(x, y)
+    if (x /= 42) then
+      stop 16
+    end if
+
+    if ( (and(fl, 2) /= 0) .and.          &
+      ((is_64bit_aligned(x) == 0) .or. &
+      (is_64bit_aligned(y) == 0) )) then
+      stop 17
+    end if
+    !$omp end task
+
+    !$omp task private(y) firstprivate(x) allocate(h: x, y)
+    if (x /= 42) then
+      stop 16
+    end if
+
+    if ( (and(fl, 1) /= 0) .and.          &
+      ((is_64bit_aligned(x) == 0) .or. &
+      (is_64bit_aligned(y) == 0) )) then
+      stop 17
+    end if
+    !$omp end task
+
+    !$omp task private(y) firstprivate(s) allocate(s, y)
+    if (s%a /= 27 .or. s%b /= 29) then
+      stop 18
+    end if
+
+    if ( (and(fl, 2) /= 0) .and.          &
+      ((is_64bit_aligned(s%a) == 0) .or. &
+      (is_64bit_aligned(y) == 0) )) then
+      stop 19
+    end if
+    !$omp end task
+
+    !$omp task private(y) firstprivate(s) allocate(h: s, y)
+    if (s%a /= 27 .or. s%b /= 29) then
+      stop 18
+    end if
+
+    if ( (and(fl, 1) /= 0) .and.          &
+      ((is_64bit_aligned(s%a) == 0) .or. &
+      (is_64bit_aligned(y) == 0) )) then
+      stop 19
+    end if
+    !$omp end task
+
+  !$omp end parallel
+
+  if (r /= ((64 * 63) / 2) .or. l /= 63 .or. n /= (8 + 16 * 64)) then
+    stop 20
+  end if
+
+  if (l2(1) /= 63 .or. l2(2) /= 64 .or. l2(3) /= 65 .or. l2(4) /= 66 .or. l3 /= 36) then
+    stop 21
+  end if
+
+  if (i2 /= 5 .or. j2 /= 23 .or. n2 /= (9 + (17 * 6)) .or. l4 /= (4 * 31 + 21)) then
+    stop 22
+  end if
+
+  if (i3 /= 5 .or. j3 /= 23 .or. n3 /= (10 + (17 * 6))  .or. l5 /= (4 * 31 + 21)) then
+    stop 23
+  end if
+
+  if (i4 /= 5 .or. j4 /= 23 .or. n4 /= (11 + (17 * 6))  .or. l6 /= (4 * 31 + 21)) then
+    stop 24
+  end if
+
+  if (i5 /= 19) then
+    stop 24
+  end if
+
+  if (p(3) /= ((32 * 31) / 2) .or. p(4) /= (2 * p(3))         &
+      .or. q(1) /= (3 * p(3)) .or. q(3) /= (4 * p(3))         &
+      .or. r2(1) /= (5 * p(3)) .or. r2(4) /= (6 * p(3))) then
+    stop 25
+  end if
+
+end subroutine
+
+program main
+  use omp_lib
+  integer, dimension(4) :: p
+  integer, dimension(4) :: q
+
+  type (omp_alloctrait) :: traits(3)
+  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)
+  if (a == omp_null_allocator) stop 1
+
+  call omp_set_default_allocator (omp_default_mem_alloc);
+  call foo (42, p, q, 2, a, 0);
+  call foo (42, p, q, 2, omp_default_mem_alloc, 0);
+  call foo (42, p, q, 2, a, 1);
+  call omp_set_default_allocator (a);
+  call foo (42, p, q, 2, omp_null_allocator, 3);
+  call foo (42, p, q, 2, omp_default_mem_alloc, 2);
+  call omp_destroy_allocator (a);
+end