OpenMP: Allocate directive for static vars, clean up

For the 'allocate' directive, remove the sorry for static variables and
just keep using normal memory, but honor the requested alignment and set
a DECL_ATTRIBUTE in case a target may want to make use of this later on.
The documentation is updated accordingly.

The C diagnostic to check for predefined allocators (req. for static vars)
failed to accept GCC's ompx_gnu_... allocator, now fixed. (Fortran was
already okay; but both now use new common #defined value for checking.)
And while Fortran common block variables are still rejected, the check
has been improved as before the sorry diagnostic did not work for
common blocks in modules.

Finally, for 'allocate' clause on the target/task/taskloop directives,
there is now a warning for omp_thread_mem_alloc (i.e. predefined allocator
with access = thread), which is undefined behavior according to the
OpenMP specification.

And, last, testing showed that var decl + static_assert sets TREE_USED
but does not produce a statement list in C, which did run into an assert
in gimplify. This special case is now also handled.

gcc/c/ChangeLog:

	* c-parser.cc (c_parser_omp_allocate): Set alignment for alignof;
	accept static variables and fix predef allocator check.

gcc/fortran/ChangeLog:

	* openmp.cc (is_predefined_allocator): Use gomp-constants.h consts.
	* trans-common.cc (translate_common): Reject OpenMP allocate directives.
	* trans-decl.cc (gfc_finish_var_decl): Handle allocate directive
	for static variables.
	(gfc_trans_deferred_vars): Update for the latter.

gcc/ChangeLog:

	* gimplify.cc (gimplify_bind_expr): Fix corner case for OpenMP
	allocate directive.
	(gimplify_scan_omp_clauses): Warn if omp_thread_mem_alloc is used
	as allocator with the target/task/taskloop directive.

include/ChangeLog:

	* gomp-constants.h (GOMP_OMP_PREDEF_ALLOC_MAX,
	GOMP_OMPX_PREDEF_ALLOC_MIN, GOMP_OMPX_PREDEF_ALLOC_MAX,
	GOMP_OMP_PREDEF_ALLOC_THREADS): New defines.

libgomp/ChangeLog:

	* allocator.c: Add static asserts for news
	GOMP_OMP{,X}_PREDEF_ALLOC_{MIN,MAX} range values.
	* libgomp.texi (OpenMP Impl. Status): Allocate directive for
	static vars is now supported. Refer to PR for allocate clause.
	(Memory allocation): Update for static vars; minor word tweaking.

gcc/testsuite/ChangeLog:

	* c-c++-common/gomp/allocate-9.c: Update for removed sorry.
	* gfortran.dg/gomp/allocate-15.f90: Likewise.
	* gfortran.dg/gomp/allocate-pinned-1.f90: Likewise.
	* gfortran.dg/gomp/allocate-4.f90: Likewise; add dg-error for
	previously missing diagnostic.
	* c-c++-common/gomp/allocate-18.c: New test.
	* c-c++-common/gomp/allocate-19.c: New test.
	* gfortran.dg/gomp/allocate-clause.f90: New test.
	* gfortran.dg/gomp/allocate-static-2.f90: New test.
	* gfortran.dg/gomp/allocate-static.f90: New test.

14 files changed, 444 insertions, 107 deletions

diff --git a/gcc/c/c-parser.cc b/gcc/c/c-parser.cc
index a681438..fe01f95 100644
--- a/gcc/c/c-parser.cc
+++ b/gcc/c/c-parser.cc
@@ -20967,20 +20967,22 @@ c_parser_omp_allocate (c_parser *parser)
       if (TREE_STATIC (var))
 	{
 	  if (allocator == NULL_TREE && allocator_loc == UNKNOWN_LOCATION)
-	    error_at (loc, "%<allocator%> clause required for "
-			   "static variable %qD", var);
+	    {
+	      error_at (loc,
+			"%<allocator%> clause required for "
+			"static variable %qD", var);
+	      continue;
+	    }
 	  else if (allocator
 		   && (wi::to_widest (allocator) < 1
-		       || wi::to_widest (allocator) > 8))
-	    /* 8 = largest predefined memory allocator. */
-	    error_at (allocator_loc,
-		      "%<allocator%> clause requires a predefined allocator as "
-		      "%qD is static", var);
-	  else
-	    sorry_at (OMP_CLAUSE_LOCATION (nl),
-		      "%<#pragma omp allocate%> for static variables like "
-		      "%qD not yet supported", var);
-	  continue;
+		       || wi::to_widest (allocator) > GOMP_OMP_PREDEF_ALLOC_MAX)
+		   && (wi::to_widest (allocator) < GOMP_OMPX_PREDEF_ALLOC_MIN
+		       || wi::to_widest (allocator) > GOMP_OMPX_PREDEF_ALLOC_MAX))
+	    {
+	      error_at (allocator_loc,
+			"%<allocator%> clause requires a predefined allocator as "
+			"%qD is static", var);
+	    }
 	}
       if (allocator)
 	{
@@ -20988,6 +20990,9 @@ c_parser_omp_allocate (c_parser *parser)
 	    = {EXPR_LOC_OR_LOC (allocator, OMP_CLAUSE_LOCATION (nl)), var};
 	  walk_tree (&allocator, c_check_omp_allocate_allocator_r, &data, NULL);
 	}
+      if (alignment)
+	SET_DECL_ALIGN (var, BITS_PER_UNIT * MAX (tree_to_uhwi (alignment),
+						  DECL_ALIGN_UNIT (var)));
       DECL_ATTRIBUTES (var) = tree_cons (get_identifier ("omp allocate"),
 					 build_tree_list (allocator, alignment),
 					 DECL_ATTRIBUTES (var));
diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc
index 2d5c430..d9ccae8 100644
--- a/gcc/fortran/openmp.cc
+++ b/gcc/fortran/openmp.cc
@@ -7857,9 +7857,12 @@ is_predefined_allocator (gfc_expr *expr)
 	  && expr->ts.kind == gfc_c_intptr_kind
 	  && expr->expr_type == EXPR_CONSTANT
 	  && ((mpz_sgn (expr->value.integer) > 0
-	       && mpz_cmp_si (expr->value.integer, 8) <= 0)
-	      || (mpz_cmp_si (expr->value.integer, 200) >= 0
-		  && mpz_cmp_si (expr->value.integer, 200) <= 0)));
+	       && mpz_cmp_si (expr->value.integer,
+			      GOMP_OMP_PREDEF_ALLOC_MAX) <= 0)
+	      || (mpz_cmp_si (expr->value.integer,
+			      GOMP_OMPX_PREDEF_ALLOC_MIN) >= 0
+		  && mpz_cmp_si (expr->value.integer,
+				 GOMP_OMPX_PREDEF_ALLOC_MAX) <= 0)));
 }
 
 /* Resolve declarative ALLOCATE statement. Note: Common block vars only appear
diff --git a/gcc/fortran/trans-common.cc b/gcc/fortran/trans-common.cc
index e714342..481d468 100644
--- a/gcc/fortran/trans-common.cc
+++ b/gcc/fortran/trans-common.cc
@@ -1219,6 +1219,10 @@ translate_common (gfc_common_head *common, gfc_symbol *var_list)
   align = 1;
   saw_equiv = false;
 
+  if (var_list->attr.omp_allocate)
+    gfc_error ("Sorry, !$OMP allocate for COMMON block variable %qs at %L "
+	       "not supported", common->name, &common->where);
+
   /* Add symbols to the segment.  */
   for (sym = var_list; sym; sym = sym->common_next)
     {
diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index 8231bd2..2586c6d 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -821,6 +821,23 @@ gfc_finish_var_decl (tree decl, gfc_symbol * sym)
       && (TREE_STATIC (decl) || DECL_EXTERNAL (decl)))
     set_decl_tls_model (decl, decl_default_tls_model (decl));
 
+  if (sym->attr.omp_allocate && TREE_STATIC (decl))
+    {
+      struct gfc_omp_namelist *n;
+      for (n = sym->ns->omp_allocate; n; n = n->next)
+	if (n->sym == sym)
+	  break;
+      tree alloc = gfc_conv_constant_to_tree (n->u2.allocator);
+      tree align = (n->u.align ? gfc_conv_constant_to_tree (n->u.align)
+			       : NULL_TREE);
+      if (align != NULL_TREE)
+	SET_DECL_ALIGN (decl, MAX (tree_to_uhwi (align),
+			DECL_ALIGN_UNIT (decl)) * BITS_PER_UNIT);
+      DECL_ATTRIBUTES (decl)
+	= tree_cons (get_identifier ("omp allocate"),
+		     build_tree_list (alloc, align), DECL_ATTRIBUTES (decl));
+    }
+
   /* Mark weak variables.  */
   if (sym->attr.ext_attr & (1 << EXT_ATTR_WEAK))
     declare_weak (decl);
@@ -5251,71 +5268,55 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block)
   se.expr = NULL_TREE;
   for (struct gfc_omp_namelist *n = omp_ns ? omp_ns->omp_allocate : NULL;
        n; n = n->next)
-    if (!TREE_STATIC (n->sym->backend_decl))
-      {
-	tree align = (n->u.align ? gfc_conv_constant_to_tree (n->u.align)
-				 : NULL_TREE);
-	if (last_allocator != n->u2.allocator)
-	  {
-	    location_t loc = input_location;
-	    gfc_init_se (&se, NULL);
-	    if (n->u2.allocator)
-	      {
-		input_location = gfc_get_location (&n->u2.allocator->where);
-		gfc_conv_expr (&se, n->u2.allocator);
-	      }
-	    /* We need to evalulate non-constants - also to find the location
-	       after which the GOMP_alloc has to be added to - also as BLOCK
-	       does not yield a new BIND_EXPR_BODY.  */
-	    if (n->u2.allocator
-		&& (!(CONSTANT_CLASS_P (se.expr) && DECL_P (se.expr))
-		    || se.pre.head || se.post.head))
-	      {
-		stmtblock_t tmpblock;
-		gfc_init_block (&tmpblock);
-		se.expr = gfc_evaluate_now (se.expr, &tmpblock);
-		/* First post then pre because the new code is inserted
-		   at the top. */
-		gfc_add_init_cleanup (block, gfc_finish_block (&se.post), NULL);
-		gfc_add_init_cleanup (block, gfc_finish_block (&tmpblock),
-				      NULL);
-		gfc_add_init_cleanup (block, gfc_finish_block (&se.pre), NULL);
-	      }
-	    last_allocator = n->u2.allocator;
-	    input_location = loc;
-	  }
-
-	/* 'omp allocate( {purpose: allocator, value: align},
-			  {purpose: init-stmtlist, value: cleanup-stmtlist},
-			  {purpose: size-var, value: last-size-expr}}
-	    where init-stmt/cleanup-stmt is the STATEMENT list to find the
-	    try-final block; last-size-expr is to find the location after
-	    which to add the code and 'size-var' is for the proper size, cf.
-	    gfc_trans_auto_array_allocation - either or both of the latter
-	    can be NULL.  */
-	tree tmp = lookup_attribute ("omp allocate",
-				     DECL_ATTRIBUTES (n->sym->backend_decl));
-	tmp = TREE_VALUE (tmp);
-	TREE_PURPOSE (tmp) = se.expr;
-	TREE_VALUE (tmp) = align;
-	TREE_PURPOSE (TREE_CHAIN (tmp)) = init_stmtlist;
-	TREE_VALUE (TREE_CHAIN (tmp)) = cleanup_stmtlist;
-      }
-    else if (n->sym->attr.in_common)
-      {
-	gfc_error ("Sorry, !$OMP allocate for COMMON block variable %qs at %L "
-		   "not supported", n->sym->common_block->name,
-		   &n->sym->common_block->where);
-	break;
-      }
-    else
-      {
-	gfc_error ("Sorry, !$OMP allocate for variable %qs at %L with SAVE "
-		   "attribute not yet implemented", n->sym->name,
-		   &n->sym->declared_at);
-	/* FIXME: Remember to handle last_allocator.  */
-	break;
-      }
+    {
+      tree align = (n->u.align ? gfc_conv_constant_to_tree (n->u.align) : NULL_TREE);
+      if (last_allocator != n->u2.allocator)
+	{
+	  location_t loc = input_location;
+	  gfc_init_se (&se, NULL);
+	  if (n->u2.allocator)
+	    {
+	      input_location = gfc_get_location (&n->u2.allocator->where);
+	      gfc_conv_expr (&se, n->u2.allocator);
+	    }
+	  /* We need to evalulate non-constants - also to find the location
+	     after which the GOMP_alloc has to be added to - also as BLOCK
+	     does not yield a new BIND_EXPR_BODY.  */
+	  if (n->u2.allocator
+	      && (!(CONSTANT_CLASS_P (se.expr) && DECL_P (se.expr))
+		  || se.pre.head || se.post.head))
+	    {
+	      stmtblock_t tmpblock;
+	      gfc_init_block (&tmpblock);
+	      se.expr = gfc_evaluate_now (se.expr, &tmpblock);
+	      /* First post then pre because the new code is inserted
+		 at the top. */
+	      gfc_add_init_cleanup (block, gfc_finish_block (&se.post), NULL);
+	      gfc_add_init_cleanup (block, gfc_finish_block (&tmpblock),
+				    NULL);
+	      gfc_add_init_cleanup (block, gfc_finish_block (&se.pre), NULL);
+	    }
+	  last_allocator = n->u2.allocator;
+	  input_location = loc;
+	}
+      if (TREE_STATIC (n->sym->backend_decl))
+	continue;
+      /* 'omp allocate( {purpose: allocator, value: align},
+			{purpose: init-stmtlist, value: cleanup-stmtlist},
+			{purpose: size-var, value: last-size-expr}}
+	  where init-stmt/cleanup-stmt is the STATEMENT list to find the
+	  try-final block; last-size-expr is to find the location after
+	  which to add the code and 'size-var' is for the proper size, cf.
+	  gfc_trans_auto_array_allocation - either or both of the latter
+	  can be NULL.  */
+      tree tmp = lookup_attribute ("omp allocate",
+				   DECL_ATTRIBUTES (n->sym->backend_decl));
+      tmp = TREE_VALUE (tmp);
+      TREE_PURPOSE (tmp) = se.expr;
+      TREE_VALUE (tmp) = align;
+      TREE_PURPOSE (TREE_CHAIN (tmp)) = init_stmtlist;
+      TREE_VALUE (TREE_CHAIN (tmp)) = cleanup_stmtlist;
+    }
 
   gfc_init_block (&tmpblock);
 
diff --git a/gcc/gimplify.cc b/gcc/gimplify.cc
index 6cdc70d..3f60246 100644
--- a/gcc/gimplify.cc
+++ b/gcc/gimplify.cc
@@ -1396,6 +1396,7 @@ gimplify_bind_expr (tree *expr_p, gimple_seq *pre_p)
 
 	  if (flag_openmp
 	      && !is_global_var (t)
+	      && !TREE_STATIC (t)
 	      && DECL_CONTEXT (t) == current_function_decl
 	      && TREE_USED (t)
 	      && (attr = lookup_attribute ("omp allocate", DECL_ATTRIBUTES (t)))
@@ -1427,11 +1428,17 @@ gimplify_bind_expr (tree *expr_p, gimple_seq *pre_p)
 			  "%<allocate%> directive for %qD inside a target "
 			  "region must specify an %<allocator%> clause", t);
 	      /* Skip for omp_default_mem_alloc (= 1),
-		 unless align is present. */
+		 unless align is present.  For C/C++, there should be always a
+		 statement list following if TREE_USED, except for, e.g., using
+		 this decl in a static_assert; in that case, only a single
+		 DECL_EXPR remains, which can be skipped here.  */
 	      else if (!errorcount
 		       && (align != NULL_TREE
 			   || alloc == NULL_TREE
-			   || !integer_onep (alloc)))
+			   || !integer_onep (alloc))
+		       && (lang_GNU_Fortran ()
+			   || (TREE_CODE (BIND_EXPR_BODY (bind_expr))
+			       != DECL_EXPR)))
 		{
 		  /* Fortran might already use a pointer type internally;
 		     use that pointer except for type(C_ptr) and type(C_funptr);
@@ -13326,6 +13333,17 @@ gimplify_scan_omp_clauses (tree *list_p, gimple_seq *pre_p,
 	  break;
 
 	case OMP_CLAUSE_ALLOCATE:
+	  decl = OMP_CLAUSE_ALLOCATE_ALLOCATOR (c);
+	  if (decl
+	      && TREE_CODE (decl) == INTEGER_CST
+	      && wi::eq_p (wi::to_widest (decl), GOMP_OMP_PREDEF_ALLOC_THREADS)
+	      && (code == OMP_TARGET || code == OMP_TASK || code == OMP_TASKLOOP))
+	    warning_at (OMP_CLAUSE_LOCATION (c), OPT_Wopenmp,
+			"allocator with access trait set to %<thread%> "
+			"results in undfined behavior for %qs directive",
+			code == OMP_TARGET ? "target"
+					   : (code == OMP_TASK
+					      ? "task" : "taskloop"));
 	  decl = OMP_CLAUSE_DECL (c);
 	  if (error_operand_p (decl))
 	    {
diff --git a/gcc/testsuite/c-c++-common/gomp/allocate-18.c b/gcc/testsuite/c-c++-common/gomp/allocate-18.c
new file mode 100644
index 0000000..4182f7e
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/allocate-18.c
@@ -0,0 +1,59 @@
+typedef enum omp_allocator_handle_t
+#if __cplusplus >= 201103L
+: __UINTPTR_TYPE__
+#endif
+{
+  omp_null_allocator = 0,
+  omp_default_mem_alloc = 1,
+  omp_large_cap_mem_alloc = 2,
+  omp_const_mem_alloc = 3,
+  omp_high_bw_mem_alloc = 4,
+  omp_low_lat_mem_alloc = 5,
+  omp_cgroup_mem_alloc = 6,
+  omp_pteam_mem_alloc = 7,
+  omp_thread_mem_alloc = 8,
+  __omp_allocator_handle_t_max__ = __UINTPTR_MAX__
+} omp_allocator_handle_t;
+
+void test0 ()
+{
+  int A1[5];
+  #pragma omp allocate(A1) align(128) allocator(omp_default_mem_alloc)
+  /* { dg-message "sorry, unimplemented: '#pragma omp allocate' not yet supported" "" { target c++ } .-1 } */
+
+  #ifndef __cplusplus
+    _Static_assert (_Alignof(A1) == 128, "wrong alignment");
+  #elif __cplusplus >= 201103L
+     static_assert (alignof(A1) == 128, "wrong alignment");  /* { dg-bogus "static assertion failed: wrong alignment" "" { xfail { c++ && { ! c++98_only } } } } */
+  #endif
+}
+
+void
+test1 ()
+{
+  int x[5];
+  #pragma omp parallel allocate(omp_thread_mem_alloc: x) firstprivate(x)
+   x[0] = 1;
+
+  #pragma omp target allocate(omp_thread_mem_alloc: x) firstprivate(x) /* uses_allocators(omp_thread_mem_alloc) */
+   /* { dg-warning "allocator with access trait set to 'thread' results in undfined behavior for 'target' directive \\\[-Wopenmp\\\]" "" { target *-*-* } .-1 } */
+   x[0] = 1;
+
+  #pragma omp taskloop allocate(omp_thread_mem_alloc: x) firstprivate(x)
+   /* { dg-warning "allocator with access trait set to 'thread' results in undfined behavior for 'taskloop' directive \\\[-Wopenmp\\\]" "" { target *-*-* } .-1 } */
+   for (int i = 0; i < 5; i++)
+     x[i] = i;
+
+  #pragma omp parallel master taskloop simd allocate(omp_thread_mem_alloc: x) firstprivate(x)
+   /* { dg-warning "allocator with access trait set to 'thread' results in undfined behavior for 'taskloop' directive \\\[-Wopenmp\\\]" "" { target *-*-* } .-1 } */
+   for (int i = 0; i < 5; i++)
+     x[i] = i;
+
+  #pragma omp parallel
+  #pragma omp masked
+  {
+    #pragma omp task allocate(omp_thread_mem_alloc: x) firstprivate(x)
+      /* { dg-warning "allocator with access trait set to 'thread' results in undfined behavior for 'task' directive \\\[-Wopenmp\\\]" "" { target *-*-* } .-1 } */
+      x[0] = 1;
+  }
+}
diff --git a/gcc/testsuite/c-c++-common/gomp/allocate-19.c b/gcc/testsuite/c-c++-common/gomp/allocate-19.c
new file mode 100644
index 0000000..ad3493d
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/allocate-19.c
@@ -0,0 +1,69 @@
+typedef enum omp_allocator_handle_t
+#if __cplusplus >= 201103L
+: __UINTPTR_TYPE__
+#endif
+{
+  omp_null_allocator = 0,
+  omp_default_mem_alloc = 1,
+  omp_large_cap_mem_alloc = 2,
+  omp_const_mem_alloc = 3,
+  omp_high_bw_mem_alloc = 4,
+  omp_low_lat_mem_alloc = 5,
+  omp_cgroup_mem_alloc = 6,
+  omp_pteam_mem_alloc = 7,
+  omp_thread_mem_alloc = 8,
+  ompx_gnu_pinned_bogus_1 = 9,
+  ompx_gnu_pinned_bogus_2 = 199,
+  ompx_gnu_pinned_mem_alloc = 200,
+  ompx_gnu_pinned_bogus_3 = 2001,
+  __omp_allocator_handle_t_max__ = __UINTPTR_MAX__
+} omp_allocator_handle_t;
+
+static int A1[5] = {1,2,3,4,5};
+#pragma omp allocate(A1) align(128) allocator(omp_default_mem_alloc)
+/* { dg-message "sorry, unimplemented: '#pragma omp allocate' not yet supported" "" { target c++ } .-1 } */
+
+#ifndef __cplusplus
+_Static_assert (_Alignof(A1) == 128, "wrong alignment");
+#elif __cplusplus >= 201103L
+static_assert (alignof(A1) == 128, "wrong alignment");  /* { dg-bogus "static assertion failed: wrong alignment" "" { xfail { c++ && { ! c++98_only } } } } */
+#endif
+
+
+static int *ptr;
+#pragma omp allocate(ptr) align(2) allocator(omp_default_mem_alloc)
+/* { dg-message "sorry, unimplemented: '#pragma omp allocate' not yet supported" "" { target c++ } .-1 } */
+
+#ifndef __cplusplus
+_Static_assert (_Alignof(ptr) == _Alignof(int*), "wrong alignment");
+#elif __cplusplus >= 201103L
+static_assert (alignof(ptr) == alignof(int*), "wrong alignment");
+#endif
+
+
+int *
+get ()
+{
+  static int q = 0;
+  #pragma omp allocate(q) align(1024) allocator(omp_default_mem_alloc)
+  /* { dg-message "sorry, unimplemented: '#pragma omp allocate' not yet supported" "" { target c++ } .-1 } */
+
+#ifndef __cplusplus
+  _Static_assert (_Alignof(q) == 1024, "wrong alignment");
+#elif __cplusplus >= 201103L
+  static_assert (alignof(q) == 1024, "wrong alignment");  /* { dg-bogus "static assertion failed: wrong alignment" "" { xfail { c++ && { ! c++98_only } } } } */
+#endif
+
+  q += 1;
+  return &A1[q];
+}
+
+static int invalid1, okay1, invalid2, invalid3;
+#pragma omp allocate(invalid1) align(128) allocator(ompx_gnu_pinned_bogus_1) /* { dg-error "'allocator' clause requires a predefined allocator as 'invalid1' is static" "" { xfail c++ } }  */
+#pragma omp allocate(okay1) align(128) allocator(ompx_gnu_pinned_mem_alloc)  /* Okay */
+#pragma omp allocate(invalid2) align(128) allocator(ompx_gnu_pinned_bogus_2) /* { dg-error "'allocator' clause requires a predefined allocator as 'invalid2' is static" "" { xfail c++ } }  */
+#pragma omp allocate(invalid3) align(128) allocator(ompx_gnu_pinned_bogus_3) /* { dg-error "'allocator' clause requires a predefined allocator as 'invalid3' is static" "" { xfail c++ } }  */
+/* { dg-message "sorry, unimplemented: '#pragma omp allocate' not yet supported" "" { target c++ } .-4 } */
+/* { dg-message "sorry, unimplemented: '#pragma omp allocate' not yet supported" "" { target c++ } .-4 } */
+/* { dg-message "sorry, unimplemented: '#pragma omp allocate' not yet supported" "" { target c++ } .-4 } */
+/* { dg-message "sorry, unimplemented: '#pragma omp allocate' not yet supported" "" { target c++ } .-4 } */
diff --git a/gcc/testsuite/c-c++-common/gomp/allocate-9.c b/gcc/testsuite/c-c++-common/gomp/allocate-9.c
index 3138274..f37a111 100644
--- a/gcc/testsuite/c-c++-common/gomp/allocate-9.c
+++ b/gcc/testsuite/c-c++-common/gomp/allocate-9.c
@@ -18,7 +18,11 @@ typedef enum omp_allocator_handle_t
 
 
 static int A[5] = {1,2,3,4,5};
-int B, C, D;
+static int A2[5] = {1,2,3,4,5};
+static int A3[5] = {1,2,3,4,5};
+static int A4[5] = {1,2,3,4,5};
+static int A5[5] = {1,2,3,4,5};
+int B, C, C2, D;
 
 /* If the following fails because of added predefined allocators, please update
    - c/c-parser.c's c_parser_omp_allocate
@@ -30,46 +34,45 @@ int B, C, D;
 #pragma omp allocate(A) align(32) allocator((omp_allocator_handle_t) 9) /* { dg-error "'allocator' clause requires a predefined allocator as 'A' is static" "" { xfail c++ } } */
 /* { dg-message "sorry, unimplemented: '#pragma omp allocate' not yet supported" "" { target c++ } .-1 } */
 
-
 // typo in allocator name:
-#pragma omp allocate(A) allocator(omp_low_latency_mem_alloc)
+#pragma omp allocate(A2) allocator(omp_low_latency_mem_alloc)
 /* { dg-error "'omp_low_latency_mem_alloc' undeclared here \\(not in a function\\); did you mean 'omp_low_lat_mem_alloc'\\?" "" { target c } .-1 } */
 /* { dg-error "'omp_low_latency_mem_alloc' was not declared in this scope; did you mean 'omp_low_lat_mem_alloc'\\?" "" { target c++ } .-2 } */
-/* { dg-error "'allocator' clause required for static variable 'A'" "" { target c } .-3 } */
+/* { dg-error "'allocator' clause required for static variable 'A2'" "" { target c } .-3 } */
 /* { dg-message "sorry, unimplemented: '#pragma omp allocate' not yet supported" "" { target c++ } .-4 } */
 
 /* align be const multiple of 2 */
-#pragma omp allocate(A) align(31) allocator(omp_default_mem_alloc) /* { dg-error "'align' clause argument needs to be positive constant power of two integer expression" } */
-/* { dg-message "sorry, unimplemented: '#pragma omp allocate' for static variables like 'A' not yet supported" "" { target c } .-1 } */
-/* { dg-message "sorry, unimplemented: '#pragma omp allocate' not yet supported" "" { target c++ } .-2 } */
+#pragma omp allocate(A3) align(31) allocator(omp_default_mem_alloc) /* { dg-error "'align' clause argument needs to be positive constant power of two integer expression" } */
+/* { dg-message "sorry, unimplemented: '#pragma omp allocate' not yet supported" "" { target c++ } .-1 } */
+
 
 /* allocator missing (required as A is static) */
-#pragma omp allocate(A) align(32) /* { dg-error "'allocator' clause required for static variable 'A'" "" { xfail c++ } } */
+#pragma omp allocate(A4) align(32) /* { dg-error "'allocator' clause required for static variable 'A4'" "" { xfail c++ } } */
 /* { dg-message "sorry, unimplemented: '#pragma omp allocate' not yet supported" "" { target c++ } .-1 } */
 
 /* "expression in the clause must be a constant expression that evaluates to one of the
    predefined memory allocator values -> omp_low_lat_mem_alloc"  */
 #pragma omp allocate(B) allocator((omp_allocator_handle_t) (omp_high_bw_mem_alloc+1)) align(32) /* OK: omp_low_lat_mem_alloc */
-/* { dg-message "sorry, unimplemented: '#pragma omp allocate' for static variables like 'B' not yet supported" "" { target c } .-1 } */
-/* { dg-message "sorry, unimplemented: '#pragma omp allocate' not yet supported" "" { target c++ } .-2 } */
+/* { dg-message "sorry, unimplemented: '#pragma omp allocate' not yet supported" "" { target c++ } .-1 } */
+
 
 #pragma omp allocate(C) allocator((omp_allocator_handle_t) 2) /* OK: omp_large_cap_mem_alloc */
-/* { dg-message "sorry, unimplemented: '#pragma omp allocate' for static variables like 'C' not yet supported" "" { target c } .-1 } */
-/* { dg-message "sorry, unimplemented: '#pragma omp allocate' not yet supported" "" { target c++ } .-2 } */
+/* { dg-message "sorry, unimplemented: '#pragma omp allocate' not yet supported" "" { target c++ } .-1 } */
 
-#pragma omp allocate(A) align(32) allocator(omp_null_allocator) /* { dg-error "'allocator' clause requires a predefined allocator as 'A' is static" "" { xfail c++ } } */
+
+#pragma omp allocate(A5) align(32) allocator(omp_null_allocator) /* { dg-error "'allocator' clause requires a predefined allocator as 'A5' is static" "" { xfail c++ } } */
+/* { dg-message "sorry, unimplemented: '#pragma omp allocate' not yet supported" "" { target c++ } .-1 } */
+
+#pragma omp allocate(C2) align(32) allocator(omp_large_cap_mem_alloc)
 /* { dg-message "sorry, unimplemented: '#pragma omp allocate' not yet supported" "" { target c++ } .-1 } */
 
-#pragma omp allocate(C) align(32) allocator(omp_large_cap_mem_alloc)  /* { dg-error "'C' already appeared as list item in an 'allocate' directive" "" { xfail *-*-* } } */
-/* { dg-message "sorry, unimplemented: '#pragma omp allocate' for static variables like 'C' not yet supported" "" { target c } .-1 } */
-/* { dg-message "sorry, unimplemented: '#pragma omp allocate' not yet supported" "" { target c++ } .-2 } */
 
 // allocate directive in same TU
 int f()
 {
   #pragma omp allocate(D) align(32) allocator(omp_large_cap_mem_alloc) /* { dg-error "'allocate' directive must be in the same scope as 'D'" "" { xfail c++ } } */
-/* { dg-note "declared here" "" { target c } 21 } */
-/* { dg-message "sorry, unimplemented: '#pragma omp allocate' not yet supported" "" { target c++ } .-2 } */
+/* { dg-message "sorry, unimplemented: '#pragma omp allocate' not yet supported" "" { target c++ } .-1 } */
+/* { dg-note "declared here" "" { target c } 25 } */
   return A[0];
 }
 
@@ -83,8 +86,8 @@ int g()
   {
     int c2=3;
     #pragma omp allocate(c2, b2) /* { dg-error "'allocate' directive must be in the same scope as 'b2'" "" { xfail c++ } } */
-/* { dg-note "declared here" "" { target c } .-8 } */
-/* { dg-message "sorry, unimplemented: '#pragma omp allocate' not yet supported" "" { target c++ } .-2 } */
+/* { dg-message "sorry, unimplemented: '#pragma omp allocate' not yet supported" "" { target c++ } .-1 } */
+/* { dg-note "declared here" "" { target c } .-9 } */
     return c2+a2+b2;
   }
 }
diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-15.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-15.f90
index a0690a5..e3ef841 100644
--- a/gcc/testsuite/gfortran.dg/gomp/allocate-15.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/allocate-15.f90
@@ -30,7 +30,7 @@ end
 
 integer function allocators() result(res)
   use m
-  integer, save :: a(5) = [1,2,3,4,5]  ! { dg-error "Sorry, !.OMP allocate for variable 'a' at .1. with SAVE attribute not yet implemented" }
+  integer, save :: a(5) = [1,2,3,4,5]
   !$omp allocate(a) allocator(omp_high_bw_mem_alloc)
   res = a(4)
 end
diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-4.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-4.f90
index b93a37c..ee5fc8e 100644
--- a/gcc/testsuite/gfortran.dg/gomp/allocate-4.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/allocate-4.f90
@@ -39,7 +39,7 @@ integer :: a,b,c(n),d(5),e(2)
 !$omp allocate(   e ) allocator( omp_high_bw_mem_alloc )
 
 !saved vars
-integer, save :: k,l,m(5),r(2)  ! { dg-error "Sorry, !.OMP allocate for variable 'k' at .1. with SAVE attribute not yet implemented" }
+integer, save :: k,l,m(5),r(2)
 !$omp allocate(k)  align(16) , allocator (omp_large_cap_mem_alloc)
 !$omp allocate ( l ) allocator (omp_large_cap_mem_alloc) , align ( 32)
 !$omp allocate (m) align( 128 ),allocator( omp_high_bw_mem_alloc )
@@ -47,8 +47,8 @@ integer, save :: k,l,m(5),r(2)  ! { dg-error "Sorry, !.OMP allocate for variable
 
 !common /block/
 integer :: q,x,y(2),z(5)
-common /com1/ q,x
-common /com2/ y,z
+common /com1/ q,x  ! { dg-error "Sorry, !.OMP allocate for COMMON block variable 'com1' at .1. not supported" }
+common /com2/ y,z  ! { dg-error "Sorry, !.OMP allocate for COMMON block variable 'com2' at .1. not supported" }
 !$omp allocate ( / com1/) align( 128 ) allocator( omp_high_bw_mem_alloc )
 !$omp allocate(/com2 / ) allocator( omp_high_bw_mem_alloc )
 end
diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-clause.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-clause.f90
new file mode 100644
index 0000000..3548538
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/allocate-clause.f90
@@ -0,0 +1,61 @@
+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 test1 ()
+  use omp_lib_kinds
+  implicit none
+  integer :: x(5), i
+
+  !$omp parallel allocate(omp_thread_mem_alloc: x) firstprivate(x)
+   x(1) = 1
+  !$omp end parallel
+
+  !$omp target allocate(omp_thread_mem_alloc: x) firstprivate(x) ! uses_allocators(omp_thread_mem_alloc)
+    ! { dg-warning "allocator with access trait set to 'thread' results in undfined behavior for 'target' directive \\\[-Wopenmp\\\]" "" { target *-*-* } .-1 }
+    x(1) = 1
+  !$omp end target
+
+  !$omp taskloop allocate(omp_thread_mem_alloc: x) firstprivate(x)
+   ! { dg-warning "allocator with access trait set to 'thread' results in undfined behavior for 'taskloop' directive \\\[-Wopenmp\\\]" "" { target *-*-* } .-1 }
+   do i = 1, 5
+     x(i) = i
+   end do
+
+  !$omp parallel master taskloop simd allocate(omp_thread_mem_alloc: x) firstprivate(x)
+   ! { dg-warning "allocator with access trait set to 'thread' results in undfined behavior for 'taskloop' directive \\\[-Wopenmp\\\]" "" { target *-*-* } .-1 }
+   do i = 1, 5
+     x(i) = i
+   end do
+
+  !$omp parallel
+  !$omp masked
+    !$omp task allocate(omp_thread_mem_alloc: x) firstprivate(x)
+      ! { dg-warning "allocator with access trait set to 'thread' results in undfined behavior for 'task' directive \\\[-Wopenmp\\\]" "" { target *-*-* } .-1 }
+      x(1) = 1
+    !$omp end task
+  !$omp end masked
+  !$omp end parallel
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-pinned-1.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-pinned-1.f90
index 0e6619b..46789dd 100644
--- a/gcc/testsuite/gfortran.dg/gomp/allocate-pinned-1.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/allocate-pinned-1.f90
@@ -11,6 +11,6 @@ subroutine f ()
   use m
   implicit none
   ! The "Sorry" is here temporarily only to avoid excess error failures.
-  integer, save :: i ! { dg-error "Sorry, !.OMP allocate for variable 'i' at .1. with SAVE attribute not yet implemented" }
+  integer, save :: i
   !$omp allocate(i) allocator(ompx_gnu_pinned_mem_alloc)
 end
diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-static-2.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-static-2.f90
new file mode 100644
index 0000000..3e4768e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/allocate-static-2.f90
@@ -0,0 +1,52 @@
+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
+
+module m
+use omp_lib_kinds, only: omp_default_mem_alloc
+implicit none
+integer a,b
+common /foo/ a,b  ! { dg-error "Sorry, !.OMP allocate for COMMON block variable 'foo' at .1. not supported" }
+!$omp allocate(/foo/) align(128) allocator(omp_default_mem_alloc)
+end
+
+subroutine sub
+use omp_lib_kinds
+implicit none
+integer a,b
+common /foo/ a,b  ! { dg-error "Sorry, !.OMP allocate for COMMON block variable 'foo' at .1. not supported" }
+!$omp allocate(/foo/) align(128) allocator(omp_default_mem_alloc)
+end
+
+subroutine outer
+contains
+subroutine inner
+use omp_lib_kinds
+implicit none
+integer a,b
+common /foo/ a,b  ! { dg-error "Sorry, !.OMP allocate for COMMON block variable 'foo' at .1. not supported" }
+!$omp allocate(/foo/) align(128) allocator(omp_default_mem_alloc)
+end
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-static.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-static.f90
new file mode 100644
index 0000000..e43dae5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/allocate-static.f90
@@ -0,0 +1,62 @@
+! { dg-do run }
+
+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
+
+module m
+  use iso_c_binding, only: c_intptr_t
+  use omp_lib_kinds, only: omp_default_mem_alloc
+  implicit none (type, external)
+
+  integer(c_intptr_t) :: intptr
+
+  integer :: A(4) = [1,2,3,4]
+  !$omp allocate(A) align(128) allocator(omp_default_mem_alloc)
+contains
+  subroutine f()
+    integer :: B(4) = [1,2,3,4]
+    !$omp allocate(B) align(256) allocator(omp_default_mem_alloc)
+
+    if (mod (transfer (loc (A), intptr), 128_c_intptr_t) /= 0) stop 1
+    if (mod (transfer (loc (B), intptr), 256_c_intptr_t) /= 0) stop 2
+
+    call inner()
+  contains
+    subroutine inner()
+      integer :: C(4) = [1,2,3,4]
+      !$omp allocate(C) align(1024) allocator(omp_default_mem_alloc)
+      if (mod (transfer (loc (A), intptr), 128_c_intptr_t) /= 0) stop 3
+      if (mod (transfer (loc (B), intptr), 256_c_intptr_t) /= 0) stop 4
+      if (mod (transfer (loc (C), intptr), 1024_c_intptr_t) /= 0) stop 5
+    end
+  end
+end
+
+use m
+implicit none (type, external)
+if (mod (transfer (loc (A), intptr), 128_c_intptr_t) /= 0) stop 6
+call f()
+end