Fortran: Support OpenMP's 'allocate' directive for stack vars

gcc/fortran/ChangeLog:

	* gfortran.h (ext_attr_t): Add omp_allocate flag.
	* match.cc (gfc_free_omp_namelist): Void deleting same
	u2.allocator multiple times now that a sequence can use
	the same one.
	* openmp.cc (gfc_match_omp_clauses, gfc_match_omp_allocate): Use
	same allocator expr multiple times.
	(is_predefined_allocator): Make static.
	(gfc_resolve_omp_allocate): Update/extend restriction checks;
	remove sorry message.
	(resolve_omp_clauses): Reject corarrays in allocate/allocators
	directive.
	* parse.cc (check_omp_allocate_stmt): Permit procedure pointers
	here (rejected later) for less misleading diagnostic.
	* trans-array.cc (gfc_trans_auto_array_allocation): Propagate
	size for GOMP_alloc and location to which it should be added to.
	* trans-decl.cc (gfc_trans_deferred_vars): Handle 'omp allocate'
	for stack variables; sorry for static variables/common blocks.
	* trans-openmp.cc (gfc_trans_omp_clauses): Evaluate 'allocate'
	clause's allocator only once; fix adding expressions to the
	block.
	(gfc_trans_omp_single): Pass a block to gfc_trans_omp_clauses.

gcc/ChangeLog:

	* gimplify.cc (gimplify_bind_expr): Handle Fortran's
	'omp allocate' for stack variables.

libgomp/ChangeLog:

	* libgomp.texi (OpenMP Impl. Status): Mention that Fortran now
	supports the allocate directive for stack variables.
	* testsuite/libgomp.fortran/allocate-5.f90: New test.
	* testsuite/libgomp.fortran/allocate-6.f90: New test.
	* testsuite/libgomp.fortran/allocate-7.f90: New test.
	* testsuite/libgomp.fortran/allocate-8.f90: New test.

gcc/testsuite/ChangeLog:

	* c-c++-common/gomp/allocate-14.c: Fix directive name.
	* c-c++-common/gomp/allocate-15.c: Likewise.
	* c-c++-common/gomp/allocate-9.c: Fix comment typo.
	* gfortran.dg/gomp/allocate-4.f90: Remove sorry dg-error.
	* gfortran.dg/gomp/allocate-7.f90: Likewise.
	* gfortran.dg/gomp/allocate-10.f90: New test.
	* gfortran.dg/gomp/allocate-11.f90: New test.
	* gfortran.dg/gomp/allocate-12.f90: New test.
	* gfortran.dg/gomp/allocate-13.f90: New test.
	* gfortran.dg/gomp/allocate-14.f90: New test.
	* gfortran.dg/gomp/allocate-15.f90: New test.
	* gfortran.dg/gomp/allocate-8.f90: New test.
	* gfortran.dg/gomp/allocate-9.f90: New test.

21 files changed, 831 insertions, 97 deletions

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 6caf776..88f33b0 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1000,6 +1000,7 @@ typedef struct
   unsigned omp_declare_target:1;
   unsigned omp_declare_target_link:1;
   ENUM_BITFIELD (gfc_omp_device_type) omp_device_type:2;
+  unsigned omp_allocate:1;
 
   /* Mentioned in OACC DECLARE.  */
   unsigned oacc_declare_create:1;
diff --git a/gcc/fortran/match.cc b/gcc/fortran/match.cc
index c926f38..148a86b 100644
--- a/gcc/fortran/match.cc
+++ b/gcc/fortran/match.cc
@@ -5541,6 +5541,7 @@ gfc_free_omp_namelist (gfc_omp_namelist *name, bool free_ns,
 		       bool free_mem_traits_space)
 {
   gfc_omp_namelist *n;
+  gfc_expr *last_allocator = NULL;
 
   for (; name; name = n)
     {
@@ -5552,7 +5553,13 @@ gfc_free_omp_namelist (gfc_omp_namelist *name, bool free_ns,
       if (free_ns)
 	gfc_free_namespace (name->u2.ns);
       else if (free_align_allocator)
-	gfc_free_expr (name->u2.allocator);
+	{
+	  if (last_allocator != name->u2.allocator)
+	    {
+	      last_allocator = name->u2.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)
diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc
index 79b5ae0..1cc65d7 100644
--- a/gcc/fortran/openmp.cc
+++ b/gcc/fortran/openmp.cc
@@ -2032,11 +2032,9 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 
 	      for (gfc_omp_namelist *n = *head; n; n = n->next)
 		{
-		  n->u2.allocator = ((allocator)
-				     ? gfc_copy_expr (allocator) : NULL);
+		  n->u2.allocator = allocator;
 		  n->u.align = (align) ? gfc_copy_expr (align) : NULL;
 		}
-	      gfc_free_expr (allocator);
 	      gfc_free_expr (align);
 	      continue;
 	    }
@@ -4547,9 +4545,8 @@ gfc_match_omp_allocate (void)
       for (; vars; vars = vars->next)
 	{
 	  vars->u.align = (align) ? gfc_copy_expr (align) : NULL;
-	  vars->u2.allocator = ((allocator) ? gfc_copy_expr (allocator) : NULL);
+	  vars->u2.allocator = allocator;
 	}
-      gfc_free_expr (allocator);
       gfc_free_expr (align);
     }
   return MATCH_YES;
@@ -7191,7 +7188,7 @@ resolve_omp_udr_clause (gfc_omp_namelist *n, gfc_namespace *ns,
 /* Assume that a constant expression in the range 1 (omp_default_mem_alloc)
    to 8 (omp_thread_mem_alloc) range is fine.  The original symbol name is
    already lost during matching via gfc_match_expr.  */
-bool
+static bool
 is_predefined_allocator (gfc_expr *expr)
 {
   return (gfc_resolve_expr (expr)
@@ -7210,9 +7207,19 @@ void
 gfc_resolve_omp_allocate (gfc_namespace *ns, gfc_omp_namelist *list)
 {
   for (gfc_omp_namelist *n = list; n; n = n->next)
-    n->sym->mark = 0;
-  for (gfc_omp_namelist *n = list; n; n = n->next)
     {
+      if (n->sym->attr.result || n->sym->result == n->sym)
+	{
+	  gfc_error ("Unexpected function-result variable %qs at %L in "
+		     "declarative !$OMP ALLOCATE", n->sym->name, &n->where);
+	  continue;
+	}
+      if (ns->omp_allocate->sym->attr.proc_pointer)
+	{
+	  gfc_error ("Procedure pointer %qs not supported with !$OMP "
+		     "ALLOCATE at %L", n->sym->name, &n->where);
+	  continue;
+	}
       if (n->sym->attr.flavor != FL_VARIABLE)
 	{
 	  gfc_error ("Argument %qs at %L to declarative !$OMP ALLOCATE "
@@ -7220,8 +7227,7 @@ gfc_resolve_omp_allocate (gfc_namespace *ns, gfc_omp_namelist *list)
 		     &n->where);
 	  continue;
 	}
-      if (ns != n->sym->ns || n->sym->attr.use_assoc
-	  || n->sym->attr.host_assoc || n->sym->attr.imported)
+      if (ns != n->sym->ns || n->sym->attr.use_assoc || n->sym->attr.imported)
 	{
 	  gfc_error ("Argument %qs at %L to declarative !$OMP ALLOCATE shall be"
 		     " in the same scope as the variable declaration",
@@ -7234,7 +7240,13 @@ gfc_resolve_omp_allocate (gfc_namespace *ns, gfc_omp_namelist *list)
 		     "declarative !$OMP ALLOCATE", n->sym->name, &n->where);
 	  continue;
 	}
-      if (n->sym->mark)
+      if (n->sym->attr.codimension)
+	{
+	  gfc_error ("Unexpected coarray argument %qs as argument at %L to "
+		     "declarative !$OMP ALLOCATE", n->sym->name, &n->where);
+	  continue;
+	}
+      if (n->sym->attr.omp_allocate)
 	{
 	  if (n->sym->attr.in_common)
 	    {
@@ -7249,7 +7261,28 @@ gfc_resolve_omp_allocate (gfc_namespace *ns, gfc_omp_namelist *list)
 		       n->sym->name, &n->where);
 	  continue;
 	}
-      n->sym->mark = 1;
+      /* For 'equivalence(a,b)', a 'union_type {<type> a,b} equiv.0' is created
+	 with a value expression for 'a' as 'equiv.0.a' (likewise for b); while
+	 this can be handled, EQUIVALENCE is marked as obsolescent since Fortran
+	 2018 and also not widely used.  However, it could be supported,
+	 if needed. */
+      if (n->sym->attr.in_equivalence)
+	{
+	  gfc_error ("Sorry, EQUIVALENCE object %qs not supported with !$OMP "
+		     "ALLOCATE at %L", n->sym->name, &n->where);
+	  continue;
+	}
+      /* Similar for Cray pointer/pointee - they could be implemented but as
+	 common vendor extension but nowadays rarely used and requiring
+	 -fcray-pointer, there is no need to support them.  */
+      if (n->sym->attr.cray_pointer || n->sym->attr.cray_pointee)
+	{
+	  gfc_error ("Sorry, Cray pointers and pointees such as %qs are not "
+		     "supported with !$OMP ALLOCATE at %L",
+		     n->sym->name, &n->where);
+	  continue;
+	}
+      n->sym->attr.omp_allocate = 1;
       if ((n->sym->ts.type == BT_CLASS && n->sym->attr.class_ok
 	   && CLASS_DATA (n->sym)->attr.allocatable)
 	  || (n->sym->ts.type != BT_CLASS && n->sym->attr.allocatable))
@@ -7307,8 +7340,6 @@ gfc_resolve_omp_allocate (gfc_namespace *ns, gfc_omp_namelist *list)
 		   "%<omp_allocator_handle_kind%> kind at %L",
 		   &n->u2.allocator->where);
     }
-  gfc_error ("Sorry, declarative !$OMP ALLOCATE at %L not yet supported",
-	     &list->where);
 }
 
 /* Resolve ASSUME's and ASSUMES' assumption clauses.  Note that absent/contains
@@ -7897,6 +7928,9 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
 	    {
 	      if (n->sym == NULL)
 		continue;
+	      if (n->sym->attr.codimension)
+		gfc_error ("Unexpected coarray %qs in %<allocate%> at %L",
+			   n->sym->name, &n->where);
 	      for (a = code->block->next->ext.alloc.list; a; a = a->next)
 		if (a->expr->expr_type == EXPR_VARIABLE
 		    && a->expr->symtree->n.sym == n->sym)
diff --git a/gcc/fortran/parse.cc b/gcc/fortran/parse.cc
index 444baf4..e103ebe 100644
--- a/gcc/fortran/parse.cc
+++ b/gcc/fortran/parse.cc
@@ -833,18 +833,18 @@ check_omp_allocate_stmt (locus *loc)
 		      &n->expr->where, gfc_ascii_statement (ST_OMP_ALLOCATE));
 	  return false;
 	}
+      /* Procedure pointers are not allocatable; hence, we do not regard them as
+	 pointers here - and reject them later in gfc_resolve_omp_allocate.  */
       bool alloc_ptr;
       if (n->sym->ts.type == BT_CLASS && n->sym->attr.class_ok)
 	alloc_ptr = (CLASS_DATA (n->sym)->attr.allocatable
 		     || CLASS_DATA (n->sym)->attr.class_pointer);
       else
-	alloc_ptr = (n->sym->attr.allocatable || n->sym->attr.pointer
-		     || n->sym->attr.proc_pointer);
+	alloc_ptr = n->sym->attr.allocatable || n->sym->attr.pointer;
       if (alloc_ptr
 	  || (n->sym->ns && n->sym->ns->proc_name
 	      && (n->sym->ns->proc_name->attr.allocatable
-		  || n->sym->ns->proc_name->attr.pointer
-		  || n->sym->ns->proc_name->attr.proc_pointer)))
+		  || n->sym->ns->proc_name->attr.pointer)))
 	has_allocatable = true;
       else
 	has_non_allocatable = true;
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 8e94a9a..bbb81f4 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -82,6 +82,9 @@ along with GCC; see the file COPYING3.  If not see
 #include "tree.h"
 #include "gfortran.h"
 #include "gimple-expr.h"
+#include "tree-iterator.h"
+#include "stringpool.h"  /* Required by "attribs.h".  */
+#include "attribs.h" /* For lookup_attribute.  */
 #include "trans.h"
 #include "fold-const.h"
 #include "constructor.h"
@@ -6770,6 +6773,15 @@ gfc_trans_auto_array_allocation (tree decl, gfc_symbol * sym,
 	 gimplifier to allocate storage, and all that good stuff.  */
       tmp = fold_build1_loc (input_location, DECL_EXPR, TREE_TYPE (decl), decl);
       gfc_add_expr_to_block (&init, tmp);
+      if (sym->attr.omp_allocate)
+	{
+	  /* Save location of size calculation to ensure GOMP_alloc is placed
+	     after it.  */
+	  tree omp_alloc = lookup_attribute ("omp allocate",
+					     DECL_ATTRIBUTES (decl));
+	  TREE_CHAIN (TREE_CHAIN (TREE_VALUE (omp_alloc)))
+	    = build_tree_list (NULL_TREE, tsi_stmt (tsi_last (init.head)));
+	}
     }
 
   if (onstack)
@@ -6798,8 +6810,22 @@ gfc_trans_auto_array_allocation (tree decl, gfc_symbol * sym,
       gfc_add_init_cleanup (block, gfc_finish_block (&init), NULL_TREE);
       return;
     }
+  if (sym->attr.omp_allocate)
+    {
+      /* The size is the number of elements in the array, so multiply by the
+	 size of an element to get the total size.  */
+      tmp = TYPE_SIZE_UNIT (gfc_get_element_type (type));
+      size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+			      size, fold_convert (gfc_array_index_type, tmp));
+      size = gfc_evaluate_now (size, &init);
 
-  if (flag_stack_arrays)
+      tree omp_alloc = lookup_attribute ("omp allocate",
+					 DECL_ATTRIBUTES (decl));
+      TREE_CHAIN (TREE_CHAIN (TREE_VALUE (omp_alloc)))
+	= build_tree_list (size, NULL_TREE);
+      space = NULL_TREE;
+    }
+  else if (flag_stack_arrays)
     {
       gcc_assert (TREE_CODE (TREE_TYPE (decl)) == POINTER_TYPE);
       space = build_decl (gfc_get_location (&sym->declared_at),
diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index b0fd25e..a3f037b 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -48,6 +48,7 @@ along with GCC; see the file COPYING3.  If not see
 #include "gimplify.h"
 #include "omp-general.h"
 #include "attr-fnspec.h"
+#include "tree-iterator.h"
 
 #define MAX_LABEL_VALUE 99999
 
@@ -4652,6 +4653,36 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block)
   init_intent_out_dt (proc_sym, block);
   gfc_restore_backend_locus (&loc);
 
+  /* For some reasons, internal procedures point to the parent's
+     namespace.  Top-level procedure and variables inside BLOCK are fine.  */
+  gfc_namespace *omp_ns = proc_sym->ns;
+  if (proc_sym->ns->proc_name != proc_sym)
+    for (omp_ns = proc_sym->ns->contained; omp_ns;
+	 omp_ns = omp_ns->sibling)
+      if (omp_ns->proc_name == proc_sym)
+	break;
+
+  /* Add 'omp allocate' attribute for gfc_trans_auto_array_allocation and
+     unset attr.omp_allocate for 'omp allocate allocator(omp_default_mem_alloc),
+     which has the normal codepath except for an invalid-use check in the ME.
+     The main processing happens later in this function.  */
+  for (struct gfc_omp_namelist *n = omp_ns ? omp_ns->omp_allocate : NULL;
+       n; n = n->next)
+    if (!TREE_STATIC (n->sym->backend_decl))
+      {
+	/* Add empty entries - described and to be filled below.  */
+	tree tmp = build_tree_list (NULL_TREE, NULL_TREE);
+	TREE_CHAIN (tmp) = build_tree_list (NULL_TREE, NULL_TREE);
+	DECL_ATTRIBUTES (n->sym->backend_decl)
+	  = tree_cons (get_identifier ("omp allocate"), tmp,
+				       DECL_ATTRIBUTES (n->sym->backend_decl));
+	if (n->u.align == NULL
+	    && n->u2.allocator != NULL
+	    && n->u2.allocator->expr_type == EXPR_CONSTANT
+	    && mpz_cmp_si (n->u2.allocator->value.integer, 1) == 0)
+	  n->sym->attr.omp_allocate = 0;
+       }
+
   for (sym = proc_sym->tlink; sym != proc_sym; sym = sym->tlink)
     {
       bool alloc_comp_or_fini = (sym->ts.type == BT_DERIVED)
@@ -5105,6 +5136,101 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block)
 	gcc_unreachable ();
     }
 
+  /* Handle 'omp allocate'. This has to be after the block above as
+     gfc_add_init_cleanup (..., init, ...) puts 'init' of later calls
+     before earlier calls.  The code is a bit more complex as gfortran does
+     not really work with bind expressions / BIND_EXPR_VARS properly, i.e.
+     gimplify_bind_expr needs some help for placing the GOMP_alloc. Thus,
+     we pass on the location of the allocate-assignment expression and,
+     if the size is not constant, the size variable if Fortran computes this
+     differently. We also might add an expression location after which the
+     code has to be added, e.g. for character len expressions, which affect
+     the UNIT_SIZE.  */
+  gfc_expr *last_allocator = NULL;
+  if (omp_ns && omp_ns->omp_allocate)
+    {
+      if (!block->init || TREE_CODE (block->init) != STATEMENT_LIST)
+	{
+	  tree tmp = build1_v (LABEL_EXPR, gfc_build_label_decl (NULL_TREE));
+	  append_to_statement_list (tmp, &block->init);
+	}
+      if (!block->cleanup || TREE_CODE (block->cleanup) != STATEMENT_LIST)
+	{
+	  tree tmp = build1_v (LABEL_EXPR, gfc_build_label_decl (NULL_TREE));
+	  append_to_statement_list (tmp, &block->cleanup);
+	}
+    }
+  tree init_stmtlist = block->init;
+  tree cleanup_stmtlist = block->cleanup;
+  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;
+      }
+
   gfc_init_block (&tmpblock);
 
   for (f = gfc_sym_get_dummy_args (proc_sym); f; f = f->next)
diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc
index 2f116fd..7930f2f 100644
--- a/gcc/fortran/trans-openmp.cc
+++ b/gcc/fortran/trans-openmp.cc
@@ -2739,34 +2739,48 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 	      }
 	  break;
 	case OMP_LIST_ALLOCATE:
-	  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_ALLOCATE);
-		    OMP_CLAUSE_DECL (node) = t;
-		    if (n->u2.allocator)
-		      {
-			tree allocator_;
-			gfc_init_se (&se, NULL);
-			gfc_conv_expr (&se, n->u2.allocator);
-			allocator_ = gfc_evaluate_now (se.expr, block);
-			OMP_CLAUSE_ALLOCATE_ALLOCATOR (node) = allocator_;
-		      }
-		    if (n->u.align)
-		      {
-			tree align_;
-			gfc_init_se (&se, NULL);
-			gfc_conv_expr (&se, n->u.align);
-			align_ = gfc_evaluate_now (se.expr, block);
-			OMP_CLAUSE_ALLOCATE_ALIGN (node) = align_;
-		      }
-		    omp_clauses = gfc_trans_add_clause (node, omp_clauses);
-		  }
-	      }
+	  {
+	    tree allocator_ = NULL_TREE;
+	    gfc_expr *alloc_expr = NULL;
+	    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_ALLOCATE);
+		      OMP_CLAUSE_DECL (node) = t;
+		      if (n->u2.allocator)
+			{
+			  if (alloc_expr != n->u2.allocator)
+			    {
+			      gfc_init_se (&se, NULL);
+			      gfc_conv_expr (&se, n->u2.allocator);
+			      gfc_add_block_to_block (block, &se.pre);
+			      allocator_ = gfc_evaluate_now (se.expr, block);
+			      gfc_add_block_to_block (block, &se.post);
+			    }
+			  OMP_CLAUSE_ALLOCATE_ALLOCATOR (node) = allocator_;
+			}
+		      alloc_expr = n->u2.allocator;
+		      if (n->u.align)
+			{
+			  tree align_;
+			  gfc_init_se (&se, NULL);
+			  gfc_conv_expr (&se, n->u.align);
+			  gcc_assert (CONSTANT_CLASS_P (se.expr)
+				      && se.pre.head == NULL
+				      && se.post.head == NULL);
+			  align_ = se.expr;
+			  OMP_CLAUSE_ALLOCATE_ALIGN (node) = align_;
+			}
+		      omp_clauses = gfc_trans_add_clause (node, omp_clauses);
+		    }
+		}
+	      else
+		alloc_expr = n->u2.allocator;
+	    }
 	  break;
 	case OMP_LIST_LINEAR:
 	  {
@@ -7184,11 +7198,14 @@ gfc_trans_omp_sections (gfc_code *code, gfc_omp_clauses *clauses)
 static tree
 gfc_trans_omp_single (gfc_code *code, gfc_omp_clauses *clauses)
 {
-  tree omp_clauses = gfc_trans_omp_clauses (NULL, clauses, code->loc);
+  stmtblock_t block;
+  gfc_start_block (&block);
+  tree omp_clauses = gfc_trans_omp_clauses (&block, clauses, code->loc);
   tree stmt = gfc_trans_omp_code (code->block->next, true);
   stmt = build2_loc (gfc_get_location (&code->loc), OMP_SINGLE, void_type_node,
 		     stmt, omp_clauses);
-  return stmt;
+  gfc_add_expr_to_block (&block, stmt);
+  return gfc_finish_block (&block);
 }
 
 static tree
diff --git a/gcc/gimplify.cc b/gcc/gimplify.cc
index 9f4722f..9c617c2 100644
--- a/gcc/gimplify.cc
+++ b/gcc/gimplify.cc
@@ -1405,18 +1405,45 @@ gimplify_bind_expr (tree *expr_p, gimple_seq *pre_p)
 			   || alloc == NULL_TREE
 			   || !integer_onep (alloc)))
 		{
-		  tree tmp = build_pointer_type (TREE_TYPE (t));
-		  tree v = create_tmp_var (tmp, get_name (t));
-		  DECL_IGNORED_P (v) = 0;
-		  tmp = remove_attribute ("omp allocate", DECL_ATTRIBUTES (t));
-		  DECL_ATTRIBUTES (v)
-		    = tree_cons (get_identifier ("omp allocate var"),
-				 build_tree_list (NULL_TREE, t), tmp);
-		  tmp = build_fold_indirect_ref (v);
-		  TREE_THIS_NOTRAP (tmp) = 1;
-		  SET_DECL_VALUE_EXPR (t, tmp);
-		  DECL_HAS_VALUE_EXPR_P (t) = 1;
-		  tree sz = TYPE_SIZE_UNIT (TREE_TYPE (t));
+		  /* Fortran might already use a pointer type internally;
+		     use that pointer except for type(C_ptr) and type(C_funptr);
+		     note that normal proc pointers are rejected.  */
+		  tree type = TREE_TYPE (t);
+		  tree tmp, v;
+		  if (lang_GNU_Fortran ()
+		      && POINTER_TYPE_P (type)
+		      && TREE_TYPE (type) != void_type_node
+		      && TREE_CODE (TREE_TYPE (type)) != FUNCTION_TYPE)
+		    {
+		      type = TREE_TYPE (type);
+		      v = t;
+		    }
+		  else
+		    {
+		      tmp = build_pointer_type (type);
+		      v = create_tmp_var (tmp, get_name (t));
+		      DECL_IGNORED_P (v) = 0;
+		      DECL_ATTRIBUTES (v)
+			= tree_cons (get_identifier ("omp allocate var"),
+				     build_tree_list (NULL_TREE, t),
+				     DECL_ATTRIBUTES (t));
+		      tmp = build_fold_indirect_ref (v);
+		      TREE_THIS_NOTRAP (tmp) = 1;
+		      SET_DECL_VALUE_EXPR (t, tmp);
+		      DECL_HAS_VALUE_EXPR_P (t) = 1;
+		    }
+		  tree sz = TYPE_SIZE_UNIT (type);
+		  /* The size to use in Fortran might not match TYPE_SIZE_UNIT;
+		     hence, for some decls, a size variable is saved in the
+		     attributes; use it, if available.  */
+		  if (TREE_CHAIN (TREE_VALUE (attr))
+		      && TREE_CHAIN (TREE_CHAIN (TREE_VALUE (attr)))
+		      && TREE_PURPOSE (
+			   TREE_CHAIN (TREE_CHAIN (TREE_VALUE (attr)))))
+		    {
+		      sz = TREE_CHAIN (TREE_CHAIN (TREE_VALUE (attr)));
+		      sz = TREE_PURPOSE (sz);
+		    }
 		  if (alloc == NULL_TREE)
 		    alloc = build_zero_cst (ptr_type_node);
 		  if (align == NULL_TREE)
@@ -1425,28 +1452,93 @@ gimplify_bind_expr (tree *expr_p, gimple_seq *pre_p)
 		    align = build_int_cst (size_type_node,
 					   MAX (tree_to_uhwi (align),
 						DECL_ALIGN_UNIT (t)));
+		  location_t loc = DECL_SOURCE_LOCATION (t);
 		  tmp = builtin_decl_explicit (BUILT_IN_GOMP_ALLOC);
-		  tmp = build_call_expr_loc (DECL_SOURCE_LOCATION (t), tmp,
-					     3, align, sz, alloc);
-		  tmp = fold_build2_loc (DECL_SOURCE_LOCATION (t), MODIFY_EXPR,
-					 TREE_TYPE (v), v,
+		  tmp = build_call_expr_loc (loc, tmp, 3, align, sz, alloc);
+		  tmp = fold_build2_loc (loc, MODIFY_EXPR, TREE_TYPE (v), v,
 					 fold_convert (TREE_TYPE (v), tmp));
-		  gcc_assert (BIND_EXPR_BODY (bind_expr) != NULL_TREE
-			      && (TREE_CODE (BIND_EXPR_BODY (bind_expr))
-				  == STATEMENT_LIST));
-		  tree_stmt_iterator e = tsi_start (BIND_EXPR_BODY (bind_expr));
-		  while (!tsi_end_p (e))
+		  gcc_assert (BIND_EXPR_BODY (bind_expr) != NULL_TREE);
+		  /* Ensure that either TREE_CHAIN (TREE_VALUE (attr) is set
+		     and GOMP_FREE added here or that DECL_HAS_VALUE_EXPR_P (t)
+		     is set, using in a condition much further below.  */
+		  gcc_assert (DECL_HAS_VALUE_EXPR_P (t)
+			      || TREE_CHAIN (TREE_VALUE (attr)));
+		  if (TREE_CHAIN (TREE_VALUE (attr)))
 		    {
-		      if ((TREE_CODE (*e) == DECL_EXPR
-			   && TREE_OPERAND (*e, 0) == t)
-			  || (TREE_CODE (*e) == CLEANUP_POINT_EXPR
-			      && TREE_CODE (TREE_OPERAND (*e, 0)) == DECL_EXPR
-			      && TREE_OPERAND (TREE_OPERAND (*e, 0), 0) == t))
-		      break;
+		      /* Fortran is special as it does not have properly nest
+			 declarations in blocks.  And as there is no
+			 initializer, there is also no expression to look for.
+			 Hence, the FE makes the statement list of the
+			 try-finally block available. We can put the GOMP_alloc
+			 at the top, unless an allocator or size expression
+			 requires to put it afterward; note that the size is
+			 always later in generated code; for strings, no
+			 size expr but still an expr might be available.  */
+		      tree sl = TREE_PURPOSE (TREE_CHAIN (TREE_VALUE (attr)));
+		      tree_stmt_iterator e = tsi_start (sl);
+		      tree needle = NULL_TREE;
+		      if (TREE_CHAIN (TREE_CHAIN (TREE_VALUE (attr))))
+			{
+			  needle = TREE_CHAIN (TREE_CHAIN (TREE_VALUE (attr)));
+			  needle = (TREE_VALUE (needle) ? TREE_VALUE (needle)
+							: sz);
+			}
+		      else if (TREE_CHAIN (TREE_CHAIN (TREE_VALUE (attr))))
+			needle = sz;
+		      else if (DECL_P (alloc) && DECL_ARTIFICIAL (alloc))
+			needle = alloc;
+
+		      if (needle != NULL_TREE)
+			{
+			  while (!tsi_end_p (e))
+			    {
+			      if (*e == needle
+				  || (TREE_CODE (*e) == MODIFY_EXPR
+				      && TREE_OPERAND (*e, 0) == needle))
+				break;
+			      ++e;
+			    }
+			  gcc_assert (!tsi_end_p (e));
+			}
+		      tsi_link_after (&e, tmp, TSI_SAME_STMT);
+
+		      /* As the cleanup is in BIND_EXPR_BODY, GOMP_free is added
+			 here; for C/C++ it will be added in the 'cleanup'
+			 section after gimplification. But Fortran already has
+			 a try-finally block.  */
+		      sl = TREE_VALUE (TREE_CHAIN (TREE_VALUE (attr)));
+		      e = tsi_last (sl);
+		      tmp = builtin_decl_explicit (BUILT_IN_GOMP_FREE);
+		      tmp = build_call_expr_loc (EXPR_LOCATION (*e), tmp, 2, v,
+						 build_zero_cst (ptr_type_node));
+		      tsi_link_after (&e, tmp, TSI_SAME_STMT);
+		      tmp = build_clobber (TREE_TYPE (v), CLOBBER_EOL);
+		      tmp = fold_build2_loc (loc, MODIFY_EXPR, TREE_TYPE (v), v,
+					     fold_convert (TREE_TYPE (v), tmp));
 		      ++e;
+		      tsi_link_after (&e, tmp, TSI_SAME_STMT);
 		    }
-		  gcc_assert (!tsi_end_p (e));
-		  tsi_link_before (&e, tmp, TSI_SAME_STMT);
+		  else
+		    {
+		      gcc_assert (TREE_CODE (BIND_EXPR_BODY (bind_expr))
+				  == STATEMENT_LIST);
+		      tree_stmt_iterator e;
+		      e = tsi_start (BIND_EXPR_BODY (bind_expr));
+		      while (!tsi_end_p (e))
+			{
+			  if ((TREE_CODE (*e) == DECL_EXPR
+			       && TREE_OPERAND (*e, 0) == t)
+			      || (TREE_CODE (*e) == CLEANUP_POINT_EXPR
+				  && (TREE_CODE (TREE_OPERAND (*e, 0))
+				      == DECL_EXPR)
+				  && (TREE_OPERAND (TREE_OPERAND (*e, 0), 0)
+				      == t)))
+			    break;
+			  ++e;
+			}
+		      gcc_assert (!tsi_end_p (e));
+		      tsi_link_before (&e, tmp, TSI_SAME_STMT);
+		   }
 		}
 	    }
 
@@ -1539,16 +1631,26 @@ gimplify_bind_expr (tree *expr_p, gimple_seq *pre_p)
 	  && !is_global_var (t)
 	  && DECL_CONTEXT (t) == current_function_decl)
 	{
+	  tree attr;
 	  if (flag_openmp
 	      && DECL_HAS_VALUE_EXPR_P (t)
 	      && TREE_USED (t)
-	      && lookup_attribute ("omp allocate", DECL_ATTRIBUTES (t)))
+	      && ((attr = lookup_attribute ("omp allocate",
+					    DECL_ATTRIBUTES (t))) != NULL_TREE)
+	      && TREE_CHAIN (TREE_VALUE (attr)) == NULL_TREE)
 	    {
+	      /* For Fortran, TREE_CHAIN (TREE_VALUE (attr)) is set, which
+		 causes that the GOMP_free call is already added above.  */
+	      tree v = TREE_OPERAND (DECL_VALUE_EXPR (t), 0);
 	      tree tmp = builtin_decl_explicit (BUILT_IN_GOMP_FREE);
-	      tmp = build_call_expr_loc (end_locus, tmp, 2,
-					 TREE_OPERAND (DECL_VALUE_EXPR (t), 0),
+	      tmp = build_call_expr_loc (end_locus, tmp, 2, v,
 					 build_zero_cst (ptr_type_node));
 	      gimplify_and_add (tmp, &cleanup);
+	      gimple *clobber_stmt;
+	      tmp = build_clobber (TREE_TYPE (v), CLOBBER_EOL);
+	      clobber_stmt = gimple_build_assign (v, tmp);
+	      gimple_set_location (clobber_stmt, end_locus);
+	      gimplify_seq_add_stmt (&cleanup, clobber_stmt);
 	    }
 	  if (!DECL_HARD_REGISTER (t)
 	      && !TREE_THIS_VOLATILE (t)
diff --git a/gcc/testsuite/c-c++-common/gomp/allocate-14.c b/gcc/testsuite/c-c++-common/gomp/allocate-14.c
index b25da54..894921a 100644
--- a/gcc/testsuite/c-c++-common/gomp/allocate-14.c
+++ b/gcc/testsuite/c-c++-common/gomp/allocate-14.c
@@ -17,7 +17,7 @@ h ()
 {
   #pragma omp target
    #pragma omp parallel
-    #pragma omp serial
+    #pragma omp single
      {
        int var2[5];  /* { dg-error "'allocate' directive for 'var2' inside a target region must specify an 'allocator' clause" } */
        #pragma omp allocate(var2)
diff --git a/gcc/testsuite/c-c++-common/gomp/allocate-15.c b/gcc/testsuite/c-c++-common/gomp/allocate-15.c
index 15105b91..52cb768 100644
--- a/gcc/testsuite/c-c++-common/gomp/allocate-15.c
+++ b/gcc/testsuite/c-c++-common/gomp/allocate-15.c
@@ -19,7 +19,7 @@ h ()
 {
   #pragma omp target
    #pragma omp parallel
-    #pragma omp serial
+    #pragma omp single
      {
        int var2[5];
        #pragma omp allocate(var2)
diff --git a/gcc/testsuite/c-c++-common/gomp/allocate-9.c b/gcc/testsuite/c-c++-common/gomp/allocate-9.c
index 3c11080..3138274 100644
--- a/gcc/testsuite/c-c++-common/gomp/allocate-9.c
+++ b/gcc/testsuite/c-c++-common/gomp/allocate-9.c
@@ -20,7 +20,7 @@ typedef enum omp_allocator_handle_t
 static int A[5] = {1,2,3,4,5};
 int B, C, D;
 
-/* If the following fails bacause of added predefined allocators, please update
+/* If the following fails because of added predefined allocators, please update
    - c/c-parser.c's c_parser_omp_allocate
    - fortran/openmp.cc's is_predefined_allocator
    - libgomp/env.c's parse_allocator
diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-10.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-10.f90
new file mode 100644
index 0000000..e50db53
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/allocate-10.f90
@@ -0,0 +1,75 @@
+! { dg-additional-options "-Wall -fdump-tree-gimple" }
+
+module m
+use iso_c_binding
+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
+
+
+! { dg-final { scan-tree-dump-times "__builtin_GOMP_alloc" 3 "gimple" } }
+! { dg-final { scan-tree-dump-times "__builtin_GOMP_free" 3 "gimple" } }
+
+subroutine f
+  use m
+  implicit none
+  integer :: n
+  block
+    integer :: A(n) ! { dg-warning "Unused variable 'a' declared" }
+  end block
+end
+
+subroutine f2
+  use m
+  implicit none
+  integer :: n  ! { dg-note "'n' was declared here" }
+  block
+    integer :: A(n)  ! { dg-warning "'n' is used uninitialized" }
+    !$omp allocate(A)
+    ! by matching 'A' above, TREE_USE is set. Hence:
+    ! { dg-final { scan-tree-dump-times "a = __builtin_GOMP_alloc \\(., D\.\[0-9\]+, 0B\\);" 1 "gimple" } }
+    ! { dg-final { scan-tree-dump-times "__builtin_GOMP_free \\(a, 0B\\);" 1 "gimple" } }
+  end block
+end
+
+subroutine h1()
+  use m
+  implicit none
+  integer(omp_allocator_handle_kind) my_handle  ! { dg-note "'my_handle' was declared here" }
+  integer :: B1(3)
+  !$omp allocate(B1) allocator(my_handle)  ! { dg-warning "31:'my_handle' is used uninitialized" }
+  B1(1) = 5
+  ! { dg-final { scan-tree-dump-times "b1.\[0-9\]+ = __builtin_GOMP_alloc \\(4, 12, D\.\[0-9\]+\\);" 1 "gimple" } }
+  ! { dg-final { scan-tree-dump-times "__builtin_GOMP_free \\(b1.\[0-9\]+, 0B\\);" 1 "gimple" } }
+end
+
+subroutine h2()
+  use m
+  implicit none
+  integer(omp_allocator_handle_kind) my_handle  ! { dg-note "'my_handle' was declared here" }
+  block
+    integer :: B2(3)
+    !$omp allocate(B2) allocator(my_handle)  ! { dg-warning "33:'my_handle' is used uninitialized" }
+    ! Similar above; B2 is unused - but in gfortran, the match in 'allocate(B2)' already
+    ! causes TREE_USED = 1
+    ! { dg-final { scan-tree-dump-times "b2.\[0-9\]+ = __builtin_GOMP_alloc \\(4, 12, D\.\[0-9\]+\\);" 1 "gimple" } }
+    ! { dg-final { scan-tree-dump-times "__builtin_GOMP_free \\(b2.\[0-9\]+, 0B\\);" 1 "gimple" } }
+  end block
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-11.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-11.f90
new file mode 100644
index 0000000..8a8d939
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/allocate-11.f90
@@ -0,0 +1,33 @@
+module m
+use iso_c_binding
+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
+
+subroutine f ()
+  use m
+  implicit none
+  integer :: i
+  !$omp parallel firstprivate(i) allocate(allocator(omp_low_latency_mem_alloc): i)
+    ! { dg-error "Symbol 'omp_low_latency_mem_alloc' at .1. has no IMPLICIT type; did you mean 'omp_low_lat_mem_alloc'\\\?" "" { target *-*-* } .-1 }
+    ! { dg-error "Expected integer expression of the 'omp_allocator_handle_kind' kind at .1." "" { target *-*-* } .-2 }
+    i = 4
+  !$omp end parallel
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-12.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-12.f90
new file mode 100644
index 0000000..183c294
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/allocate-12.f90
@@ -0,0 +1,24 @@
+module m
+  implicit none
+contains
+subroutine f ()
+  !$omp declare target
+  integer :: var  ! { dg-error "'allocate' directive for 'var' inside a target region must specify an 'allocator' clause" }
+  !$omp allocate(var)
+  var = 5
+end
+
+subroutine h ()
+  !$omp target
+   !$omp parallel
+    !$omp single
+       block
+       integer :: var2(5)  ! { dg-error "'allocate' directive for 'var2' inside a target region must specify an 'allocator' clause" }
+         !$omp allocate(var2)
+         var2(1) = 7
+       end block
+    !$omp end single
+   !$omp end parallel
+  !$omp end target  
+end
+end module
diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-13.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-13.f90
new file mode 100644
index 0000000..bf8a5a2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/allocate-13.f90
@@ -0,0 +1,25 @@
+module m
+  implicit none
+  !$omp requires dynamic_allocators
+contains
+subroutine f ()
+  !$omp declare target
+  integer :: var
+  !$omp allocate(var)
+  var = 5
+end
+
+subroutine h ()
+  !$omp target
+   !$omp parallel
+    !$omp single
+      block
+       integer :: var2(5)
+       !$omp allocate(var2)
+       var2(1) = 7
+      end block
+    !$omp end single
+   !$omp end parallel
+  !$omp end target
+end
+end module
diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-14.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-14.f90
new file mode 100644
index 0000000..8ff9c25
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/allocate-14.f90
@@ -0,0 +1,95 @@
+! { dg-additional-options "-fcoarray=single -fcray-pointer" }
+
+module m
+use iso_c_binding
+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
+
+subroutine coarrays(x)
+  use m
+  implicit none
+
+  integer :: x[*]
+  integer, allocatable :: y[:], z(:)[:]
+
+  !$omp allocate(x)  ! { dg-error "Unexpected dummy argument 'x' as argument at .1. to declarative !.OMP ALLOCATE" }
+
+  !$omp allocators allocate(y) ! { dg-error "28:Unexpected coarray 'y' in 'allocate' at .1." }
+    allocate(y[*])
+
+  !$omp allocate(z) ! { dg-error "17:Unexpected coarray 'z' in 'allocate' at .1." }
+    allocate(z(5)[*])
+  x = 5
+end 
+
+
+integer function f() result(res)
+  !$omp allocate(f)   ! { dg-error "Argument 'f' at .1. to declarative !.OMP ALLOCATE directive must be a variable" }
+  !$omp allocate(res) ! { dg-error "Unexpected function-result variable 'res' at .1. in declarative !.OMP ALLOCATE" }
+  res = 5
+end
+
+integer function g() result(res)
+  allocatable :: res
+  !$omp allocators allocate(g)   ! { dg-error "Expected variable list at .1." }
+
+  !$omp allocators allocate (res)
+  allocate(res, source=5)
+  deallocate(res)
+
+  !$omp allocate (res)
+  allocate(res, source=5)
+end
+
+
+subroutine cray_ptr()
+   real pointee(10)
+   pointer (ipt, pointee)
+   !$omp allocate(pointee)  ! { dg-error "Sorry, Cray pointers and pointees such as 'pointee' are not supported with !.OMP ALLOCATE at .1." }
+   !$omp allocate(ipt)      ! { dg-error "Sorry, Cray pointers and pointees such as 'ipt' are not supported with !.OMP ALLOCATE at .1." }
+end
+
+subroutine equiv
+  integer :: A
+  real :: B(2)
+  equivalence(A,B)
+  !$omp allocate (A)  ! { dg-error "Sorry, EQUIVALENCE object 'a' not supported with !.OMP ALLOCATE at .1." }
+  !$omp allocate (B)  ! { dg-error "Sorry, EQUIVALENCE object 'b' not supported with !.OMP ALLOCATE at .1." }
+end
+
+subroutine common
+  use m
+  integer :: a,b,c(5)
+  common /my/ a,b,c
+  !$omp allocate(b) allocator(omp_cgroup_mem_alloc)  ! { dg-error "'b' at .1. is part of the common block '/my/' and may only be specificed implicitly via the named common block" }
+end
+
+subroutine c_and_func_ptrs
+  use iso_c_binding
+  implicit none
+  procedure(), pointer :: p
+  type(c_ptr) :: cptr
+  type(c_ptr) :: cfunptr
+
+  !$omp allocate(cptr)  ! OK
+  !$omp allocate(cfunptr) ! OK? A normal derived-type var?
+  !$omp allocate(p)  ! { dg-error "Argument 'p' at .1. to declarative !.OMP ALLOCATE directive must be a variable" }
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-15.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-15.f90
new file mode 100644
index 0000000..a0690a5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/allocate-15.f90
@@ -0,0 +1,38 @@
+module m
+use iso_c_binding
+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
+
+subroutine common
+  use m
+  integer :: a,b,c(5)
+  common /my/ a,b,c  ! { dg-error "Sorry, !.OMP allocate for COMMON block variable 'my' at .1. not supported" }
+  !$omp allocate(/my/) allocator(omp_cgroup_mem_alloc)
+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" }
+  !$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 a2dcf10..b93a37c 100644
--- a/gcc/testsuite/gfortran.dg/gomp/allocate-4.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/allocate-4.f90
@@ -33,13 +33,13 @@ integer(kind=omp_allocator_handle_kind), intent(in) :: my_alloc
 
 !stack variables:
 integer :: a,b,c(n),d(5),e(2)
-!$omp allocate(a)   ! { dg-error "Sorry, declarative !.OMP ALLOCATE at .1. not yet supported" }
+!$omp allocate(a)
 !$omp allocate ( b , c ) align ( 32) allocator (my_alloc)
 !$omp allocate (d) align( 128 )
 !$omp allocate(   e ) allocator( omp_high_bw_mem_alloc )
 
 !saved vars
-integer, save :: k,l,m(5),r(2)
+integer, save :: k,l,m(5),r(2)  ! { dg-error "Sorry, !.OMP allocate for variable 'k' at .1. with SAVE attribute not yet implemented" }
 !$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 )
diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-7.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-7.f90
index b856204..ab85e32 100644
--- a/gcc/testsuite/gfortran.dg/gomp/allocate-7.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/allocate-7.f90
@@ -47,7 +47,6 @@ integer, pointer :: ptr
 integer, parameter :: prm=5
 
 !$omp allocate(prm) align(64) ! { dg-error "Argument 'prm' at .1. to declarative !.OMP ALLOCATE directive must be a variable" }
-! { dg-error "Sorry, declarative !.OMP ALLOCATE at .1. not yet supported" "" { target *-*-* } .-1 }
 
 !$omp allocate(used) allocator(omp_pteam_mem_alloc)  ! { dg-error "Argument 'used' at .1. to declarative !.OMP ALLOCATE shall be in the same scope as the variable declaration" }
 !$omp allocate(n) allocator(omp_pteam_mem_alloc) ! { dg-error "Unexpected dummy argument 'n' as argument at .1. to declarative !.OMP ALLOCATE" }
@@ -59,7 +58,6 @@ contains
 
   subroutine inner
     !$omp allocate(a) allocator(omp_pteam_mem_alloc)  ! { dg-error "Argument 'a' at .1. to declarative !.OMP ALLOCATE shall be in the same scope as the variable declaration" }
-! { dg-error "Sorry, declarative !.OMP ALLOCATE at .1. not yet supported" "" { target *-*-* } .-1 }
   end
 end
 
@@ -74,7 +72,6 @@ common /com4/ y,z
 allocatable :: q
 pointer :: b
 !$omp allocate (c, d) allocator (omp_pteam_mem_alloc)
-! { dg-error "Sorry, declarative !.OMP ALLOCATE at .1. not yet supported" "" { target *-*-* } .-1 }
 !$omp allocate (/com4/) allocator (omp_pteam_mem_alloc)
 !$omp allocate (c) allocator (omp_pteam_mem_alloc) ! { dg-error "Duplicated variable 'c' in !.OMP ALLOCATE" }
 !$omp allocate (/com4/) allocator (omp_pteam_mem_alloc) ! { dg-error "Duplicated common block '/com4/' in !.OMP ALLOCATE" }
@@ -86,7 +83,6 @@ end
 subroutine four(n)
   integer :: qq, rr, ss, tt, uu, vv,n
 !$omp allocate (qq) align(3+n) ! { dg-error "ALIGN requires a scalar positive constant integer alignment expression at .1. that is a power of two" }
-! { dg-error "Sorry, declarative !.OMP ALLOCATE at .1. not yet supported" "" { target *-*-* } .-1 }
 !$omp allocate (rr) align([4]) ! { dg-error "ALIGN requires a scalar positive constant integer alignment expression at .1. that is a power of two" }
 !$omp allocate (ss) align([4]) ! { dg-error "ALIGN requires a scalar positive constant integer alignment expression at .1. that is a power of two" }
 !$omp allocate (tt) align(32.0) ! { dg-error "ALIGN requires a scalar positive constant integer alignment expression at .1. that is a power of two" }
@@ -99,7 +95,6 @@ subroutine five(n,my_alloc)
   integer :: qq, rr, ss, tt, uu, vv,n
   integer(omp_allocator_handle_kind) :: my_alloc
 !$omp allocate (qq) allocator(3.0)  ! { dg-error "Expected integer expression of the 'omp_allocator_handle_kind' kind" }
-! { dg-error "Sorry, declarative !.OMP ALLOCATE at .1. not yet supported" "" { target *-*-* } .-1 }
 !$omp allocate (rr) allocator(3_2)  ! { dg-error "Expected integer expression of the 'omp_allocator_handle_kind' kind" }
 !$omp allocate (ss) allocator([omp_pteam_mem_alloc])  ! { dg-error "Expected integer expression of the 'omp_allocator_handle_kind' kind" }
 !$omp allocate (tt) allocator(my_alloc)  ! OK
@@ -113,7 +108,6 @@ subroutine five_SaveAll(n,my_alloc)
   integer :: qq, rr, ss, tt, uu, vv,n
   integer(omp_allocator_handle_kind) :: my_alloc
 !$omp allocate (qq) allocator(3.0)  ! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item 'qq' at .2. has the SAVE attribute" }
-! { dg-error "Sorry, declarative !.OMP ALLOCATE at .1. not yet supported" "" { target *-*-* } .-1 }
 !$omp allocate (rr) allocator(3_2)  ! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item 'rr' at .2. has the SAVE attribute" }
 !$omp allocate (ss) allocator([omp_pteam_mem_alloc])  ! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item 'ss' at .2. has the SAVE attribute" }
 !$omp allocate (tt) allocator(my_alloc)  ! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item 'tt' at .2. has the SAVE attribute" }
@@ -127,7 +121,6 @@ subroutine five_Save(n,my_alloc)
   integer, save :: qq, rr, ss, tt, uu, vv
   integer(omp_allocator_handle_kind) :: my_alloc
 !$omp allocate (qq) allocator(3.0)  ! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item 'qq' at .2. has the SAVE attribute" }
-! { dg-error "Sorry, declarative !.OMP ALLOCATE at .1. not yet supported" "" { target *-*-* } .-1 }
 !$omp allocate (rr) allocator(3_2)  ! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item 'rr' at .2. has the SAVE attribute" }
 !$omp allocate (ss) allocator([omp_pteam_mem_alloc])  ! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item 'ss' at .2. has the SAVE attribute" }
 !$omp allocate (tt) allocator(my_alloc)  ! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item 'tt' at .2. has the SAVE attribute" }
@@ -139,7 +132,6 @@ module five_Module
   integer, save :: qq, rr, ss, tt, uu, vv,n
   integer(omp_allocator_handle_kind) :: my_alloc
 !$omp allocate (qq) allocator(3.0)  ! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item 'qq' at .2. has the SAVE attribute" }
-! { dg-error "Sorry, declarative !.OMP ALLOCATE at .1. not yet supported" "" { target *-*-* } .-1 }
 !$omp allocate (rr) allocator(3_2)  ! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item 'rr' at .2. has the SAVE attribute" }
 !$omp allocate (ss) allocator([omp_pteam_mem_alloc])  ! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item 'ss' at .2. has the SAVE attribute" }
 !$omp allocate (tt) allocator(my_alloc)  ! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item 'tt' at .2. has the SAVE attribute" }
@@ -151,7 +143,6 @@ program five_program
   integer, save :: qq, rr, ss, tt, uu, vv,n
   integer(omp_allocator_handle_kind) :: my_alloc
 !$omp allocate (qq) allocator(3.0)  ! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item 'qq' at .2. has the SAVE attribute" }
-! { dg-error "Sorry, declarative !.OMP ALLOCATE at .1. not yet supported" "" { target *-*-* } .-1 }
 !$omp allocate (rr) allocator(3_2)  ! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item 'rr' at .2. has the SAVE attribute" }
 !$omp allocate (ss) allocator([omp_pteam_mem_alloc])  ! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item 'ss' at .2. has the SAVE attribute" }
 !$omp allocate (tt) allocator(my_alloc)  ! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item 'tt' at .2. has the SAVE attribute" }
@@ -170,7 +161,6 @@ subroutine six(n,my_alloc)
   integer(omp_allocator_handle_kind) :: my_alloc
 
 !$omp allocate (/com6qq/) allocator(3.0)  ! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item '/com6qq/' at .2. has the SAVE attribute" }
-! { dg-error "Sorry, declarative !.OMP ALLOCATE at .1. not yet supported" "" { target *-*-* } .-1 }
 !$omp allocate (/com6rr/) allocator(3_2)  ! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item '/com6rr/' at .2. has the SAVE attribute" }
 !$omp allocate (/com6ss/) allocator([omp_pteam_mem_alloc])  ! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item '/com6ss/' at .2. has the SAVE attribute" }
 !$omp allocate (/com6tt/) allocator(my_alloc)  ! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item '/com6tt/' at .2. has the SAVE attribute" }
diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-8.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-8.f90
new file mode 100644
index 0000000..bb4d07d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/allocate-8.f90
@@ -0,0 +1,29 @@
+! { dg-additional-options "-fdump-tree-original" }
+
+module m
+  use iso_c_binding
+  !use omp_lib, only: omp_allocator_handle_kind
+  implicit none
+  integer, parameter :: omp_allocator_handle_kind = c_intptr_t
+  integer :: a = 0, b = 42, c = 0
+
+contains
+  integer(omp_allocator_handle_kind) function get_alloc()
+    allocatable :: get_alloc
+    get_alloc = 2_omp_allocator_handle_kind
+  end
+  subroutine foo ()
+  !$omp scope private (a) firstprivate (b) reduction (+: c) allocate ( get_alloc() : a , b , c)
+    if (b /= 42) &
+      error stop
+    a = 36
+    b = 15
+    c = c + 1
+  !$omp end scope
+  end
+end
+
+! { dg-final { scan-tree-dump "omp scope private\\(a\\) firstprivate\\(b\\) reduction\\(\\+:c\\) allocate\\(allocator\\(D\\.\[0-9\]+\\):a\\) allocate\\(allocator\\(D\\.\[0-9\]+\\):b\\) allocate\\(allocator\\(D\\.\[0-9\]+\\):c\\)" "original" } }
+
+! { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ = get_alloc \\(\\);\[\n\r\]+ *D\\.\[0-9\]+ = \\*D\\.\[0-9\]+;\[\n\r\]+ *__builtin_free \\(\\(void \\*\\) D\\.\[0-9\]+\\);" 1 "original" } }
+
diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-9.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-9.f90
new file mode 100644
index 0000000..4d95536
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/allocate-9.f90
@@ -0,0 +1,112 @@
+module m
+use iso_c_binding
+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 m2
+  use m
+  implicit none
+  integer :: A(5) = [1,2,3,4,5], A2, A3, A4, A5
+  integer :: B, C, D
+
+! If the following fails because of added predefined allocators, please update
+! - c/c-parser.c's c_parser_omp_allocate
+! - fortran/openmp.cc's is_predefined_allocator
+! - libgomp/env.c's parse_allocator
+! - libgomp/libgomp.texi (document the new values - multiple locations)
+! + ensure that the memory-spaces are also up to date.
+
+!$omp allocate(A) align(32) allocator(9_omp_allocator_handle_kind)  ! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item 'a' at .2. has the SAVE attribute" }
+
+! typo in allocator name:
+!$omp allocate(A2) allocator(omp_low_latency_mem_alloc)  ! { dg-error "Symbol 'omp_low_latency_mem_alloc' at .1. has no IMPLICIT type; did you mean 'omp_low_lat_mem_alloc'\\?" }
+! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item 'a2' at .2. has the SAVE attribute" "" { target *-*-* } .-1 }
+
+! align be const multiple of 2
+!$omp allocate(A3) align(31) allocator(omp_default_mem_alloc) ! { dg-error "ALIGN requires a scalar positive constant integer alignment expression at .1. that is a power of two" }
+
+! allocator missing (required as A is static)
+!$omp allocate(A4) align(32) ! { dg-error "An ALLOCATOR clause is required as the list item 'a4' at .1. has the SAVE attribute" }
+
+! "expression in the clause must be a constant expression that evaluates to one of the
+! predefined memory allocator values -> omp_low_lat_mem_alloc"
+!$omp allocate(B) allocator(omp_high_bw_mem_alloc+1_omp_allocator_handle_kind) align(32) ! OK: omp_low_lat_mem_alloc
+
+!$omp allocate(C) allocator(2_omp_allocator_handle_kind) ! OK: omp_large_cap_mem_alloc
+
+!$omp allocate(A5) align(32) allocator(omp_null_allocator) ! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item 'a5' at .2. has the SAVE attribute" }
+
+!$omp allocate(C) align(32) allocator(omp_large_cap_mem_alloc)  ! { dg-error "Duplicated variable 'c' in !.OMP ALLOCATE at .1." }
+
+contains
+
+integer function f()
+  !$omp allocate(D) align(32) allocator(omp_large_cap_mem_alloc) ! { dg-error "Argument 'd' at .1. to declarative !.OMP ALLOCATE shall be in the same scope as the variable declaration" }
+  f = A(1)
+end
+
+integer function g()
+  integer :: a2, b2
+  !$omp allocate(a2)
+  !$omp allocate(a2)  ! { dg-error "Duplicated variable 'a2' in !.OMP ALLOCATE at .1." }
+  a2=1; b2=2
+  block
+    integer :: c2
+    !$omp allocate(c2, b2) ! { dg-error "Argument 'b2' at .1. to declarative !.OMP ALLOCATE shall be in the same scope as the variable declaration" }
+    c2 = 3
+    g = c2+a2+b2
+  end block
+end
+
+integer function h(q)
+  integer :: q
+  !$omp allocate(q)  ! { dg-error "Unexpected dummy argument 'q' as argument at .1. to declarative !.OMP ALLOCATE" }
+  h = q
+end
+
+integer function k ()
+  integer, save :: var3 = 8
+  !$omp allocate(var3) allocator(-1_omp_allocator_handle_kind)  ! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item 'var3' at .2. has the SAVE attribute" }
+  k = var3
+end
+end module
+
+
+subroutine foo
+  integer :: a, b
+  integer :: c, d,h
+  !$omp allocate(a,b)
+  b = 1; d = 5
+contains
+subroutine internal
+  integer :: e,f
+  !$omp allocate(c,d)
+  ! { dg-error "Argument 'c' at .1. to declarative !.OMP ALLOCATE shall be in the same scope as the variable declaration" "" { target *-*-* } .-1 }
+  ! { dg-error "Argument 'd' at .1. to declarative !.OMP ALLOCATE shall be in the same scope as the variable declaration" "" { target *-*-* } .-2 }
+  !$omp allocate(e)
+  a = 1; c = 2; e = 4
+  block
+    !$omp allocate(f) ! { dg-error "Argument 'f' at .1. to declarative !.OMP ALLOCATE shall be in the same scope as the variable declaration" }
+    !$omp allocate(h) ! { dg-error "Argument 'h' at .1. to declarative !.OMP ALLOCATE shall be in the same scope as the variable declaration" }
+  end block
+end
+end