diff mbox series

[gfortran] Add support for allocate clause (OpenMP 5.0).

Message ID 20211022130502.2211568-1-abidh@codesourcery.com
State New
Headers show
Series [gfortran] Add support for allocate clause (OpenMP 5.0). | expand

Commit Message

Hafiz Abid Qadeer Oct. 22, 2021, 1:05 p.m. UTC
This patch adds support for OpenMP 5.0 allocate clause for fortran. It does not
yet support the allocator-modifier as specified in OpenMP 5.1. The allocate
clause is already supported in C/C++.

gcc/fortran/ChangeLog:

	* dump-parse-tree.c (show_omp_clauses): Handle OMP_LIST_ALLOCATE.
	* gfortran.h (OMP_LIST_ALLOCATE): New enum value.
	(allocate): New member in gfc_symbol.
	* openmp.c (enum omp_mask1): Add OMP_CLAUSE_ALLOCATE.
	(gfc_match_omp_clauses): Handle OMP_CLAUSE_ALLOCATE
	(OMP_PARALLEL_CLAUSES, OMP_DO_CLAUSES, OMP_SECTIONS_CLAUSES)
	(OMP_TASK_CLAUSES, OMP_TASKLOOP_CLAUSES, OMP_TARGET_CLAUSES)
	(OMP_TEAMS_CLAUSES, OMP_DISTRIBUTE_CLAUSES)
	(OMP_SINGLE_CLAUSES): Add OMP_CLAUSE_ALLOCATE.
	(OMP_TASKGROUP_CLAUSES): New
	(gfc_match_omp_taskgroup): Use 'OMP_TASKGROUP_CLAUSES' instead of
	'OMP_CLAUSE_TASK_REDUCTION'
	(resolve_omp_clauses): Handle OMP_LIST_ALLOCATE.
	(resolve_omp_do): Avoid warning when loop iteration variable is
	in allocate clause.
	* trans-openmp.c (gfc_trans_omp_clauses): Handle translation of
	allocate clause.
	(gfc_split_omp_clauses): Update for OMP_LIST_ALLOCATE.

gcc/testsuite/ChangeLog:

	* gfortran.dg/gomp/allocate-1.f90: New test.
	* gfortran.dg/gomp/allocate-2.f90: New test.
	* gfortran.dg/gomp/collapse1.f90: Update error message.
	* gfortran.dg/gomp/openmp-simd-4.f90: Likewise.

libgomp/ChangeLog:

	* testsuite/libgomp.fortran/allocate-1.c: New test.
	* testsuite/libgomp.fortran/allocate-1.f90: New test.
---
 gcc/fortran/dump-parse-tree.c                 |   1 +
 gcc/fortran/gfortran.h                        |   5 +
 gcc/fortran/openmp.c                          | 140 +++++++-
 gcc/fortran/trans-openmp.c                    |  34 ++
 gcc/testsuite/gfortran.dg/gomp/allocate-1.f90 | 123 +++++++
 gcc/testsuite/gfortran.dg/gomp/allocate-2.f90 |  45 +++
 gcc/testsuite/gfortran.dg/gomp/collapse1.f90  |   2 +-
 .../gfortran.dg/gomp/openmp-simd-4.f90        |   6 +-
 .../testsuite/libgomp.fortran/allocate-1.c    |   7 +
 .../testsuite/libgomp.fortran/allocate-1.f90  | 333 ++++++++++++++++++
 10 files changed, 675 insertions(+), 21 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/gomp/allocate-1.f90
 create mode 100644 gcc/testsuite/gfortran.dg/gomp/allocate-2.f90
 create mode 100644 libgomp/testsuite/libgomp.fortran/allocate-1.c
 create mode 100644 libgomp/testsuite/libgomp.fortran/allocate-1.f90

Comments

Tobias Burnus Oct. 22, 2021, 1:28 p.m. UTC | #1
Hi all,

On 22.10.21 15:05, Hafiz Abid Qadeer wrote:
> This patch adds support for OpenMP 5.0 allocate clause for fortran. It does not
> yet support the allocator-modifier as specified in OpenMP 5.1. The allocate
> clause is already supported in C/C++.

I think the following shouldn't block the acceptance of the patch,
but I think we eventually need to handle the following as well:

type t
   integer, allocatable :: xx(:)
end type

type(t) :: tt
class(t), allocatable :: cc

allocate(t :: cc)
tt%xx = [1,2,3,4,5,6]
cc%xx = [1,2,3,4,5,6]

! ...
!$omp task firstprivate(tt, cc) allocate(h)
  ...

In my spec reading, both tt/cc itself and tt%ii and cc%ii should
use the specified allocator.

And unless I missed something (I only glanced at the patch so far),
it is not handled.

But for derived types (except for recursive allocatables, valid since 5.1),
I think it can be handled in gfc_omp_clause_copy_ctor / gfc_omp_clause_dtor,
but I have not checked whether those support it properly.

For CLASS + recursive allocatables, it requires some more changes
(which might be provided by my derived-type deep copy patch,
of which only 1/3 has been written).

Tobias

PS: Just a side note, OpenMP has the following for Fortran:

"If any operation of the base language causes a reallocation
  of a variable that is allocated with a memory allocator then
  that memory allocator will be used to deallocate the current
  memory and to allocate the new memory. For allocated
  allocatable components of such variables, the allocator that
  will be used for the deallocation and allocation is unspecified."

-----------------
Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955
Jakub Jelinek Nov. 2, 2021, 4:27 p.m. UTC | #2
On Fri, Oct 22, 2021 at 02:05:02PM +0100, Hafiz Abid Qadeer wrote:
> This patch adds support for OpenMP 5.0 allocate clause for fortran. It does not
> yet support the allocator-modifier as specified in OpenMP 5.1. The allocate
> clause is already supported in C/C++.
> 
> gcc/fortran/ChangeLog:
> 
> 	* dump-parse-tree.c (show_omp_clauses): Handle OMP_LIST_ALLOCATE.
> 	* gfortran.h (OMP_LIST_ALLOCATE): New enum value.
> 	(allocate): New member in gfc_symbol.
> 	* openmp.c (enum omp_mask1): Add OMP_CLAUSE_ALLOCATE.
> 	(gfc_match_omp_clauses): Handle OMP_CLAUSE_ALLOCATE

Missing . at the end.

> 	(OMP_PARALLEL_CLAUSES, OMP_DO_CLAUSES, OMP_SECTIONS_CLAUSES)
> 	(OMP_TASK_CLAUSES, OMP_TASKLOOP_CLAUSES, OMP_TARGET_CLAUSES)
> 	(OMP_TEAMS_CLAUSES, OMP_DISTRIBUTE_CLAUSES)
> 	(OMP_SINGLE_CLAUSES): Add OMP_CLAUSE_ALLOCATE.
> 	(OMP_TASKGROUP_CLAUSES): New

Likewise.

> 	(gfc_match_omp_taskgroup): Use 'OMP_TASKGROUP_CLAUSES' instead of
> 	'OMP_CLAUSE_TASK_REDUCTION'

Likewise.  Please also drop the ' characters.

> @@ -1880,6 +1881,10 @@ typedef struct gfc_symbol
>       according to the Fortran standard.  */
>    unsigned pass_as_value:1;
>  
> +  /* Used to check if a variable used in allocate clause has also been
> +     used in privatization clause.  */
> +  unsigned allocate:1;

I think it would be desirable to use omp_allocate here instead
of allocate and mention OpenMP in the comment too.
Fortran has allocate statement in the language, so not pointing to
OpenMP would only cause confusion.

> @@ -1540,6 +1541,40 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
>  		}
>  	      continue;
>  	    }
> +	  if ((mask & OMP_CLAUSE_ALLOCATE)
> +	      && gfc_match ("allocate ( ") == MATCH_YES)
> +	    {
> +	      gfc_expr *allocator = NULL;
> +	      old_loc = gfc_current_locus;
> +	      m = gfc_match_expr (&allocator);
> +	      if (m != MATCH_YES)
> +		{
> +		  gfc_error ("Expected allocator or variable list at %C");
> +		  goto error;
> +		}
> +	      if (gfc_match (" : ") != MATCH_YES)
> +		{
> +		  /* If no ":" then there is no allocator, we backtrack
> +		     and read the variable list.  */
> +		  allocator = NULL;

Isn't this a memory leak?  I believe Fortran FE expressions are not GC
allocated...
So, shouldn't there be gfc_free_expr or something similar before clearing it?

> +  /* Check for 2 things here.
> +     1.  There is no duplication of variable in allocate clause.
> +     2.  Variable in allocate clause are also present in some
> +	 privatization clase.  */
> +  for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; n = n->next)
> +    n->sym->allocate = 0;
> +
> +  gfc_omp_namelist *prev = NULL;
> +  for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n;)
> +    {
> +      if (n->sym->allocate == 1)
> +	{
> +	  gfc_warning (0, "%qs appears more than once in %<allocate%> "
> +			  "clauses at %L" , n->sym->name, &n->where);
> +	  /* We have already seen this variable so it is a duplicate.
> +	     Remove it.  */
> +	  if (prev != NULL && prev->next == n)
> +	    {
> +	      prev->next = n->next;
> +	      n->next = NULL;
> +	      gfc_free_omp_namelist (n, 0);
> +	      n = prev->next;
> +	    }
> +
> +	  continue;
> +	}
> +      n->sym->allocate = 1;
> +      prev = n;
> +      n = n->next;
> +    }
> +
> +  for (list = 0; list < OMP_LIST_NUM; list++)
> +    switch (list)
> +      {
> +      case OMP_LIST_PRIVATE:
> +      case OMP_LIST_FIRSTPRIVATE:
> +      case OMP_LIST_LASTPRIVATE:
> +      case OMP_LIST_REDUCTION:
> +      case OMP_LIST_REDUCTION_INSCAN:
> +      case OMP_LIST_REDUCTION_TASK:
> +      case OMP_LIST_IN_REDUCTION:
> +      case OMP_LIST_TASK_REDUCTION:
> +      case OMP_LIST_LINEAR:
> +	for (n = omp_clauses->lists[list]; n; n = n->next)
> +	  n->sym->allocate = 0;
> +	break;
> +      default:
> +	break;
> +      }
> +
> +  for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; n = n->next)
> +    if (n->sym->allocate == 1)
> +      gfc_error ("%qs specified in 'allocate' clause at %L but not in an "
> +		 "explicit privatization clause", n->sym->name, &n->where);

I'm not sure this is what the standard says, certainly C/C++ FE do this
quite differently for combined/composite constructs.
In particular, we first split the clauses to the individual leaf constructs
in c_omp_split_clauses, which for allocate clause is even more complicated
because as clarified in 5.2:
"The effect of the allocate clause is as if it is applied to all leaf constructs that permit the clause
and to which a data-sharing attribute clause that may create a private copy of the same list item is
applied."
so there is the has_dup_allocate stuff, we first duplicate it to all leaf
constructs that allow the allocate clause and set has_dup_allocate if it is
put on more than one construct, and then if has_dup_allocate is set, do
more detailed processing.  And finally then {,c_}finish_omp_clauses
diagnoses what you are trying above, but only on each leaf construct
separately.

Now, Fortran is performing the splitting of clauses only much later in
trans-openmp.c, I wonder if it doesn't have other issues on
combined/composite constructs if it performs other checks only on the
clauses on the whole combined/composite construct and not just each leaf
separately.  I'd say we should move that diagnostics and perhaps other
similar later on into a separate routine that is invoked only after the
clauses are split or for non-combined/composite construct clauses.

	Jakub
Jakub Jelinek Nov. 2, 2021, 5:54 p.m. UTC | #3
On Tue, Nov 02, 2021 at 05:27:14PM +0100, Jakub Jelinek via Gcc-patches wrote:
> I'm not sure this is what the standard says, certainly C/C++ FE do this
> quite differently for combined/composite constructs.
> In particular, we first split the clauses to the individual leaf constructs
> in c_omp_split_clauses, which for allocate clause is even more complicated
> because as clarified in 5.2:
> "The effect of the allocate clause is as if it is applied to all leaf constructs that permit the clause
> and to which a data-sharing attribute clause that may create a private copy of the same list item is
> applied."
> so there is the has_dup_allocate stuff, we first duplicate it to all leaf
> constructs that allow the allocate clause and set has_dup_allocate if it is
> put on more than one construct, and then if has_dup_allocate is set, do
> more detailed processing.  And finally then {,c_}finish_omp_clauses
> diagnoses what you are trying above, but only on each leaf construct
> separately.
> 
> Now, Fortran is performing the splitting of clauses only much later in
> trans-openmp.c, I wonder if it doesn't have other issues on
> combined/composite constructs if it performs other checks only on the
> clauses on the whole combined/composite construct and not just each leaf
> separately.  I'd say we should move that diagnostics and perhaps other
> similar later on into a separate routine that is invoked only after the
> clauses are split or for non-combined/composite construct clauses.

Testcases unrelated to allocate clause that have same problematic behavior:

void
foo (int x)
{
  #pragma omp parallel for simd shared (x) private (x)
  for (int i = 0; i < 32; i++)
    ;
}

is correctly accepted, as per
Clauses on Combined and Composite Constructs
shared clause goes to parallel construct, private goes to innermost
leaf aka simd, so there is no leaf construct with multiple data sharing
clauses for x.

But:

subroutine foo (x)
  integer :: x, i
  !$omp parallel do simd shared (x) private (x)
  do i = 1, 32
  end do
end subroutine

is incorrectly rejected with:
    3 |   !$omp parallel do simd shared (x) private (x)
      |                                 1
Error: Symbol ‘x’ present on multiple clauses at (1)

	Jakub
Hafiz Abid Qadeer Nov. 18, 2021, 7:30 p.m. UTC | #4
On 02/11/2021 16:27, Jakub Jelinek wrote:
> On Fri, Oct 22, 2021 at 02:05:02PM +0100, Hafiz Abid Qadeer wrote:
>> This patch adds support for OpenMP 5.0 allocate clause for fortran. It does not
>> yet support the allocator-modifier as specified in OpenMP 5.1. The allocate
>> clause is already supported in C/C++.
>>
>> gcc/fortran/ChangeLog:
>>
>> 	* dump-parse-tree.c (show_omp_clauses): Handle OMP_LIST_ALLOCATE.
>> 	* gfortran.h (OMP_LIST_ALLOCATE): New enum value.
>> 	(allocate): New member in gfc_symbol.
>> 	* openmp.c (enum omp_mask1): Add OMP_CLAUSE_ALLOCATE.
>> 	(gfc_match_omp_clauses): Handle OMP_CLAUSE_ALLOCATE
> 
> Missing . at the end.
Done.

> 
>> 	(OMP_PARALLEL_CLAUSES, OMP_DO_CLAUSES, OMP_SECTIONS_CLAUSES)
>> 	(OMP_TASK_CLAUSES, OMP_TASKLOOP_CLAUSES, OMP_TARGET_CLAUSES)
>> 	(OMP_TEAMS_CLAUSES, OMP_DISTRIBUTE_CLAUSES)
>> 	(OMP_SINGLE_CLAUSES): Add OMP_CLAUSE_ALLOCATE.
>> 	(OMP_TASKGROUP_CLAUSES): New
> 
> Likewise.
Done.

> 
>> 	(gfc_match_omp_taskgroup): Use 'OMP_TASKGROUP_CLAUSES' instead of
>> 	'OMP_CLAUSE_TASK_REDUCTION'
> 
> Likewise.  Please also drop the ' characters.
Done.

> 
>> @@ -1880,6 +1881,10 @@ typedef struct gfc_symbol
>>       according to the Fortran standard.  */
>>    unsigned pass_as_value:1;
>>  
>> +  /* Used to check if a variable used in allocate clause has also been
>> +     used in privatization clause.  */
>> +  unsigned allocate:1;
> 
> I think it would be desirable to use omp_allocate here instead
> of allocate and mention OpenMP in the comment too.
> Fortran has allocate statement in the language, so not pointing to
> OpenMP would only cause confusion.
Done.

> 
>> @@ -1540,6 +1541,40 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
>>  		}
>>  	      continue;
>>  	    }
>> +	  if ((mask & OMP_CLAUSE_ALLOCATE)
>> +	      && gfc_match ("allocate ( ") == MATCH_YES)
>> +	    {
>> +	      gfc_expr *allocator = NULL;
>> +	      old_loc = gfc_current_locus;
>> +	      m = gfc_match_expr (&allocator);
>> +	      if (m != MATCH_YES)
>> +		{
>> +		  gfc_error ("Expected allocator or variable list at %C");
>> +		  goto error;
>> +		}
>> +	      if (gfc_match (" : ") != MATCH_YES)
>> +		{
>> +		  /* If no ":" then there is no allocator, we backtrack
>> +		     and read the variable list.  */
>> +		  allocator = NULL;
> 
> Isn't this a memory leak?  I believe Fortran FE expressions are not GC
> allocated...
> So, shouldn't there be gfc_free_expr or something similar before clearing it?
Done. Also added a call to gfc_free_expr at the end to free it as n->expr points
to a copy.

> 
>> +  /* Check for 2 things here.
>> +     1.  There is no duplication of variable in allocate clause.
>> +     2.  Variable in allocate clause are also present in some
>> +	 privatization clase.  */
>> +  for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; n = n->next)
>> +    n->sym->allocate = 0;
>> +
>> +  gfc_omp_namelist *prev = NULL;
>> +  for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n;)
>> +    {
>> +      if (n->sym->allocate == 1)
>> +	{
>> +	  gfc_warning (0, "%qs appears more than once in %<allocate%> "
>> +			  "clauses at %L" , n->sym->name, &n->where);
>> +	  /* We have already seen this variable so it is a duplicate.
>> +	     Remove it.  */
>> +	  if (prev != NULL && prev->next == n)
>> +	    {
>> +	      prev->next = n->next;
>> +	      n->next = NULL;
>> +	      gfc_free_omp_namelist (n, 0);
>> +	      n = prev->next;
>> +	    }
>> +
>> +	  continue;
>> +	}
>> +      n->sym->allocate = 1;
>> +      prev = n;
>> +      n = n->next;
>> +    }
>> +
>> +  for (list = 0; list < OMP_LIST_NUM; list++)
>> +    switch (list)
>> +      {
>> +      case OMP_LIST_PRIVATE:
>> +      case OMP_LIST_FIRSTPRIVATE:
>> +      case OMP_LIST_LASTPRIVATE:
>> +      case OMP_LIST_REDUCTION:
>> +      case OMP_LIST_REDUCTION_INSCAN:
>> +      case OMP_LIST_REDUCTION_TASK:
>> +      case OMP_LIST_IN_REDUCTION:
>> +      case OMP_LIST_TASK_REDUCTION:
>> +      case OMP_LIST_LINEAR:
>> +	for (n = omp_clauses->lists[list]; n; n = n->next)
>> +	  n->sym->allocate = 0;
>> +	break;
>> +      default:
>> +	break;
>> +      }
>> +
>> +  for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; n = n->next)
>> +    if (n->sym->allocate == 1)
>> +      gfc_error ("%qs specified in 'allocate' clause at %L but not in an "
>> +		 "explicit privatization clause", n->sym->name, &n->where);
> 
> I'm not sure this is what the standard says, certainly C/C++ FE do this
> quite differently for combined/composite constructs.
> In particular, we first split the clauses to the individual leaf constructs
> in c_omp_split_clauses, which for allocate clause is even more complicated
> because as clarified in 5.2:
> "The effect of the allocate clause is as if it is applied to all leaf constructs that permit the clause
> and to which a data-sharing attribute clause that may create a private copy of the same list item is
> applied."
> so there is the has_dup_allocate stuff, we first duplicate it to all leaf
> constructs that allow the allocate clause and set has_dup_allocate if it is
> put on more than one construct, and then if has_dup_allocate is set, do
> more detailed processing.  And finally then {,c_}finish_omp_clauses
> diagnoses what you are trying above, but only on each leaf construct
> separately.
> 
> Now, Fortran is performing the splitting of clauses only much later in
> trans-openmp.c, I wonder if it doesn't have other issues on
> combined/composite constructs if it performs other checks only on the
> clauses on the whole combined/composite construct and not just each leaf
> separately.  I'd say we should move that diagnostics and perhaps other
> similar later on into a separate routine that is invoked only after the
> clauses are split or for non-combined/composite construct clauses.

Updated patch keeps the old code but restricts it to non-composite case. For composite constructs, I
have added code at the end of gfc_split_omp_clauses to copy allocate clause to all leaf constructs
which allow it and have a privatization clause. A new testcase checks for error in this case.

Thanks
diff mbox series

Patch

diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
index 14a307856fc..66af802ec36 100644
--- a/gcc/fortran/dump-parse-tree.c
+++ b/gcc/fortran/dump-parse-tree.c
@@ -1685,6 +1685,7 @@  show_omp_clauses (gfc_omp_clauses *omp_clauses)
 	  case OMP_LIST_USE_DEVICE_PTR: type = "USE_DEVICE_PTR"; break;
 	  case OMP_LIST_USE_DEVICE_ADDR: type = "USE_DEVICE_ADDR"; break;
 	  case OMP_LIST_NONTEMPORAL: type = "NONTEMPORAL"; break;
+	  case OMP_LIST_ALLOCATE: type = "ALLOCATE"; break;
 	  case OMP_LIST_SCAN_IN: type = "INCLUSIVE"; break;
 	  case OMP_LIST_SCAN_EX: type = "EXCLUSIVE"; break;
 	  default:
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 66192c07d8c..feae00052cc 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1388,6 +1388,7 @@  enum
   OMP_LIST_USE_DEVICE_PTR,
   OMP_LIST_USE_DEVICE_ADDR,
   OMP_LIST_NONTEMPORAL,
+  OMP_LIST_ALLOCATE,
   OMP_LIST_NUM
 };
 
@@ -1880,6 +1881,10 @@  typedef struct gfc_symbol
      according to the Fortran standard.  */
   unsigned pass_as_value:1;
 
+  /* Used to check if a variable used in allocate clause has also been
+     used in privatization clause.  */
+  unsigned allocate:1;
+
   int refs;
   struct gfc_namespace *ns;	/* namespace containing this symbol */
 
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index dcf22ac2c2f..aac8d2580a4 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -911,6 +911,7 @@  enum omp_mask1
   OMP_CLAUSE_MEMORDER,  /* OpenMP 5.0.  */
   OMP_CLAUSE_DETACH,  /* OpenMP 5.0.  */
   OMP_CLAUSE_AFFINITY,  /* OpenMP 5.0.  */
+  OMP_CLAUSE_ALLOCATE,  /* OpenMP 5.0.  */
   OMP_CLAUSE_BIND,  /* OpenMP 5.0.  */
   OMP_CLAUSE_FILTER,  /* OpenMP 5.1.  */
   OMP_CLAUSE_AT,  /* OpenMP 5.1.  */
@@ -1540,6 +1541,40 @@  gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 		}
 	      continue;
 	    }
+	  if ((mask & OMP_CLAUSE_ALLOCATE)
+	      && gfc_match ("allocate ( ") == MATCH_YES)
+	    {
+	      gfc_expr *allocator = NULL;
+	      old_loc = gfc_current_locus;
+	      m = gfc_match_expr (&allocator);
+	      if (m != MATCH_YES)
+		{
+		  gfc_error ("Expected allocator or variable list at %C");
+		  goto error;
+		}
+	      if (gfc_match (" : ") != MATCH_YES)
+		{
+		  /* If no ":" then there is no allocator, we backtrack
+		     and read the variable list.  */
+		  allocator = NULL;
+		  gfc_current_locus = old_loc;
+		}
+
+	      gfc_omp_namelist **head = NULL;
+	      m = gfc_match_omp_variable_list ("", &c->lists[OMP_LIST_ALLOCATE],
+					       false, NULL, &head);
+
+	      if (m == MATCH_ERROR)
+		break;
+
+	      gfc_omp_namelist *n;
+	      for (n = *head; n; n = n->next)
+		if (allocator)
+		  n->expr = gfc_copy_expr (allocator);
+		else
+		  n->expr = NULL;
+	      continue;
+	    }
 	  if ((mask & OMP_CLAUSE_AT)
 	      && (m = gfc_match_dupl_check (c->at == OMP_AT_UNSET, "at", true))
 		 != MATCH_NO)
@@ -3511,7 +3546,7 @@  cleanup:
   (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE		\
    | OMP_CLAUSE_SHARED | OMP_CLAUSE_COPYIN | OMP_CLAUSE_REDUCTION	\
    | OMP_CLAUSE_IF | OMP_CLAUSE_NUM_THREADS | OMP_CLAUSE_DEFAULT	\
-   | OMP_CLAUSE_PROC_BIND)
+   | OMP_CLAUSE_PROC_BIND | OMP_CLAUSE_ALLOCATE)
 #define OMP_DECLARE_SIMD_CLAUSES \
   (omp_mask (OMP_CLAUSE_SIMDLEN) | OMP_CLAUSE_LINEAR			\
    | OMP_CLAUSE_UNIFORM	| OMP_CLAUSE_ALIGNED | OMP_CLAUSE_INBRANCH	\
@@ -3520,15 +3555,16 @@  cleanup:
   (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE		\
    | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION			\
    | OMP_CLAUSE_SCHEDULE | OMP_CLAUSE_ORDERED | OMP_CLAUSE_COLLAPSE	\
-   | OMP_CLAUSE_LINEAR | OMP_CLAUSE_ORDER)
+   | OMP_CLAUSE_LINEAR | OMP_CLAUSE_ORDER | OMP_CLAUSE_ALLOCATE)
 #define OMP_LOOP_CLAUSES \
   (omp_mask (OMP_CLAUSE_BIND) | OMP_CLAUSE_COLLAPSE | OMP_CLAUSE_ORDER	\
    | OMP_CLAUSE_PRIVATE | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION)
+
 #define OMP_SCOPE_CLAUSES \
   (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_REDUCTION)
 #define OMP_SECTIONS_CLAUSES \
   (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE		\
-   | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION)
+   | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION | OMP_CLAUSE_ALLOCATE)
 #define OMP_SIMD_CLAUSES \
   (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_LASTPRIVATE		\
    | OMP_CLAUSE_REDUCTION | OMP_CLAUSE_COLLAPSE | OMP_CLAUSE_SAFELEN	\
@@ -3539,19 +3575,22 @@  cleanup:
    | OMP_CLAUSE_SHARED | OMP_CLAUSE_IF | OMP_CLAUSE_DEFAULT		\
    | OMP_CLAUSE_UNTIED | OMP_CLAUSE_FINAL | OMP_CLAUSE_MERGEABLE	\
    | OMP_CLAUSE_DEPEND | OMP_CLAUSE_PRIORITY | OMP_CLAUSE_IN_REDUCTION	\
-   | OMP_CLAUSE_DETACH | OMP_CLAUSE_AFFINITY)
+   | OMP_CLAUSE_DETACH | OMP_CLAUSE_AFFINITY | OMP_CLAUSE_ALLOCATE)
 #define OMP_TASKLOOP_CLAUSES \
   (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE		\
    | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_SHARED | OMP_CLAUSE_IF		\
    | OMP_CLAUSE_DEFAULT | OMP_CLAUSE_UNTIED | OMP_CLAUSE_FINAL		\
    | OMP_CLAUSE_MERGEABLE | OMP_CLAUSE_PRIORITY | OMP_CLAUSE_GRAINSIZE	\
    | OMP_CLAUSE_NUM_TASKS | OMP_CLAUSE_COLLAPSE | OMP_CLAUSE_NOGROUP	\
-   | OMP_CLAUSE_REDUCTION | OMP_CLAUSE_IN_REDUCTION)
+   | OMP_CLAUSE_REDUCTION | OMP_CLAUSE_IN_REDUCTION | OMP_CLAUSE_ALLOCATE)
+#define OMP_TASKGROUP_CLAUSES \
+  (omp_mask (OMP_CLAUSE_TASK_REDUCTION) | OMP_CLAUSE_ALLOCATE)
 #define OMP_TARGET_CLAUSES \
   (omp_mask (OMP_CLAUSE_DEVICE) | OMP_CLAUSE_MAP | OMP_CLAUSE_IF	\
    | OMP_CLAUSE_DEPEND | OMP_CLAUSE_NOWAIT | OMP_CLAUSE_PRIVATE		\
    | OMP_CLAUSE_FIRSTPRIVATE | OMP_CLAUSE_DEFAULTMAP			\
-   | OMP_CLAUSE_IS_DEVICE_PTR | OMP_CLAUSE_IN_REDUCTION)
+   | OMP_CLAUSE_IS_DEVICE_PTR | OMP_CLAUSE_IN_REDUCTION			\
+   | OMP_CLAUSE_ALLOCATE)
 #define OMP_TARGET_DATA_CLAUSES \
   (omp_mask (OMP_CLAUSE_DEVICE) | OMP_CLAUSE_MAP | OMP_CLAUSE_IF	\
    | OMP_CLAUSE_USE_DEVICE_PTR | OMP_CLAUSE_USE_DEVICE_ADDR)
@@ -3567,13 +3606,14 @@  cleanup:
 #define OMP_TEAMS_CLAUSES \
   (omp_mask (OMP_CLAUSE_NUM_TEAMS) | OMP_CLAUSE_THREAD_LIMIT		\
    | OMP_CLAUSE_DEFAULT | OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE	\
-   | OMP_CLAUSE_SHARED | OMP_CLAUSE_REDUCTION)
+   | OMP_CLAUSE_SHARED | OMP_CLAUSE_REDUCTION | OMP_CLAUSE_ALLOCATE)
 #define OMP_DISTRIBUTE_CLAUSES \
   (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE		\
    | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_COLLAPSE | OMP_CLAUSE_DIST_SCHEDULE \
-   | OMP_CLAUSE_ORDER)
+   | OMP_CLAUSE_ORDER | OMP_CLAUSE_ALLOCATE)
 #define OMP_SINGLE_CLAUSES \
-  (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE)
+  (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE		\
+   | OMP_CLAUSE_ALLOCATE)
 #define OMP_ORDERED_CLAUSES \
   (omp_mask (OMP_CLAUSE_THREADS) | OMP_CLAUSE_SIMD)
 #define OMP_DECLARE_TARGET_CLAUSES \
@@ -5836,7 +5876,7 @@  gfc_match_omp_barrier (void)
 match
 gfc_match_omp_taskgroup (void)
 {
-  return match_omp (EXEC_OMP_TASKGROUP, OMP_CLAUSE_TASK_REDUCTION);
+  return match_omp (EXEC_OMP_TASKGROUP, OMP_TASKGROUP_CLAUSES);
 }
 
 
@@ -6174,7 +6214,7 @@  resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
 	"IN_REDUCTION", "TASK_REDUCTION",
 	"DEVICE_RESIDENT", "LINK", "USE_DEVICE",
 	"CACHE", "IS_DEVICE_PTR", "USE_DEVICE_PTR", "USE_DEVICE_ADDR",
-	"NONTEMPORAL" };
+	"NONTEMPORAL", "ALLOCATE" };
   STATIC_ASSERT (ARRAY_SIZE (clause_names) == OMP_LIST_NUM);
 
   if (omp_clauses == NULL)
@@ -6457,7 +6497,8 @@  resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
 	&& list != OMP_LIST_REDUCTION_INSCAN
 	&& list != OMP_LIST_REDUCTION_TASK
 	&& list != OMP_LIST_IN_REDUCTION
-	&& list != OMP_LIST_TASK_REDUCTION)
+	&& list != OMP_LIST_TASK_REDUCTION
+	&& list != OMP_LIST_ALLOCATE)
       for (n = omp_clauses->lists[list]; n; n = n->next)
 	{
 	  bool component_ref_p = false;
@@ -6526,6 +6567,70 @@  resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
 	n->sym->mark = 1;
     }
 
+  for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; n = n->next)
+    if (n->expr && (n->expr->ts.type != BT_INTEGER
+	|| n->expr->ts.kind != gfc_c_intptr_kind))
+      {
+	gfc_error ("Expected integer expression of the "
+	    "'omp_allocator_handle_kind' kind at %L", &n->expr->where);
+	break;
+      }
+
+  /* Check for 2 things here.
+     1.  There is no duplication of variable in allocate clause.
+     2.  Variable in allocate clause are also present in some
+	 privatization clase.  */
+  for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; n = n->next)
+    n->sym->allocate = 0;
+
+  gfc_omp_namelist *prev = NULL;
+  for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n;)
+    {
+      if (n->sym->allocate == 1)
+	{
+	  gfc_warning (0, "%qs appears more than once in %<allocate%> "
+			  "clauses at %L" , n->sym->name, &n->where);
+	  /* We have already seen this variable so it is a duplicate.
+	     Remove it.  */
+	  if (prev != NULL && prev->next == n)
+	    {
+	      prev->next = n->next;
+	      n->next = NULL;
+	      gfc_free_omp_namelist (n, 0);
+	      n = prev->next;
+	    }
+
+	  continue;
+	}
+      n->sym->allocate = 1;
+      prev = n;
+      n = n->next;
+    }
+
+  for (list = 0; list < OMP_LIST_NUM; list++)
+    switch (list)
+      {
+      case OMP_LIST_PRIVATE:
+      case OMP_LIST_FIRSTPRIVATE:
+      case OMP_LIST_LASTPRIVATE:
+      case OMP_LIST_REDUCTION:
+      case OMP_LIST_REDUCTION_INSCAN:
+      case OMP_LIST_REDUCTION_TASK:
+      case OMP_LIST_IN_REDUCTION:
+      case OMP_LIST_TASK_REDUCTION:
+      case OMP_LIST_LINEAR:
+	for (n = omp_clauses->lists[list]; n; n = n->next)
+	  n->sym->allocate = 0;
+	break;
+      default:
+	break;
+      }
+
+  for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; n = n->next)
+    if (n->sym->allocate == 1)
+      gfc_error ("%qs specified in 'allocate' clause at %L but not in an "
+		 "explicit privatization clause", n->sym->name, &n->where);
+
   /* OpenACC reductions.  */
   if (openacc)
     {
@@ -8233,19 +8338,20 @@  resolve_omp_do (gfc_code *code)
       if (code->ext.omp_clauses)
 	for (list = 0; list < OMP_LIST_NUM; list++)
 	  if (!is_simd || code->ext.omp_clauses->collapse > 1
-	      ? (list != OMP_LIST_PRIVATE && list != OMP_LIST_LASTPRIVATE)
+	      ? (list != OMP_LIST_PRIVATE && list != OMP_LIST_LASTPRIVATE
+		  && list != OMP_LIST_ALLOCATE)
 	      : (list != OMP_LIST_PRIVATE && list != OMP_LIST_LASTPRIVATE
-		 && list != OMP_LIST_LINEAR))
+		 && list != OMP_LIST_ALLOCATE && list != OMP_LIST_LINEAR))
 	    for (n = code->ext.omp_clauses->lists[list]; n; n = n->next)
 	      if (dovar == n->sym)
 		{
 		  if (!is_simd || code->ext.omp_clauses->collapse > 1)
 		    gfc_error ("%s iteration variable present on clause "
-			       "other than PRIVATE or LASTPRIVATE at %L",
-			       name, &do_code->loc);
+			       "other than PRIVATE, LASTPRIVATE or "
+			       "ALLOCATE at %L", name, &do_code->loc);
 		  else
 		    gfc_error ("%s iteration variable present on clause "
-			       "other than PRIVATE, LASTPRIVATE or "
+			       "other than PRIVATE, LASTPRIVATE, ALLOCATE or "
 			       "LINEAR at %L", name, &do_code->loc);
 		  break;
 		}
diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index e81c5588c53..cce65f999cb 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -2646,6 +2646,28 @@  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 || declare_simd)
+	      {
+		tree t = gfc_trans_omp_variable (n->sym, declare_simd);
+		if (t != error_mark_node)
+		  {
+		    tree node = build_omp_clause (input_location,
+						  OMP_CLAUSE_ALLOCATE);
+		    OMP_CLAUSE_DECL (node) = t;
+		    if (n->expr)
+		      {
+			tree allocator_;
+			gfc_init_se (&se, NULL);
+			gfc_conv_expr (&se, n->expr);
+			allocator_ = gfc_evaluate_now (se.expr, block);
+			OMP_CLAUSE_ALLOCATE_ALLOCATOR (node) = allocator_;
+		      }
+		    omp_clauses = gfc_trans_add_clause (node, omp_clauses);
+		  }
+	      }
+	  break;
 	case OMP_LIST_LINEAR:
 	  {
 	    gfc_expr *last_step_expr = NULL;
@@ -5857,6 +5879,8 @@  gfc_split_omp_clauses (gfc_code *code,
 	  /* First the clauses that are unique to some constructs.  */
 	  clausesa[GFC_OMP_SPLIT_TARGET].lists[OMP_LIST_MAP]
 	    = code->ext.omp_clauses->lists[OMP_LIST_MAP];
+	  clausesa[GFC_OMP_SPLIT_TARGET].lists[OMP_LIST_ALLOCATE]
+	    = code->ext.omp_clauses->lists[OMP_LIST_ALLOCATE];
 	  clausesa[GFC_OMP_SPLIT_TARGET].lists[OMP_LIST_IS_DEVICE_PTR]
 	    = code->ext.omp_clauses->lists[OMP_LIST_IS_DEVICE_PTR];
 	  clausesa[GFC_OMP_SPLIT_TARGET].device
@@ -5883,6 +5907,8 @@  gfc_split_omp_clauses (gfc_code *code,
 	    = code->ext.omp_clauses->lists[OMP_LIST_SHARED];
 	  clausesa[GFC_OMP_SPLIT_TEAMS].default_sharing
 	    = code->ext.omp_clauses->default_sharing;
+	  clausesa[GFC_OMP_SPLIT_TEAMS].lists[OMP_LIST_ALLOCATE]
+	    = code->ext.omp_clauses->lists[OMP_LIST_ALLOCATE];
 	}
       if (mask & GFC_OMP_MASK_DISTRIBUTE)
 	{
@@ -5900,6 +5926,8 @@  gfc_split_omp_clauses (gfc_code *code,
 	    = code->ext.omp_clauses->order_unconstrained;
 	  clausesa[GFC_OMP_SPLIT_DISTRIBUTE].order_reproducible
 	    = code->ext.omp_clauses->order_reproducible;
+	  clausesa[GFC_OMP_SPLIT_DISTRIBUTE].lists[OMP_LIST_ALLOCATE]
+	    = code->ext.omp_clauses->lists[OMP_LIST_ALLOCATE];
 	}
       if (mask & GFC_OMP_MASK_PARALLEL)
 	{
@@ -5921,6 +5949,8 @@  gfc_split_omp_clauses (gfc_code *code,
 	  /* And this is copied to all.  */
 	  clausesa[GFC_OMP_SPLIT_PARALLEL].if_expr
 	    = code->ext.omp_clauses->if_expr;
+	  clausesa[GFC_OMP_SPLIT_PARALLEL].lists[OMP_LIST_ALLOCATE]
+	    = code->ext.omp_clauses->lists[OMP_LIST_ALLOCATE];
 	}
       if (mask & GFC_OMP_MASK_MASKED)
 	clausesa[GFC_OMP_SPLIT_MASKED].filter = code->ext.omp_clauses->filter;
@@ -5958,6 +5988,8 @@  gfc_split_omp_clauses (gfc_code *code,
 	    = code->ext.omp_clauses->order_unconstrained;
 	  clausesa[GFC_OMP_SPLIT_DO].order_reproducible
 	    = code->ext.omp_clauses->order_reproducible;
+	  clausesa[GFC_OMP_SPLIT_DO].lists[OMP_LIST_ALLOCATE]
+	    = code->ext.omp_clauses->lists[OMP_LIST_ALLOCATE];
 	}
       if (mask & GFC_OMP_MASK_SIMD)
 	{
@@ -6005,6 +6037,8 @@  gfc_split_omp_clauses (gfc_code *code,
 	    = code->ext.omp_clauses->mergeable;
 	  clausesa[GFC_OMP_SPLIT_TASKLOOP].if_exprs[OMP_IF_TASKLOOP]
 	    = code->ext.omp_clauses->if_exprs[OMP_IF_TASKLOOP];
+	  clausesa[GFC_OMP_SPLIT_TASKLOOP].lists[OMP_LIST_ALLOCATE]
+	    = code->ext.omp_clauses->lists[OMP_LIST_ALLOCATE];
 	  /* And this is copied to all.  */
 	  clausesa[GFC_OMP_SPLIT_TASKLOOP].if_expr
 	    = code->ext.omp_clauses->if_expr;
diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-1.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-1.f90
new file mode 100644
index 00000000000..34dad47a39d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/allocate-1.f90
@@ -0,0 +1,123 @@ 
+! { dg-do compile }
+
+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 bar (a, b, c)
+  implicit none
+  integer  :: a
+  integer  :: b
+  integer  :: c
+  c = a + b
+end
+
+subroutine bar2 (a, b, c)
+  implicit none
+  integer  :: a
+  integer  :: b(15)
+  integer  :: c
+  c = a + b(1)
+end
+
+subroutine foo(x, y)
+  use omp_lib_kinds
+  implicit none
+  integer  :: x
+  integer  :: z
+
+  integer, dimension(15) :: y
+  integer  :: r
+  integer  :: i
+  integer (kind=omp_allocator_handle_kind) :: h
+  r = 0
+  h = omp_default_mem_alloc;
+
+  !$omp parallel allocate (x) allocate (h : y) &
+  !$omp  allocate (omp_large_cap_mem_alloc:z) firstprivate (x, y, z)
+  call bar2 (x, y, z);
+  !$omp end parallel
+
+  !$omp task private (x) firstprivate (z) allocate (omp_low_lat_mem_alloc:x,z)
+  call bar (0, x, z);
+  !$omp end task
+  
+  !$omp target teams distribute parallel do private (x) firstprivate (y) &
+  !$omp allocate ((omp_default_mem_alloc + 0):z) allocate &
+  !$omp (omp_default_mem_alloc: x, y) allocate (h: r) lastprivate (z) reduction(+:r)
+  do i = 1, 10
+    call bar (0, x, z);
+    call bar2 (1, y, r);
+  end do
+  !$omp end target teams distribute parallel do
+
+  !$omp single private (x) allocate (omp_low_lat_mem_alloc:x)
+  x=1
+  !$omp end single
+
+  !$omp single allocate (omp_low_lat_mem_alloc:x) private (x)
+  !$omp end single
+
+  !$omp parallel
+  !$omp do allocate (x) private (x)
+  do i = 1, 64
+    x = 1;
+  end do
+  !$omp end parallel
+
+  !$omp sections private (x) allocate (omp_low_lat_mem_alloc: x)
+    x = 1;
+    !$omp section
+    x = 2;
+    !$omp section
+    x = 3;
+  !$omp end sections
+
+  !$omp taskgroup task_reduction(+:r) allocate (omp_default_mem_alloc : r)
+  call bar (r, r, r);
+  !$omp end taskgroup
+
+  !$omp teams private (x) firstprivate (y) allocate (h : x, y)
+  call bar2 (x, y, r);
+  !$omp end teams
+
+  !$omp taskloop lastprivate (x) reduction (+:r) allocate (h : x, r)
+  do i = 1, 16
+    call bar (0, r, r);
+    x = i;
+  end do
+  !$omp end taskloop
+
+  !$omp taskgroup task_reduction(+:r) allocate (omp_default_mem_alloc : r)
+  !$omp taskloop firstprivate (x) in_reduction (+:r) &
+  !$omp allocate (omp_default_mem_alloc : x, r)
+  do i = 1, 16
+    call bar (x, r, r);
+  end do
+  !$omp end taskloop
+  !$omp end taskgroup
+  !$omp taskwait
+end subroutine
+
diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-2.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-2.f90
new file mode 100644
index 00000000000..88b2d26872d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/allocate-2.f90
@@ -0,0 +1,45 @@ 
+! { dg-do compile }
+
+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
+
+end module
+
+subroutine foo(x)
+  use omp_lib_kinds
+  implicit none
+  integer  :: x
+
+  !$omp task allocate (x) ! { dg-error "'x' specified in 'allocate' clause at .1. but not in an explicit privatization clause" }
+  x=1
+  !$omp end task
+
+  !$omp parallel allocate (x) ! { dg-error "'x' specified in 'allocate' clause at .1. but not in an explicit privatization clause" }
+  x=2
+  !$omp end parallel
+
+  !$omp parallel allocate (x) shared (x) ! { dg-error "'x' specified in 'allocate' clause at .1. but not in an explicit privatization clause" }
+  x=3
+  !$omp end parallel
+
+  !$omp parallel private (x) allocate (x) allocate (x) ! { dg-warning "'x' appears more than once in 'allocate' clauses at .1." }
+  x=4
+  !$omp end parallel
+
+  !$omp parallel private (x) allocate (x, x) ! { dg-warning "'x' appears more than once in 'allocate' clauses at .1." } 
+  x=5
+  !$omp end parallel
+
+  !$omp parallel allocate (0: x) private(x) ! { dg-error "Expected integer expression of the 'omp_allocator_handle_kind' kind at .1." }
+  x=6
+  !$omp end parallel
+  
+  !$omp parallel private (x) allocate (0.1 : x) ! { dg-error "Expected integer expression of the 'omp_allocator_handle_kind' kind at .1." }
+  x=7
+  !$omp end parallel
+
+end subroutine
+
diff --git a/gcc/testsuite/gfortran.dg/gomp/collapse1.f90 b/gcc/testsuite/gfortran.dg/gomp/collapse1.f90
index 1a06eaba823..01cfc82b760 100644
--- a/gcc/testsuite/gfortran.dg/gomp/collapse1.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/collapse1.f90
@@ -24,7 +24,7 @@  subroutine collapse1
     end do
   !$omp parallel do collapse(2) shared(j)
     do i = 1, 3
-      do j = 4, 6		! { dg-error "iteration variable present on clause other than PRIVATE or LASTPRIVATE" }
+      do j = 4, 6		! { dg-error "iteration variable present on clause other than PRIVATE, LASTPRIVATE or ALLOCATE" }
       end do
     end do
   !$omp parallel do collapse(2)
diff --git a/gcc/testsuite/gfortran.dg/gomp/openmp-simd-4.f90 b/gcc/testsuite/gfortran.dg/gomp/openmp-simd-4.f90
index 4a17fb9820e..17375e0eff5 100644
--- a/gcc/testsuite/gfortran.dg/gomp/openmp-simd-4.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/openmp-simd-4.f90
@@ -45,17 +45,17 @@  do i = 1, 5
 end do
 
 !$omp parallel do firstprivate(i)
-do i = 1, 5  ! { dg-error "PARALLEL DO iteration variable present on clause other than PRIVATE or LASTPRIVATE" }
+do i = 1, 5  ! { dg-error "PARALLEL DO iteration variable present on clause other than PRIVATE, LASTPRIVATE or ALLOCATE" }
   x(i) = 42
 end do
 
 !$omp parallel do simd firstprivate(i)
-do i = 1, 5  ! { dg-error "PARALLEL DO SIMD iteration variable present on clause other than PRIVATE, LASTPRIVATE or LINEAR" }
+do i = 1, 5  ! { dg-error "PARALLEL DO SIMD iteration variable present on clause other than PRIVATE, LASTPRIVATE, ALLOCATE or LINEAR" }
   x(i) = 42
 end do
 
 !$omp simd linear(i) collapse(2)
-do i = 1, 5  ! { dg-error "SIMD iteration variable present on clause other than PRIVATE or LASTPRIVATE" }
+do i = 1, 5  ! { dg-error "SIMD iteration variable present on clause other than PRIVATE, LASTPRIVATE or ALLOCATE" }
   do j = 1, 2
     y(j, i) = 52
   end do
diff --git a/libgomp/testsuite/libgomp.fortran/allocate-1.c b/libgomp/testsuite/libgomp.fortran/allocate-1.c
new file mode 100644
index 00000000000..d33acc6feef
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/allocate-1.c
@@ -0,0 +1,7 @@ 
+#include <stdint.h>
+
+int
+is_64bit_aligned_ (uintptr_t a)
+{
+  return ( (a & 0x3f) == 0);
+}
diff --git a/libgomp/testsuite/libgomp.fortran/allocate-1.f90 b/libgomp/testsuite/libgomp.fortran/allocate-1.f90
new file mode 100644
index 00000000000..35d1750b878
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/allocate-1.f90
@@ -0,0 +1,333 @@ 
+! { dg-do run }
+! { dg-additional-sources allocate-1.c }
+! { dg-prune-output "command-line option '-fintrinsic-modules-path=.*' is valid for Fortran but not for C" }
+
+module m
+  use omp_lib
+  use iso_c_binding
+  implicit none
+
+  interface
+    integer(c_int) function is_64bit_aligned (a) bind(C)
+      import :: c_int
+      integer  :: a
+    end
+  end interface
+end module m
+
+subroutine foo (x, p, q, px, h, fl)
+  use omp_lib
+  use iso_c_binding
+  integer  :: x
+  integer, dimension(4) :: p
+  integer, dimension(4) :: q
+  integer  :: px
+  integer (kind=omp_allocator_handle_kind) :: h
+  integer  :: fl
+
+  integer  :: y
+  integer  :: r, i, i1, i2, i3, i4, i5
+  integer  :: l, l3, l4, l5, l6
+  integer  :: n, n1, n2, n3, n4
+  integer  :: j2, j3, j4
+  integer, dimension(4) :: l2
+  integer, dimension(4) :: r2
+  integer, target  :: xo
+  integer, target  :: yo
+  integer, dimension(x) :: v
+  integer, dimension(x) :: w
+
+  type s_type
+    integer      :: a
+    integer      :: b
+  end type
+
+  type (s_type) :: s
+  s%a = 27
+  s%b = 29
+  y = 0
+  r = 0
+  n = 8
+  n2 = 9
+  n3 = 10
+  n4 = 11
+  xo = x
+  yo = y
+
+  do i = 1, 4
+    r2(i) = 0;
+  end do
+
+  do i = 1, 4
+    p(i) = 0;
+  end do
+
+  do i = 1, 4
+    q(i) = 0;
+  end do
+
+  do i = 1, x
+    w(i) = i
+  end do
+
+  !$omp parallel private (y, v) firstprivate (x) allocate (x, y, v)
+  if (x /= 42) then
+    stop 1
+  end if
+  v(1) = 7
+  if ( (and(fl, 2) /= 0) .and.          &
+       ((is_64bit_aligned(x) == 0) .or. &
+        (is_64bit_aligned(y) == 0) .or. &
+        (is_64bit_aligned(v(1)) == 0))) then
+      stop 2
+  end if
+
+  !$omp barrier
+  y = 1;
+  x = x + 1
+  v(1) = 7
+  v(41) = 8
+  !$omp barrier
+  if (x /= 43 .or. y /= 1) then
+    stop 3
+  end if
+  if (v(1) /= 7 .or. v(41) /= 8) then
+    stop 4
+  end if
+  !$omp end parallel
+
+  !$omp teams
+  !$omp parallel private (y) firstprivate (x, w) allocate (h: x, y, w)
+
+  if (x /= 42 .or. w(17) /= 17 .or. w(41) /= 41) then
+    stop 5
+  end if
+  !$omp barrier
+  y = 1;
+  x = x + 1
+  w(19) = w(19) + 1
+  !$omp barrier
+  if (x /= 43 .or. y /= 1 .or. w(19) /= 20) then
+    stop 6
+  end if
+  if ( (and(fl, 1) /= 0) .and.          &
+       ((is_64bit_aligned(x) == 0) .or. &
+        (is_64bit_aligned(y) == 0) .or. &
+        (is_64bit_aligned(w(1)) == 0))) then
+    stop 7
+  end if
+  !$omp end parallel
+  !$omp end teams
+
+  !$omp parallel do private (y) firstprivate (x)  reduction(+: r) allocate (h: x, y, r, l, n) lastprivate (l)  linear (n: 16)
+  do i = 0, 63
+    if (x /= 42) then
+      stop 8
+    end if
+    y = 1;
+    l = i;
+    n = n + y + 15;
+    r = r + i;
+    if ( (and(fl, 1) /= 0) .and.          &
+         ((is_64bit_aligned(x) == 0) .or. &
+          (is_64bit_aligned(y) == 0) .or. &
+          (is_64bit_aligned(r) == 0) .or. &
+          (is_64bit_aligned(l) == 0) .or. &
+          (is_64bit_aligned(n) == 0))) then
+      stop 9
+    end if
+  end do
+  !$omp end parallel do
+
+  !$omp parallel
+    !$omp do lastprivate (l2) private (i1) allocate (h: l2, l3, i1) lastprivate (conditional: l3)
+    do i1 = 0, 63
+      l2(1) = i1
+      l2(2) = i1 + 1
+      l2(3) = i1 + 2
+      l2(4) = i1 + 3
+      if (i1 < 37) then
+        l3 = i1
+      end if
+      if ( (and(fl, 1) /= 0) .and.          &
+           ((is_64bit_aligned(l2(1)) == 0) .or. &
+            (is_64bit_aligned(l3) == 0) .or. &
+            (is_64bit_aligned(i1) == 0))) then
+	stop 10
+      end if
+    end do
+
+    !$omp do collapse(2) lastprivate(l4, i2, j2) linear (n2:17) allocate (h: n2, l4, i2, j2)
+    do i2 = 3, 4
+      do j2 = 17, 22, 2
+	n2 = n2 + 17
+	l4 = i2 * 31 + j2
+	if ( (and(fl, 1) /= 0) .and.          &
+	  ((is_64bit_aligned(l4) == 0) .or. &
+	  (is_64bit_aligned(n2) == 0) .or. &
+	  (is_64bit_aligned(i2) == 0) .or. &
+	  (is_64bit_aligned(j2) == 0))) then
+	  stop 11
+	end if
+      end do
+    end do
+
+    !$omp do collapse(2) lastprivate(l5, i3, j3) linear (n3:17) schedule (static, 3) allocate (n3, l5, i3, j3)
+    do i3 = 3, 4
+      do j3 = 17, 22, 2
+	  n3 = n3 + 17
+	  l5 = i3 * 31 + j3
+	  if ( (and(fl, 2) /= 0) .and.      &
+	  ((is_64bit_aligned(l5) == 0) .or. &
+	  (is_64bit_aligned(n3) == 0) .or. &
+	  (is_64bit_aligned(i3) == 0) .or. &
+	  (is_64bit_aligned(j3) == 0))) then
+	  stop 12
+	end if
+      end do
+    end do
+
+    !$omp do collapse(2) lastprivate(l6, i4, j4) linear (n4:17) schedule (dynamic) allocate (h: n4, l6, i4, j4)
+    do i4 = 3, 4
+      do j4 = 17, 22,2
+	  n4 = n4 + 17;
+	  l6 = i4 * 31 + j4;
+	if ( (and(fl, 1) /= 0) .and.          &
+	  ((is_64bit_aligned(l6) == 0) .or. &
+	  (is_64bit_aligned(n4) == 0) .or. &
+	  (is_64bit_aligned(i4) == 0) .or. &
+	  (is_64bit_aligned(j4) == 0))) then
+	  stop 13
+	end if
+      end do
+    end do
+
+    !$omp do lastprivate (i5) allocate (i5)
+    do i5 = 1, 17, 3
+      if ( (and(fl, 2) /= 0) .and.          &
+	   (is_64bit_aligned(i5) == 0)) then
+	stop 14
+      end if
+    end do
+
+    !$omp do reduction(+:p, q, r2) allocate(h: p, q, r2)
+    do i = 0, 31
+	p(3) = p(3) +  i;
+	p(4) = p(4) + (2 * i)
+	q(1) = q(1) + (3 * i)
+	q(3) = q(3) + (4 * i)
+	r2(1) = r2(1) + (5 * i)
+	r2(4) = r2(4) + (6 * i)
+	if ( (and(fl, 1) /= 0) .and.          &
+	  ((is_64bit_aligned(q(1)) == 0) .or. &
+	  (is_64bit_aligned(p(1)) == 0) .or. &
+	  (is_64bit_aligned(r2(1)) == 0) )) then
+	  stop 15
+	end if
+    end do
+
+    !$omp task private(y) firstprivate(x) allocate(x, y)
+    if (x /= 42) then
+      stop 16
+    end if
+
+    if ( (and(fl, 2) /= 0) .and.          &
+      ((is_64bit_aligned(x) == 0) .or. &
+      (is_64bit_aligned(y) == 0) )) then
+      stop 17
+    end if
+    !$omp end task
+
+    !$omp task private(y) firstprivate(x) allocate(h: x, y)
+    if (x /= 42) then
+      stop 16
+    end if
+
+    if ( (and(fl, 1) /= 0) .and.          &
+      ((is_64bit_aligned(x) == 0) .or. &
+      (is_64bit_aligned(y) == 0) )) then
+      stop 17
+    end if
+    !$omp end task
+
+    !$omp task private(y) firstprivate(s) allocate(s, y)
+    if (s%a /= 27 .or. s%b /= 29) then
+      stop 18
+    end if
+
+    if ( (and(fl, 2) /= 0) .and.          &
+      ((is_64bit_aligned(s%a) == 0) .or. &
+      (is_64bit_aligned(y) == 0) )) then
+      stop 19
+    end if
+    !$omp end task
+
+    !$omp task private(y) firstprivate(s) allocate(h: s, y)
+    if (s%a /= 27 .or. s%b /= 29) then
+      stop 18
+    end if
+
+    if ( (and(fl, 1) /= 0) .and.          &
+      ((is_64bit_aligned(s%a) == 0) .or. &
+      (is_64bit_aligned(y) == 0) )) then
+      stop 19
+    end if
+    !$omp end task
+
+  !$omp end parallel
+
+  if (r /= ((64 * 63) / 2) .or. l /= 63 .or. n /= (8 + 16 * 64)) then
+    stop 20
+  end if
+
+  if (l2(1) /= 63 .or. l2(2) /= 64 .or. l2(3) /= 65 .or. l2(4) /= 66 .or. l3 /= 36) then
+    stop 21
+  end if
+
+  if (i2 /= 5 .or. j2 /= 23 .or. n2 /= (9 + (17 * 6)) .or. l4 /= (4 * 31 + 21)) then
+    stop 22
+  end if
+
+  if (i3 /= 5 .or. j3 /= 23 .or. n3 /= (10 + (17 * 6))  .or. l5 /= (4 * 31 + 21)) then
+    stop 23
+  end if
+
+  if (i4 /= 5 .or. j4 /= 23 .or. n4 /= (11 + (17 * 6))  .or. l6 /= (4 * 31 + 21)) then
+    stop 24
+  end if
+
+  if (i5 /= 19) then
+    stop 24
+  end if
+
+  if (p(3) /= ((32 * 31) / 2) .or. p(4) /= (2 * p(3))         &
+      .or. q(1) /= (3 * p(3)) .or. q(3) /= (4 * p(3))         &
+      .or. r2(1) /= (5 * p(3)) .or. r2(4) /= (6 * p(3))) then
+    stop 25
+  end if
+
+end subroutine
+
+program main
+  use omp_lib
+  integer, dimension(4) :: p
+  integer, dimension(4) :: q
+
+  type (omp_alloctrait) :: traits(3)
+  integer (omp_allocator_handle_kind) :: a
+
+  traits = [omp_alloctrait (omp_atk_alignment, 64), &
+            omp_alloctrait (omp_atk_fallback, omp_atv_null_fb), &
+            omp_alloctrait (omp_atk_pool_size, 8192)]
+  a = omp_init_allocator (omp_default_mem_space, 3, traits)
+  if (a == omp_null_allocator) stop 1
+
+  call omp_set_default_allocator (omp_default_mem_alloc);
+  call foo (42, p, q, 2, a, 0);
+  call foo (42, p, q, 2, omp_default_mem_alloc, 0);
+  call foo (42, p, q, 2, a, 1);
+  call omp_set_default_allocator (a);
+  call foo (42, p, q, 2, omp_null_allocator, 3);
+  call foo (42, p, q, 2, omp_default_mem_alloc, 2);
+  call omp_destroy_allocator (a);
+end