commit 89d0f082b3c95f68d116d4480126e3ab7fb7f36b
Author: Tobias Burnus <tobias@codesourcery.com>
Date:   Mon Jul 17 15:13:44 2023 +0200

    OpenMP/Fortran: Parsing support for 'uses_allocators'
    
    The 'uses_allocators' clause to the 'target' construct accepts predefined
    allocators and can also be used to define a new allocator for a target region.
    As predefined allocators in GCC do not require special handling, those can and
    are ignored after parsing, such that this feature now works. On the other hand,
    defining a new allocator will fail for now with a 'sorry, unimplemented'.
    
    Note that both the OpenMP 5.0/5.1 and 5.2 syntax for uses_allocators
    is supported by this commit.
    
    2023-07-17  Tobias Burnus  <tobias@codesoucery.com>
                Chung-Lin Tang  <cltang@codesourcery.com>
    
    gcc/fortran/ChangeLog:
    
            * dump-parse-tree.cc (show_omp_namelist, show_omp_clauses): Dump
            uses_allocators clause.
            * gfortran.h (gfc_free_omp_namelist): Add memspace_sym to u union
            and traits_sym to u2 union.
            (OMP_LIST_USES_ALLOCATORS): New enum value.
            (gfc_free_omp_namelist): Add 'bool free_mem_traits_space' arg.
            * match.cc (gfc_free_omp_namelist): Likewise.
            * openmp.cc (gfc_free_omp_clauses, gfc_match_omp_variable_list,
            gfc_match_omp_to_link, gfc_match_omp_doacross_sink,
            gfc_match_omp_clause_reduction, gfc_match_omp_allocate,
            gfc_match_omp_flush): Update call.
            (gfc_match_omp_clauses): Likewise. Parse uses_allocators clause.
            (gfc_match_omp_clause_uses_allocators): New.
            (enum omp_mask2): Add new OMP_CLAUSE_USES_ALLOCATORS.
            (OMP_TARGET_CLAUSES): Accept it.
            (resolve_omp_clauses): Resolve uses_allocators clause
            * st.cc (gfc_free_statement): Update gfc_free_omp_namelist call.
            * trans-openmp.cc (gfc_trans_omp_clauses): Handle
            OMP_LIST_USES_ALLOCATORS; fail with sorry unless predefined allocator.
            (gfc_split_omp_clauses): Handle uses_allocators.
    
    libgomp/ChangeLog:
    
            * testsuite/libgomp.fortran/uses_allocators_1.f90: New test.
            * testsuite/libgomp.fortran/uses_allocators_2.f90: New test.
    
    Co-authored-by: Chung-Lin Tang <cltang@codesourcery.com>
---
 gcc/fortran/dump-parse-tree.cc                     |  24 +++
 gcc/fortran/gfortran.h                             |   5 +-
 gcc/fortran/match.cc                               |   7 +-
 gcc/fortran/openmp.cc                              | 194 +++++++++++++++++++--
 gcc/fortran/st.cc                                  |   2 +-
 gcc/fortran/trans-openmp.cc                        |  11 ++
 .../libgomp.fortran/uses_allocators_1.f90          | 168 ++++++++++++++++++
 .../libgomp.fortran/uses_allocators_2.f90          |  99 +++++++++++
 8 files changed, 491 insertions(+), 19 deletions(-)

diff --git a/gcc/fortran/dump-parse-tree.cc b/gcc/fortran/dump-parse-tree.cc
index effcebe9325..68122e3e6fd 100644
--- a/gcc/fortran/dump-parse-tree.cc
+++ b/gcc/fortran/dump-parse-tree.cc
@@ -1497,6 +1497,29 @@ show_omp_namelist (int list_type, gfc_omp_namelist *n)
 	  case OMP_LINEAR_UVAL: fputs ("uval(", dumpfile); break;
 	  default: break;
 	  }
+      else if (list_type == OMP_LIST_USES_ALLOCATORS)
+	{
+	  if (n->u.memspace_sym)
+	    {
+	      fputs ("memspace(", dumpfile);
+	      fputs (n->sym->name, dumpfile);
+	      fputc (')', dumpfile);
+	    }
+	  if (n->u.memspace_sym && n->u2.traits_sym)
+	    fputc (',', dumpfile);
+	  if (n->u2.traits_sym)
+	    {
+	      fputs ("traits(", dumpfile);
+	      fputs (n->u2.traits_sym->name, dumpfile);
+	      fputc (')', dumpfile);
+	    }
+	  if (n->u.memspace_sym || n->u2.traits_sym)
+	    fputc (':', dumpfile);
+	  fputs (n->sym->name, dumpfile);
+	  if (n->next)
+	    fputs (", ", dumpfile);
+	  continue;
+	}
       fprintf (dumpfile, "%s", n->sym ? n->sym->name : "omp_all_memory");
       if (list_type == OMP_LIST_LINEAR && n->u.linear.op != OMP_LINEAR_DEFAULT)
 	fputc (')', dumpfile);
@@ -1799,6 +1822,7 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses)
 	  case OMP_LIST_ALLOCATE: type = "ALLOCATE"; break;
 	  case OMP_LIST_SCAN_IN: type = "INCLUSIVE"; break;
 	  case OMP_LIST_SCAN_EX: type = "EXCLUSIVE"; break;
+	  case OMP_LIST_USES_ALLOCATORS: type = "USES_ALLOCATORS"; break;
 	  default:
 	    gcc_unreachable ();
 	  }
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 74466c7f04c..6482a885211 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1368,6 +1368,7 @@ typedef struct gfc_omp_namelist
 	  bool old_modifier;
 	} linear;
       struct gfc_common_head *common;
+      struct gfc_symbol *memspace_sym;
       bool lastprivate_conditional;
       bool present_modifier;
     } u;
@@ -1376,6 +1377,7 @@ typedef struct gfc_omp_namelist
       struct gfc_omp_namelist_udr *udr;
       gfc_namespace *ns;
       gfc_expr *allocator;
+      struct gfc_symbol *traits_sym;
     } u2;
   struct gfc_omp_namelist *next;
   locus where;
@@ -1419,6 +1421,7 @@ enum
   OMP_LIST_ALLOCATE,
   OMP_LIST_HAS_DEVICE_ADDR,
   OMP_LIST_ENTER,
+  OMP_LIST_USES_ALLOCATORS,
   OMP_LIST_NUM /* Must be the last.  */
 };
 
@@ -3600,7 +3603,7 @@ void gfc_free_iterator (gfc_iterator *, int);
 void gfc_free_forall_iterator (gfc_forall_iterator *);
 void gfc_free_alloc_list (gfc_alloc *);
 void gfc_free_namelist (gfc_namelist *);
-void gfc_free_omp_namelist (gfc_omp_namelist *, bool, bool);
+void gfc_free_omp_namelist (gfc_omp_namelist *, bool, bool, bool);
 void gfc_free_equiv (gfc_equiv *);
 void gfc_free_equiv_until (gfc_equiv *, gfc_equiv *);
 void gfc_free_data (gfc_data *);
diff --git a/gcc/fortran/match.cc b/gcc/fortran/match.cc
index 7335d98f222..ba23bcd9692 100644
--- a/gcc/fortran/match.cc
+++ b/gcc/fortran/match.cc
@@ -5537,7 +5537,8 @@ gfc_free_namelist (gfc_namelist *name)
 
 void
 gfc_free_omp_namelist (gfc_omp_namelist *name, bool free_ns,
-		       bool free_align_allocator)
+		       bool free_align_allocator,
+		       bool free_mem_traits_space)
 {
   gfc_omp_namelist *n;
 
@@ -5546,10 +5547,14 @@ gfc_free_omp_namelist (gfc_omp_namelist *name, bool free_ns,
       gfc_free_expr (name->expr);
       if (free_align_allocator)
 	gfc_free_expr (name->u.align);
+      else if (free_mem_traits_space)
+	{ }  /* name->u.memspace_sym: shall not call gfc_free_symbol here. */
       if (free_ns)
 	gfc_free_namespace (name->u2.ns);
       else if (free_align_allocator)
 	gfc_free_expr (name->u2.allocator);
+      else if (free_mem_traits_space)
+	{ }  /* name->u2.traits_sym: shall not call gfc_free_symbol here. */
       else if (name->u2.udr)
 	{
 	  if (name->u2.udr->combiner)
diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc
index 8efc4b3ecfa..05a697da071 100644
--- a/gcc/fortran/openmp.cc
+++ b/gcc/fortran/openmp.cc
@@ -188,7 +188,8 @@ gfc_free_omp_clauses (gfc_omp_clauses *c)
   for (i = 0; i < OMP_LIST_NUM; i++)
     gfc_free_omp_namelist (c->lists[i],
 			   i == OMP_LIST_AFFINITY || i == OMP_LIST_DEPEND,
-			   i == OMP_LIST_ALLOCATE);
+			   i == OMP_LIST_ALLOCATE,
+			   i == OMP_LIST_USES_ALLOCATORS);
   gfc_free_expr_list (c->wait_list);
   gfc_free_expr_list (c->tile_list);
   free (CONST_CAST (char *, c->critical_name));
@@ -553,7 +554,7 @@ syntax:
   gfc_error ("Syntax error in OpenMP variable list at %C");
 
 cleanup:
-  gfc_free_omp_namelist (head, false, false);
+  gfc_free_omp_namelist (head, false, false, false);
   gfc_current_locus = old_loc;
   return MATCH_ERROR;
 }
@@ -643,7 +644,7 @@ syntax:
   gfc_error ("Syntax error in OpenMP variable list at %C");
 
 cleanup:
-  gfc_free_omp_namelist (head, false, false);
+  gfc_free_omp_namelist (head, false, false, false);
   gfc_current_locus = old_loc;
   return MATCH_ERROR;
 }
@@ -752,7 +753,7 @@ syntax:
   gfc_error ("Syntax error in OpenMP SINK dependence-type list at %C");
 
 cleanup:
-  gfc_free_omp_namelist (head, false, false);
+  gfc_free_omp_namelist (head, false, false, false);
   gfc_current_locus = old_loc;
   return MATCH_ERROR;
 }
@@ -1091,6 +1092,7 @@ enum omp_mask2
   OMP_CLAUSE_ENTER, /* OpenMP 5.2 */
   OMP_CLAUSE_DOACROSS, /* OpenMP 5.2 */
   OMP_CLAUSE_ASSUMPTIONS, /* OpenMP 5.1. */
+  OMP_CLAUSE_USES_ALLOCATORS, /* OpenMP 5.0  */
   /* This must come last.  */
   OMP_MASK2_LAST
 };
@@ -1502,7 +1504,7 @@ gfc_match_omp_clause_reduction (char pc, gfc_omp_clauses *c, bool openacc,
       *head = NULL;
       gfc_error_now ("!$OMP DECLARE REDUCTION %s not found at %L",
 		     buffer, &old_loc);
-      gfc_free_omp_namelist (n, false, false);
+      gfc_free_omp_namelist (n, false, false, false);
     }
   else
     for (n = *head; n; n = n->next)
@@ -1697,6 +1699,106 @@ omp_verify_merge_absent_contains (gfc_statement st, gfc_omp_assumptions *check,
   return MATCH_YES;
 }
 
+/* OpenMP 5.0
+   uses_allocators ( allocator-list )
+
+   allocator:
+     predefined-allocator
+     variable ( traits-array )
+
+   OpenMP 5.2:
+   uses_allocators ( [modifier-list :] allocator-list )
+
+   allocator:
+     variable or predefined-allocator
+   modifier:
+     traits ( traits-array )
+     memspace ( mem-space-handle )  */
+
+static match
+gfc_match_omp_clause_uses_allocators (gfc_omp_clauses *c)
+{
+  gfc_symbol *memspace_sym = NULL;
+  gfc_symbol *traits_sym = NULL;
+  gfc_omp_namelist *head = NULL;
+  gfc_omp_namelist *p, *tail, **list;
+  int ntraits, nmemspace;
+  bool has_modifiers;
+  locus old_loc, cur_loc;
+
+  gfc_gobble_whitespace ();
+  old_loc = gfc_current_locus;
+  ntraits = nmemspace = 0;
+  do
+    {
+      cur_loc = gfc_current_locus;
+      if (gfc_match ("traits ( %S ) ", &traits_sym) == MATCH_YES)
+	ntraits++;
+      else if (gfc_match ("memspace ( %S ) ", &memspace_sym) == MATCH_YES)
+	nmemspace++;
+      if (ntraits > 1 || nmemspace > 1)
+	{
+	  gfc_error ("Duplicate %s modifier at %L in USES_ALLOCATORS clause",
+		     ntraits > 1 ? "TRAITS" : "MEMSPACE", &cur_loc);
+	  return MATCH_ERROR;
+	}
+      if (gfc_match (", ") == MATCH_YES)
+	continue;
+      if (gfc_match (": ") != MATCH_YES)
+	{
+	  /* Assume no modifier. */
+	  memspace_sym = traits_sym = NULL;
+	  gfc_current_locus = old_loc;
+	  break;
+	}
+      break;
+    } while (true);
+
+  has_modifiers = traits_sym != NULL || memspace_sym != NULL;
+  do
+    {
+      p = gfc_get_omp_namelist ();
+      p->where = gfc_current_locus;
+      if (head == NULL)
+	head = tail = p;
+      else
+	{
+	  tail->next = p;
+	  tail = tail->next;
+	}
+      if (gfc_match ("%S ", &p->sym) != MATCH_YES)
+	goto error;
+      if (!has_modifiers)
+	gfc_match ("( %S ) ", &p->u2.traits_sym);
+      else if (gfc_peek_ascii_char () == '(')
+	{
+	  gfc_error ("Unexpected %<(%> at %C");
+	  goto error;
+	}
+      else
+	{
+	  p->u.memspace_sym = memspace_sym;
+	  p->u2.traits_sym = traits_sym;
+	}
+      if (gfc_match (", ") == MATCH_YES)
+	continue;
+      if (gfc_match (") ") == MATCH_YES)
+	break;
+      goto error;
+    } while (true);
+
+  list = &c->lists[OMP_LIST_USES_ALLOCATORS];
+  while (*list)
+    list = &(*list)->next;
+  *list = head;
+
+  return MATCH_YES;
+
+error:
+  gfc_free_omp_namelist (head, false, false, true);
+  return MATCH_ERROR;
+}
+
 
 /* Match with duplicate check. Matches 'name'. If expr != NULL, it
    then matches '(expr)', otherwise, if open_parens is true,
@@ -1820,7 +1922,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 
 	      if (end_colon && gfc_match (" %e )", &alignment) != MATCH_YES)
 		{
-		  gfc_free_omp_namelist (*head, false, false);
+		  gfc_free_omp_namelist (*head, false, false, false);
 		  gfc_current_locus = old_loc;
 		  *head = NULL;
 		  break;
@@ -2763,7 +2865,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 		    end_colon = true;
 		  else if (gfc_match (" )") != MATCH_YES)
 		    {
-		      gfc_free_omp_namelist (*head, false, false);
+		      gfc_free_omp_namelist (*head, false, false, false);
 		      gfc_current_locus = old_loc;
 		      *head = NULL;
 		      break;
@@ -2774,7 +2876,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 		{
 		  if (gfc_match (" %e )", &step) != MATCH_YES)
 		    {
-		      gfc_free_omp_namelist (*head, false, false);
+		      gfc_free_omp_namelist (*head, false, false, false);
 		      gfc_current_locus = old_loc;
 		      *head = NULL;
 		      goto error;
@@ -2871,7 +2973,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 		    }
 		  if (has_error)
 		    {
-		      gfc_free_omp_namelist (*head, false, false);
+		      gfc_free_omp_namelist (*head, false, false, false);
 		      *head = NULL;
 		      goto error;
 		    }
@@ -3561,6 +3663,13 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 		   ("use_device_addr (", &c->lists[OMP_LIST_USE_DEVICE_ADDR],
 		    false, NULL, NULL, true) == MATCH_YES)
 	    continue;
+	  if ((mask & OMP_CLAUSE_USES_ALLOCATORS)
+	      && (gfc_match ("uses_allocators ( ") == MATCH_YES))
+	    {
+	      if (gfc_match_omp_clause_uses_allocators (c) != MATCH_YES)
+		goto error;
+	      continue;
+	    }
 	  break;
 	case 'v':
 	  /* VECTOR_LENGTH must be matched before VECTOR, because the latter
@@ -4290,7 +4399,7 @@ cleanup:
    | OMP_CLAUSE_FIRSTPRIVATE | OMP_CLAUSE_DEFAULTMAP			\
    | OMP_CLAUSE_IS_DEVICE_PTR | OMP_CLAUSE_IN_REDUCTION			\
    | OMP_CLAUSE_THREAD_LIMIT | OMP_CLAUSE_ALLOCATE			\
-   | OMP_CLAUSE_HAS_DEVICE_ADDR)
+   | OMP_CLAUSE_HAS_DEVICE_ADDR | OMP_CLAUSE_USES_ALLOCATORS)
 #define OMP_TARGET_DATA_CLAUSES \
   (omp_mask (OMP_CLAUSE_DEVICE) | OMP_CLAUSE_MAP | OMP_CLAUSE_IF	\
    | OMP_CLAUSE_USE_DEVICE_PTR | OMP_CLAUSE_USE_DEVICE_ADDR)
@@ -4410,7 +4519,7 @@ gfc_match_omp_allocate (void)
 	  gfc_error ("Unexpected expression as list item at %L in ALLOCATE "
 		     "directive", &n->expr->where);
 
-	gfc_free_omp_namelist (vars, false, true);
+	gfc_free_omp_namelist (vars, false, true, false);
 	goto error;
       }
 
@@ -4814,14 +4923,14 @@ gfc_match_omp_flush (void)
     {
       gfc_error ("List specified together with memory order clause in FLUSH "
 		 "directive at %C");
-      gfc_free_omp_namelist (list, false, false);
+      gfc_free_omp_namelist (list, false, false, false);
       gfc_free_omp_clauses (c);
       return MATCH_ERROR;
     }
   if (gfc_match_omp_eos () != MATCH_YES)
     {
       gfc_error ("Unexpected junk after $OMP FLUSH statement at %C");
-      gfc_free_omp_namelist (list, false, false);
+      gfc_free_omp_namelist (list, false, false, false);
       gfc_free_omp_clauses (c);
       return MATCH_ERROR;
     }
@@ -7229,7 +7338,8 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
 	"IN_REDUCTION", "TASK_REDUCTION",
 	"DEVICE_RESIDENT", "LINK", "USE_DEVICE",
 	"CACHE", "IS_DEVICE_PTR", "USE_DEVICE_PTR", "USE_DEVICE_ADDR",
-	"NONTEMPORAL", "ALLOCATE", "HAS_DEVICE_ADDR", "ENTER" };
+	"NONTEMPORAL", "ALLOCATE", "HAS_DEVICE_ADDR", "ENTER",
+	"USES_ALLOCATORS" };
   STATIC_ASSERT (ARRAY_SIZE (clause_names) == OMP_LIST_NUM);
 
   if (omp_clauses == NULL)
@@ -7495,7 +7605,7 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
 			 " cannot be and need not be mapped", n->sym->name,
 			 &n->where);
 	  }
-	else
+	else if (list != OMP_LIST_USES_ALLOCATORS)
 	  gfc_error ("Object %qs is not a variable at %L", n->sym->name,
 		     &n->where);
       }
@@ -7721,7 +7831,7 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
 		{
 		  prev->next = n->next;
 		  n->next = NULL;
-		  gfc_free_omp_namelist (n, false, true);
+		  gfc_free_omp_namelist (n, false, true, false);
 		  n = prev->next;
 		}
 	      continue;
@@ -8291,6 +8401,58 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
 		n = n->next;
 	      }
 	    break;
+	  case OMP_LIST_USES_ALLOCATORS:
+	    {
+	      if (n != NULL
+		  && n->u.memspace_sym
+		  && (n->u.memspace_sym->attr.flavor != FL_PARAMETER
+		      || n->u.memspace_sym->ts.type != BT_INTEGER
+		      || n->u.memspace_sym->ts.kind != gfc_c_intptr_kind
+		      || n->u.memspace_sym->attr.dimension
+		      || (!startswith (n->u.memspace_sym->name, "omp_")
+			  && !startswith (n->u.memspace_sym->name, "ompx_"))
+		      || !endswith (n->u.memspace_sym->name, "_mem_space")))
+		gfc_error ("Memspace %qs at %L in USES_ALLOCATORS must be "
+			   "a predefined memory space",
+			   n->u.memspace_sym->name, &n->where);
+	      for (; n != NULL; n = n->next)
+		{
+		  if (n->sym->ts.type != BT_INTEGER
+		      || n->sym->ts.kind != gfc_c_intptr_kind
+		      || n->sym->attr.dimension)
+		    gfc_error ("Allocator %qs at %L in USES_ALLOCATORS must "
+			       "be a scalar integer of kind "
+			       "%<omp_allocator_handle_kind%>", n->sym->name,
+			       &n->where);
+		  else if (n->sym->attr.flavor != FL_VARIABLE
+			   && ((!startswith (n->sym->name, "omp_")
+				&& !startswith (n->sym->name, "ompx_"))
+			       || !endswith (n->sym->name, "_mem_alloc")))
+		    gfc_error ("Allocator %qs at %L in USES_ALLOCATORS must "
+			       "either a variable or a predefined allocator",
+			       n->sym->name, &n->where);
+		  else if ((n->u.memspace_sym || n->u2.traits_sym)
+			   && n->sym->attr.flavor != FL_VARIABLE)
+		    gfc_error ("A memory space or traits array may not be "
+			       "specified for predefined allocator %qs at %L",
+			       n->sym->name, &n->where);
+		  if (n->u2.traits_sym
+		      && (n->u2.traits_sym->attr.flavor != FL_PARAMETER
+			  || !n->u2.traits_sym->attr.dimension
+			  || n->u2.traits_sym->as->rank != 1
+			  || n->u2.traits_sym->ts.type != BT_DERIVED
+			  || strcmp (n->u2.traits_sym->ts.u.derived->name,
+				     "omp_alloctrait") != 0))
+		    {
+		      gfc_error ("Traits array %qs in USES_ALLOCATORS %L must "
+				 "be a one-dimensional named constant array of "
+				 "type %<omp_alloctrait%>",
+				 n->u2.traits_sym->name, &n->where);
+		      break;
+		    }
+		}
+	      break;
+	    }
 	  default:
 	    for (; n != NULL; n = n->next)
 	      {
diff --git a/gcc/fortran/st.cc b/gcc/fortran/st.cc
index 55debca8e0b..b6d87c40207 100644
--- a/gcc/fortran/st.cc
+++ b/gcc/fortran/st.cc
@@ -288,7 +288,7 @@ gfc_free_statement (gfc_code *p)
       break;
 
     case EXEC_OMP_FLUSH:
-      gfc_free_omp_namelist (p->ext.omp_namelist, false, false);
+      gfc_free_omp_namelist (p->ext.omp_namelist, false, false, false);
       break;
 
     case EXEC_OMP_BARRIER:
diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc
index 4aa16fa88da..c88ee3c7656 100644
--- a/gcc/fortran/trans-openmp.cc
+++ b/gcc/fortran/trans-openmp.cc
@@ -3923,6 +3923,15 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 	      omp_clauses = gfc_trans_add_clause (node, omp_clauses);
 	    }
 	  break;
+	case OMP_LIST_USES_ALLOCATORS:
+	  /* Ignore pre-defined allocators as no special treatment is needed. */
+	  for (; n != NULL; n = n->next)
+	    if (n->sym->attr.flavor == FL_VARIABLE)
+	      break;
+	  if (n != NULL)
+	    sorry_at (input_location, "%<uses_allocators%> clause with traits "
+				      "and memory spaces");
+	  break;
 	default:
 	  break;
 	}
@@ -6581,6 +6590,8 @@ gfc_split_omp_clauses (gfc_code *code,
 	    = code->ext.omp_clauses->device;
 	  clausesa[GFC_OMP_SPLIT_TARGET].thread_limit
 	    = code->ext.omp_clauses->thread_limit;
+	  clausesa[GFC_OMP_SPLIT_TARGET].lists[OMP_LIST_USES_ALLOCATORS]
+	    = code->ext.omp_clauses->lists[OMP_LIST_USES_ALLOCATORS];
 	  for (int i = 0; i < OMP_DEFAULTMAP_CAT_NUM; i++)
 	    clausesa[GFC_OMP_SPLIT_TARGET].defaultmap[i]
 	      = code->ext.omp_clauses->defaultmap[i];
diff --git a/libgomp/testsuite/libgomp.fortran/uses_allocators_1.f90 b/libgomp/testsuite/libgomp.fortran/uses_allocators_1.f90
new file mode 100644
index 00000000000..66984d98c89
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/uses_allocators_1.f90
@@ -0,0 +1,168 @@
+! { dg-do compile }
+
+subroutine test
+  use omp_lib
+  implicit none
+
+  !$omp target uses_allocators ( omp_default_mem_alloc , omp_large_cap_mem_alloc, &
+  !$omp&                         omp_const_mem_alloc,omp_high_bw_mem_alloc, &
+  !$omp&                         omp_low_lat_mem_alloc ,omp_cgroup_mem_alloc , &
+  !$omp&                         omp_pteam_mem_alloc, omp_thread_mem_alloc )
+  block; end block
+
+  !$omp target uses_allocators(omp_default_mem_alloc, omp_high_bw_mem_alloc) &
+  !$omp&       uses_allocators(omp_high_bw_mem_alloc, omp_low_lat_mem_alloc)  ! { dg-error "Symbol 'omp_high_bw_mem_alloc' present on multiple clauses" }
+  block; end block
+
+  !$omp target firstprivate ( omp_default_mem_alloc ) , uses_allocators &
+  !$omp&                                                 (omp_default_mem_alloc , omp_high_bw_mem_alloc ) &
+  !$omp&       map(to: omp_high_bw_mem_alloc)
+  block; end block
+! { dg-error "Object 'omp_default_mem_alloc' is not a variable" "" { target *-*-* } .-4 }
+! { dg-error "Symbol 'omp_default_mem_alloc' present on both data and map clauses" "" { target *-*-* } .-5 }
+! { dg-error "Symbol 'omp_high_bw_mem_alloc' present on multiple clauses" "" { target *-*-* } .-5 }
+! { dg-error "Object 'omp_high_bw_mem_alloc' is not a variable at .1.; parameters cannot be and need not be mapped" "" { target *-*-* } .-5 }
+end
+
+subroutine non_predef
+  use omp_lib
+  implicit none
+
+  type(omp_alloctrait), parameter :: trait(0) = [omp_alloctrait :: ]
+  type(omp_alloctrait), parameter :: trait2(*) &
+    = [omp_alloctrait (omp_atk_alignment, 16),                    &
+       omp_alloctrait (omp_atk_sync_hint, omp_atv_default),       &
+       omp_alloctrait (omp_atk_access, omp_atv_default)]
+
+  integer(kind=omp_allocator_handle_kind) :: a1, a2, a3
+
+  !$omp target uses_allocators(omp_default_mem_alloc, a1(trait), a2(trait2))
+  block; end block
+
+  !$omp target uses_allocators(omp_default_mem_alloc, a1(trait), omp_cgroup_mem_alloc, a1(trait2)) ! { dg-error "Symbol 'a1' present on multiple clauses" }
+  block; end block
+
+  !$omp target uses_allocators(traits(trait):a1) &
+  !$omp&        uses_allocators ( memspace ( omp_low_lat_mem_space ) , traits ( trait2 ) : a2 , a3)
+  block; end block
+
+  !$omp target uses_allocators ( traits(trait2) , memspace ( omp_low_lat_mem_space ) : a2 , a3)
+  block; end block
+
+  !$omp target firstprivate ( a2 ) , &  ! { dg-error "Symbol 'a2' present on both data and map clauses" }
+  !$omp&       uses_allocators (a2, a3) &  ! { dg-error "Symbol 'a3' present on multiple clauses" }
+  !$omp&       map(to: a3)
+  block; end block
+end subroutine
+
+subroutine duplicate
+  use omp_lib
+  implicit none
+  type(omp_alloctrait), parameter :: trait1(0) = [omp_alloctrait :: ]
+  type(omp_alloctrait), parameter :: trait2(0) = [omp_alloctrait :: ]
+
+  !$omp target uses_allocators(traits(trait1), memspace ( omp_low_lat_mem_space ) , traits ( trait2 ) : bar)  ! { dg-error "Duplicate TRAITS modifier" }
+  block; end block
+
+  !$omp target uses_allocators(traits(trait1), memspace ( omp_low_lat_mem_space ) , memspace (omp_large_cap_mem_space) : bar)  ! { dg-error "Duplicate MEMSPACE modifier" }
+  block; end block
+end
+
+subroutine trait_present
+  use omp_lib
+  implicit none
+
+  type(omp_alloctrait), parameter :: trait1(0) = [omp_alloctrait :: ]
+  integer(kind=omp_allocator_handle_kind) :: a1
+
+  !$omp target uses_allocators(omp_cgroup_mem_alloc(trait1))  ! { dg-error "A memory space or traits array may not be specified for predefined allocator 'omp_cgroup_mem_alloc'" }
+  block; end block
+
+  !$omp target uses_allocators(traits(trait1) : omp_pteam_mem_alloc)  ! { dg-error "A memory space or traits array may not be specified for predefined allocator 'omp_pteam_mem_alloc'" }
+  block; end block
+
+  !$omp target uses_allocators(memspace(omp_low_lat_mem_space) : omp_thread_mem_alloc)  ! { dg-error "A memory space or traits array may not be specified for predefined allocator 'omp_thread_mem_alloc'" }
+  block; end block
+
+  ! Invalid in OpenMP 5.0 / 5.1, but valid since 5.2 the same as omp_default_mem_space + emptry traits array
+  !$omp target uses_allocators ( a1 )
+  block; end block
+end
+
+subroutine odd_names
+  use omp_lib
+  implicit none
+
+  type(omp_alloctrait), parameter :: trait1(0) = [omp_alloctrait :: ]
+
+  ! oddly named allocators:
+  integer(kind=omp_allocator_handle_kind) :: traits
+  integer(kind=omp_allocator_handle_kind) :: memspace
+
+  !$omp target uses_allocators ( traits(trait1), memspace(trait1) )
+  block; end block
+
+  !$omp target uses_allocators ( traits(trait1), memspace(omp_low_lat_mem_space)  : traits)
+  block; end block
+
+  !$omp target uses_allocators ( memspace(omp_low_lat_mem_space), traits(trait1) : memspace)
+  block; end block
+end
+
+subroutine more_checks
+  use omp_lib
+  implicit none
+
+  integer(kind=kind(omp_low_lat_mem_space)) :: my_memspace
+  integer(kind=omp_allocator_handle_kind) :: a1, a2(4)
+  integer(kind=1) :: a3
+
+  !$omp target uses_allocators ( memspace(my_memspace) : a1)  ! { dg-error "Memspace 'my_memspace' at .1. in USES_ALLOCATORS must be a predefined memory space" }
+  block; end block
+
+  !$omp target uses_allocators ( omp_low_lat_mem_space)  ! { dg-error "Allocator 'omp_low_lat_mem_space' at .1. in USES_ALLOCATORS must either a variable or a predefined allocator" }
+  block; end block
+
+  !$omp target uses_allocators ( memspace (omp_low_lat_mem_alloc) : a1)  ! { dg-error "Memspace 'omp_low_lat_mem_alloc' at .1. in USES_ALLOCATORS must be a predefined memory space" }
+  block; end block
+
+  !$omp target uses_allocators(memspace (omp_low_lat_mem_space) : a1 )
+  block; end block
+
+  !$omp target uses_allocators(memspace (omp_low_lat_mem_space) : a2 )  ! { dg-error "Allocator 'a2' at .1. in USES_ALLOCATORS must be a scalar integer of kind 'omp_allocator_handle_kind'" }
+  block; end block
+
+  !$omp target uses_allocators(memspace (omp_low_lat_mem_space) : a3 )  ! { dg-error "Allocator 'a3' at .1. in USES_ALLOCATORS must be a scalar integer of kind 'omp_allocator_handle_kind'" }
+  block; end block
+end
+
+subroutine traits_checks
+  use omp_lib
+  implicit none
+
+  type(omp_alloctrait), parameter :: trait1 = omp_alloctrait (omp_atk_alignment, 16)
+  type(omp_alloctrait) :: trait2
+  integer(kind=omp_atk_alignment), parameter :: trait3(1) = omp_atk_alignment
+  integer(kind=omp_allocator_handle_kind) :: a1
+
+  ! Sensible - but not (yet?) valid - an array constructor:
+  !$omp target uses_allocators(traits ([omp_alloctrait :: ]) : a1 )  ! { dg-error "Invalid character in name" }
+  block; end block
+  !$omp target uses_allocators(a1 ([omp_alloctrait :: ]))  ! { dg-error "Invalid character in name" }
+  block; end block
+
+  !$omp target uses_allocators(traits (trait1) : a1 )  ! { dg-error "Traits array 'trait1' in USES_ALLOCATORS .1. must be a one-dimensional named constant array of type 'omp_alloctrait'" }
+  block; end block
+  !$omp target uses_allocators(a1 (trait1))  ! { dg-error "Traits array 'trait1' in USES_ALLOCATORS .1. must be a one-dimensional named constant array of type 'omp_alloctrait'" }
+  block; end block
+
+  !$omp target uses_allocators(traits (trait2) : a1 )  ! { dg-error "Traits array 'trait2' in USES_ALLOCATORS .1. must be a one-dimensional named constant array of type 'omp_alloctrait'" }
+  block; end block
+  !$omp target uses_allocators(a1 (trait2))  ! { dg-error "Traits array 'trait2' in USES_ALLOCATORS .1. must be a one-dimensional named constant array of type 'omp_alloctrait'" }
+  block; end block
+
+  !$omp target uses_allocators(traits (trait3) : a1 )  ! { dg-error "Traits array 'trait3' in USES_ALLOCATORS .1. must be a one-dimensional named constant array of type 'omp_alloctrait'" }
+  block; end block
+  !$omp target uses_allocators(a1 (trait3))  ! { dg-error "Traits array 'trait3' in USES_ALLOCATORS .1. must be a one-dimensional named constant array of type 'omp_alloctrait'" }
+  block; end block
+end
diff --git a/libgomp/testsuite/libgomp.fortran/uses_allocators_2.f90 b/libgomp/testsuite/libgomp.fortran/uses_allocators_2.f90
new file mode 100644
index 00000000000..07327969775
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/uses_allocators_2.f90
@@ -0,0 +1,99 @@
+! { dg-do compile }
+
+! Minimal test for valid code:
+! - predefined allocators do not need any special treatment in uses_allocators
+!   (as 'requires dynamic_allocators' is the default).
+!
+! - Non-predefined allocators are currently rejected ('sorry)'
+
+subroutine test
+  use omp_lib
+  implicit none
+
+  !$omp target uses_allocators ( omp_default_mem_alloc , omp_large_cap_mem_alloc, &
+  !$omp&                         omp_const_mem_alloc,omp_high_bw_mem_alloc, &
+  !$omp&                         omp_low_lat_mem_alloc ,omp_cgroup_mem_alloc , &
+  !$omp&                         omp_pteam_mem_alloc, omp_thread_mem_alloc )
+  block; end block
+
+  !$omp target parallel uses_allocators ( omp_default_mem_alloc , omp_large_cap_mem_alloc, &
+  !$omp&                                  omp_const_mem_alloc,omp_high_bw_mem_alloc, &
+  !$omp&                                  omp_low_lat_mem_alloc ,omp_cgroup_mem_alloc , &
+  !$omp&                                  omp_pteam_mem_alloc, omp_thread_mem_alloc )
+  block; end block
+end
+
+subroutine non_predef
+  use omp_lib
+  implicit none
+
+  type(omp_alloctrait), parameter :: trait(0) = [omp_alloctrait :: ]
+  type(omp_alloctrait), parameter :: trait2(*) &
+    = [omp_alloctrait (omp_atk_alignment, 16),                    &
+       omp_alloctrait (omp_atk_sync_hint, omp_atv_default),       &
+       omp_alloctrait (omp_atk_access, omp_atv_default)]
+
+  integer(kind=omp_allocator_handle_kind) :: a1, a2, a3
+
+  !$omp target uses_allocators(omp_default_mem_alloc, a1(trait), a2(trait2))  ! { dg-message "sorry, unimplemented: 'uses_allocators' clause with traits and memory spaces" }
+  block; end block
+
+  !$omp target parallel uses_allocators(omp_default_mem_alloc, a1(trait), a2(trait2))  ! { dg-message "sorry, unimplemented: 'uses_allocators' clause with traits and memory spaces" }
+  block; end block
+
+
+  !$omp target uses_allocators(traits(trait):a1) &
+  !$omp&        uses_allocators ( memspace ( omp_low_lat_mem_space ) , traits ( trait2 ) : a2 , a3)  ! { dg-message "sorry, unimplemented: 'uses_allocators' clause with traits and memory spaces" }
+  block; end block
+
+  !$omp target parallel uses_allocators(traits(trait):a1) &
+  !$omp&        uses_allocators ( memspace ( omp_low_lat_mem_space ) , traits ( trait2 ) : a2 , a3)  ! { dg-message "sorry, unimplemented: 'uses_allocators' clause with traits and memory spaces" }
+  block; end block
+
+  !$omp target uses_allocators ( traits(trait2) , memspace ( omp_low_lat_mem_space ) : a2 , a3)  ! { dg-message "sorry, unimplemented: 'uses_allocators' clause with traits and memory spaces" }
+  block; end block
+end subroutine
+
+subroutine trait_present
+  use omp_lib
+  implicit none
+
+  type(omp_alloctrait), parameter :: trait1(0) = [omp_alloctrait :: ]
+  integer(kind=omp_allocator_handle_kind) :: a1
+
+  ! Invalid in OpenMP 5.0 / 5.1, but valid since 5.2 the same as omp_default_mem_space + emptry traits array
+  !$omp target uses_allocators ( a1 )  ! { dg-message "sorry, unimplemented: 'uses_allocators' clause with traits and memory spaces" }
+  block; end block
+end
+
+subroutine odd_names
+  use omp_lib
+  implicit none
+
+  type(omp_alloctrait), parameter :: trait1(0) = [omp_alloctrait :: ]
+
+  ! oddly named allocators:
+  integer(kind=omp_allocator_handle_kind) :: traits
+  integer(kind=omp_allocator_handle_kind) :: memspace
+
+  !$omp target uses_allocators ( traits(trait1), memspace(trait1) )  ! { dg-message "sorry, unimplemented: 'uses_allocators' clause with traits and memory spaces" }
+  block; end block
+
+  !$omp target uses_allocators ( traits(trait1), memspace(omp_low_lat_mem_space)  : traits)  ! { dg-message "sorry, unimplemented: 'uses_allocators' clause with traits and memory spaces" }
+  block; end block
+
+  !$omp target uses_allocators ( memspace(omp_low_lat_mem_space), traits(trait1) : memspace)  ! { dg-message "sorry, unimplemented: 'uses_allocators' clause with traits and memory spaces" }
+  block; end block
+end
+
+subroutine more_checks
+  use omp_lib
+  implicit none
+
+  integer(kind=kind(omp_low_lat_mem_space)) :: my_memspace
+  integer(kind=omp_allocator_handle_kind) :: a1, a2(4)
+  integer(kind=1) :: a3
+
+  !$omp target uses_allocators(memspace (omp_low_lat_mem_space) : a1 )  ! { dg-message "sorry, unimplemented: 'uses_allocators' clause with traits and memory spaces" }
+  block; end block
+end
