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.

7 files changed, 261 insertions, 50 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