Translate allocate directive (OpenMP 5.0).

Backport of a patch posted at
https://gcc.gnu.org/pipermail/gcc-patches/2022-January/588369.html

gcc/fortran/ChangeLog:

	* trans-openmp.c (gfc_trans_omp_clauses): Handle OMP_LIST_ALLOCATOR.
	(gfc_trans_omp_allocate): New function.
	(gfc_trans_omp_directive): Handle EXEC_OMP_ALLOCATE.

gcc/ChangeLog:

	* tree-pretty-print.c (dump_omp_clause): Handle OMP_CLAUSE_ALLOCATOR.
	(dump_generic_node): Handle OMP_ALLOCATE.
	* tree.def (OMP_ALLOCATE): New.
	* tree.h (OMP_ALLOCATE_CLAUSES): Likewise.
	(OMP_ALLOCATE_DECL): Likewise.
	(OMP_ALLOCATE_ALLOCATOR): Likewise.
	* tree.c (omp_clause_num_ops): Add entry for OMP_CLAUSE_ALLOCATOR.

gcc/testsuite/ChangeLog:

	* gfortran.dg/gomp/allocate-6.f90: New test.

10 files changed, 184 insertions, 1 deletions

diff --git a/gcc/ChangeLog.omp b/gcc/ChangeLog.omp
index 77c8f39..ffd4881 100644
--- a/gcc/ChangeLog.omp
+++ b/gcc/ChangeLog.omp
@@ -1,3 +1,16 @@
+2022-03-09  Abid Qadeer  <abidh@codesourcery.com>
+
+	Backport of a patch posted at
+	https://gcc.gnu.org/pipermail/gcc-patches/2022-January/588369.html
+
+	* tree-pretty-print.c (dump_omp_clause): Handle OMP_CLAUSE_ALLOCATOR.
+	(dump_generic_node): Handle OMP_ALLOCATE.
+	* tree.def (OMP_ALLOCATE): New.
+	* tree.h (OMP_ALLOCATE_CLAUSES): Likewise.
+	(OMP_ALLOCATE_DECL): Likewise.
+	(OMP_ALLOCATE_ALLOCATOR): Likewise.
+	* tree.c (omp_clause_num_ops): Add entry for OMP_CLAUSE_ALLOCATOR.
+
 2022-03-08  Abid Qadeer  <abidh@codesourcery.com>
 
 	* omp-low.c (omp_maybe_offloaded_ctx): New prototype.
diff --git a/gcc/fortran/ChangeLog.omp b/gcc/fortran/ChangeLog.omp
index a3fe0b7..df3d17f 100644
--- a/gcc/fortran/ChangeLog.omp
+++ b/gcc/fortran/ChangeLog.omp
@@ -1,6 +1,15 @@
 2022-03-09  Abid Qadeer  <abidh@codesourcery.com>
 
 	Backport of a patch posted at
+	https://gcc.gnu.org/pipermail/gcc-patches/2022-January/588369.html
+
+	* trans-openmp.c (gfc_trans_omp_clauses): Handle OMP_LIST_ALLOCATOR.
+	(gfc_trans_omp_allocate): New function.
+	(gfc_trans_omp_directive): Handle EXEC_OMP_ALLOCATE.
+
+2022-03-09  Abid Qadeer  <abidh@codesourcery.com>
+
+	Backport of a patch posted at
 	https://gcc.gnu.org/pipermail/gcc-patches/2022-January/588368.html
 
 	* dump-parse-tree.c (show_omp_node): Handle EXEC_OMP_ALLOCATE.
diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index 6e225c6..36787c2 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -4036,6 +4036,28 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 		  }
 	      }
 	  break;
+	case OMP_LIST_ALLOCATOR:
+	  for (; n != NULL; n = n->next)
+	    if (n->sym->attr.referenced)
+	      {
+		tree t = gfc_trans_omp_variable (n->sym, false);
+		if (t != error_mark_node)
+		  {
+		    tree node = build_omp_clause (input_location,
+						  OMP_CLAUSE_ALLOCATOR);
+		    OMP_ALLOCATE_DECL (node) = t;
+		    if (n->expr)
+		      {
+			tree allocator_;
+			gfc_init_se (&se, NULL);
+			gfc_conv_expr (&se, n->expr);
+			allocator_ = gfc_evaluate_now (se.expr, block);
+			OMP_ALLOCATE_ALLOCATOR (node) = allocator_;
+		      }
+		    omp_clauses = gfc_trans_add_clause (node, omp_clauses);
+		  }
+	      }
+	  break;
 	case OMP_LIST_LINEAR:
 	  {
 	    gfc_expr *last_step_expr = NULL;
@@ -6374,6 +6396,26 @@ gfc_trans_omp_atomic (gfc_code *code)
 }
 
 static tree
+gfc_trans_omp_allocate (gfc_code *code)
+{
+  stmtblock_t block;
+  tree stmt;
+
+  gfc_omp_clauses *clauses = code->ext.omp_clauses;
+  gcc_assert (clauses);
+
+  gfc_start_block (&block);
+  stmt = make_node (OMP_ALLOCATE);
+  TREE_TYPE (stmt) = void_type_node;
+  OMP_ALLOCATE_CLAUSES (stmt) = gfc_trans_omp_clauses (&block, clauses,
+						       code->loc, false,
+						       true);
+  gfc_add_expr_to_block (&block, stmt);
+  gfc_merge_block_scope (&block);
+  return gfc_finish_block (&block);
+}
+
+static tree
 gfc_trans_omp_barrier (void)
 {
   tree decl = builtin_decl_explicit (BUILT_IN_GOMP_BARRIER);
@@ -8907,6 +8949,8 @@ gfc_trans_omp_directive (gfc_code *code)
 {
   switch (code->op)
     {
+    case EXEC_OMP_ALLOCATE:
+      return gfc_trans_omp_allocate (code);
     case EXEC_OMP_ATOMIC:
       return gfc_trans_omp_atomic (code);
     case EXEC_OMP_BARRIER:
diff --git a/gcc/testsuite/ChangeLog.omp b/gcc/testsuite/ChangeLog.omp
index 9cfcd64..ae8c018 100644
--- a/gcc/testsuite/ChangeLog.omp
+++ b/gcc/testsuite/ChangeLog.omp
@@ -1,6 +1,13 @@
 2022-03-09  Abid Qadeer  <abidh@codesourcery.com>
 
 	Backport of a patch posted at
+	https://gcc.gnu.org/pipermail/gcc-patches/2022-January/588369.html
+
+	* gfortran.dg/gomp/allocate-6.f90: New test.
+
+2022-03-09  Abid Qadeer  <abidh@codesourcery.com>
+
+	Backport of a patch posted at
 	https://gcc.gnu.org/pipermail/gcc-patches/2022-January/588368.html
 
 	* gfortran.dg/gomp/allocate-4.f90: New test.
diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-6.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-6.f90
new file mode 100644
index 0000000..2de2b52
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/allocate-6.f90
@@ -0,0 +1,72 @@
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-original" }
+
+module omp_lib_kinds
+  use iso_c_binding, only: c_int, c_intptr_t
+  implicit none
+  private :: c_int, c_intptr_t
+  integer, parameter :: omp_allocator_handle_kind = c_intptr_t
+
+  integer (kind=omp_allocator_handle_kind), &
+     parameter :: omp_null_allocator = 0
+  integer (kind=omp_allocator_handle_kind), &
+     parameter :: omp_default_mem_alloc = 1
+  integer (kind=omp_allocator_handle_kind), &
+     parameter :: omp_large_cap_mem_alloc = 2
+  integer (kind=omp_allocator_handle_kind), &
+     parameter :: omp_const_mem_alloc = 3
+  integer (kind=omp_allocator_handle_kind), &
+     parameter :: omp_high_bw_mem_alloc = 4
+  integer (kind=omp_allocator_handle_kind), &
+     parameter :: omp_low_lat_mem_alloc = 5
+  integer (kind=omp_allocator_handle_kind), &
+     parameter :: omp_cgroup_mem_alloc = 6
+  integer (kind=omp_allocator_handle_kind), &
+     parameter :: omp_pteam_mem_alloc = 7
+  integer (kind=omp_allocator_handle_kind), &
+     parameter :: omp_thread_mem_alloc = 8
+end module
+
+
+subroutine foo(x, y, al)
+  use omp_lib_kinds
+  implicit none
+  
+type :: my_type
+  integer :: i
+  integer :: j
+  real :: x
+end type
+
+  integer  :: x
+  integer  :: y
+  integer (kind=omp_allocator_handle_kind) :: al
+
+  integer, allocatable :: var1
+  integer, allocatable :: var2
+  real, allocatable :: var3(:,:)
+  type (my_type), allocatable :: var4
+  integer, pointer :: pii, parr(:)
+
+  character, allocatable :: str1a, str1aarr(:) 
+  character(len=5), allocatable :: str5a, str5aarr(:)
+  
+  !$omp allocate
+  allocate(str1a, str1aarr(10), str5a, str5aarr(10))
+
+  !$omp allocate (var1) allocator(omp_default_mem_alloc)
+  !$omp allocate (var2) allocator(omp_large_cap_mem_alloc)
+  allocate (var1, var2)
+
+  !$omp allocate (var4)  allocator(omp_low_lat_mem_alloc)
+  allocate (var4)
+  var4%i = 5
+
+  !$omp allocate (var3)  allocator(omp_low_lat_mem_alloc)
+  allocate (var3(x,y))
+
+  !$omp allocate
+  allocate(pii, parr(5))
+end subroutine
+
+! { dg-final { scan-tree-dump-times "#pragma omp allocate" 6 "original" } }
diff --git a/gcc/tree-core.h b/gcc/tree-core.h
index 162c25d..e2c641f 100644
--- a/gcc/tree-core.h
+++ b/gcc/tree-core.h
@@ -513,7 +513,10 @@ enum omp_clause_code {
   OMP_CLAUSE_IF_PRESENT,
 
   /* OpenACC clause: finalize.  */
-  OMP_CLAUSE_FINALIZE
+  OMP_CLAUSE_FINALIZE,
+
+  /* OpenMP clause: allocator.  */
+  OMP_CLAUSE_ALLOCATOR
 };
 
 #undef DEFTREESTRUCT
diff --git a/gcc/tree-pretty-print.c b/gcc/tree-pretty-print.c
index f41587f..dfc7624 100644
--- a/gcc/tree-pretty-print.c
+++ b/gcc/tree-pretty-print.c
@@ -731,6 +731,20 @@ dump_omp_clause (pretty_printer *pp, tree clause, int spc, dump_flags_t flags)
       pp_right_paren (pp);
       break;
 
+    case OMP_CLAUSE_ALLOCATOR:
+      pp_string (pp, "(");
+      dump_generic_node (pp, OMP_ALLOCATE_DECL (clause),
+			 spc, flags, false);
+      if (OMP_ALLOCATE_ALLOCATOR (clause))
+	{
+	  pp_string (pp, ":allocator(");
+	  dump_generic_node (pp, OMP_ALLOCATE_ALLOCATOR (clause),
+			     spc, flags, false);
+	  pp_right_paren (pp);
+	}
+      pp_right_paren (pp);
+      break;
+
     case OMP_CLAUSE_ALLOCATE:
       pp_string (pp, "allocate(");
       if (OMP_CLAUSE_ALLOCATE_ALLOCATOR (clause))
@@ -3522,6 +3536,11 @@ dump_generic_node (pretty_printer *pp, tree node, int spc, dump_flags_t flags,
       dump_omp_clauses (pp, OACC_CACHE_CLAUSES (node), spc, flags);
       break;
 
+    case OMP_ALLOCATE:
+      pp_string (pp, "#pragma omp allocate ");
+      dump_omp_clauses (pp, OMP_ALLOCATE_CLAUSES (node), spc, flags);
+      break;
+
     case OMP_PARALLEL:
       pp_string (pp, "#pragma omp parallel");
       dump_omp_clauses (pp, OMP_PARALLEL_CLAUSES (node), spc, flags);
diff --git a/gcc/tree.c b/gcc/tree.c
index 9146d3e..26830f4 100644
--- a/gcc/tree.c
+++ b/gcc/tree.c
@@ -364,6 +364,7 @@ unsigned const char omp_clause_num_ops[] =
   3, /* OMP_CLAUSE_TILE  */
   0, /* OMP_CLAUSE_IF_PRESENT */
   0, /* OMP_CLAUSE_FINALIZE */
+  2, /* OMP_CLAUSE_ALLOCATOR */
 };
 
 const char * const omp_clause_code_name[] =
diff --git a/gcc/tree.def b/gcc/tree.def
index 91f8c4d..ec80d52 100644
--- a/gcc/tree.def
+++ b/gcc/tree.def
@@ -1306,6 +1306,10 @@ DEFTREECODE (OMP_ATOMIC_READ, "omp_atomic_read", tcc_statement, 1)
 DEFTREECODE (OMP_ATOMIC_CAPTURE_OLD, "omp_atomic_capture_old", tcc_statement, 2)
 DEFTREECODE (OMP_ATOMIC_CAPTURE_NEW, "omp_atomic_capture_new", tcc_statement, 2)
 
+/* OpenMP - #pragma omp allocate
+   Operand 0: Clauses.  */
+DEFTREECODE (OMP_ALLOCATE, "omp allocate", tcc_statement, 1)
+
 /* OpenMP clauses.  */
 DEFTREECODE (OMP_CLAUSE, "omp_clause", tcc_exceptional, 0)
 
diff --git a/gcc/tree.h b/gcc/tree.h
index 6b63e2e..57fa201 100644
--- a/gcc/tree.h
+++ b/gcc/tree.h
@@ -1399,6 +1399,8 @@ class auto_suppress_location_wrappers
 #define OACC_UPDATE_CLAUSES(NODE) \
   TREE_OPERAND (OACC_UPDATE_CHECK (NODE), 0)
 
+#define OMP_ALLOCATE_CLAUSES(NODE) TREE_OPERAND (OMP_ALLOCATE_CHECK (NODE), 0)
+
 #define OMP_PARALLEL_BODY(NODE)    TREE_OPERAND (OMP_PARALLEL_CHECK (NODE), 0)
 #define OMP_PARALLEL_CLAUSES(NODE) TREE_OPERAND (OMP_PARALLEL_CHECK (NODE), 1)
 
@@ -1811,6 +1813,15 @@ class auto_suppress_location_wrappers
 #define OMP_CLAUSE_ALLOCATE_ALIGN(NODE) \
   OMP_CLAUSE_OPERAND (OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_ALLOCATE), 2)
 
+/* May be we can use OMP_CLAUSE_DECL but the I am not sure where to place
+   OMP_CLAUSE_ALLOCATOR in omp_clause_code.  */
+
+#define OMP_ALLOCATE_DECL(NODE) \
+  OMP_CLAUSE_OPERAND (OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_ALLOCATOR), 0)
+
+#define OMP_ALLOCATE_ALLOCATOR(NODE) \
+  OMP_CLAUSE_OPERAND (OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_ALLOCATOR), 1)
+
 /* True if an ALLOCATE clause was present on a combined or composite
    construct and the code for splitting the clauses has already performed
    checking if the listed variable has explicit privatization on the