amdgcn: Change -m(no-)xnack to -mxnack=(on,off,any)

Since object code target ID V4, xnack has the values unspecified, '+' and '-',
which with this commit is represented in GCC as 'any', 'on', and 'off',
following the precidence for 'sram(-)ecc' and -msram-ecc=.

The current default was 'no' and is now 'off'; however, once XNACK is
implemented, the default should be probably 'any'.

This commit updates the commandline options to permit the new tristate and
updates the documentation. As the feature itself is currently not really
supported in GCC, the change should not affect real-world users.

The XNACK feature allows memory load instructions to restart safely following
a page-miss interrupt.  This is useful for shared-memory devices, like APUs,
and to implement OpenMP Unified Shared Memory.

2023-05-26  Andrew Stubbs  <ams@codesourcery.com>
	    Tobias Burnus  <tobias@codesourcery.com>

	* config/gcn/gcn-hsa.h (XNACKOPT): New macro.
	(ASM_SPEC): Use XNACKOPT.
	* config/gcn/gcn-opts.h (enum sram_ecc_type): Rename to ...
	(enum hsaco_attr_type): ... this, and generalize the names.
	(TARGET_XNACK): New macro.
	* config/gcn/gcn.cc (gcn_option_override): Update to sorry for all
	but -mxnack=off.
	(output_file_start): Update xnack handling.
	(gcn_hsa_declare_function_name): Use TARGET_XNACK.
	* config/gcn/gcn.opt (-mxnack): Add the "on/off/any" syntax.
	(sram_ecc_type): Rename to ...
	(hsaco_attr_type: ... this.)
	* config/gcn/mkoffload.cc (SET_XNACK_ANY): New macro.
	(TEST_XNACK): Delete.
	(TEST_XNACK_ANY): New macro.
	(TEST_XNACK_ON): New macro.
	(main): Support the new -mxnack=on/off/any syntax.
	* doc/invoke.texi (-mxnack): Update for new syntax.

12 files changed, 585 insertions, 35 deletions

diff --git a/gcc/config/gcn/gcn-hsa.h b/gcc/config/gcn/gcn-hsa.h
index 51b0509..0b5610b 100644
--- a/gcc/config/gcn/gcn-hsa.h
+++ b/gcc/config/gcn/gcn-hsa.h
@@ -82,11 +82,15 @@ extern unsigned int gcn_local_sym_hash (const char *name);
    configuration.  The name of the attribute also changed.  */
 #define SRAMOPT "msram-ecc=on:-mattr=+sramecc;msram-ecc=off:-mattr=-sramecc"
 
+/* Replace once XNACK is supported:
+   #define XNACKOPT "mxnack=on:-mattr=+xnack;mxnack=off:-mattr=-xnack"  */
+#define XNACKOPT "!mnack=*:-mattr=-xnack;mnack=*:-mattr=-xnack"
+
 /* Use LLVM assembler and linker options.  */
 #define ASM_SPEC  "-triple=amdgcn--amdhsa "  \
 		  "%:last_arg(%{march=*:-mcpu=%*}) " \
 		  "%{!march=*|march=fiji:--amdhsa-code-object-version=3} " \
-		  "%{" NO_XNACK "mxnack:-mattr=+xnack;:-mattr=-xnack} " \
+		  "%{" NO_XNACK XNACKOPT "}" \
 		  "%{" NO_SRAM_ECC SRAMOPT "} " \
 		  "-filetype=obj"
 #define LINK_SPEC "--pie --export-dynamic"
diff --git a/gcc/config/gcn/gcn-opts.h b/gcc/config/gcn/gcn-opts.h
index cd1b2ec..f780a7c 100644
--- a/gcc/config/gcn/gcn-opts.h
+++ b/gcc/config/gcn/gcn-opts.h
@@ -54,11 +54,13 @@ extern enum gcn_isa {
 #define TARGET_M0_LDS_LIMIT (TARGET_GCN3)
 #define TARGET_PACKED_WORK_ITEMS (TARGET_CDNA2_PLUS)
 
-enum sram_ecc_type
+#define TARGET_XNACK (flag_xnack != HSACO_ATTR_OFF)
+
+enum hsaco_attr_type
 {
-  SRAM_ECC_OFF,
-  SRAM_ECC_ON,
-  SRAM_ECC_ANY
+  HSACO_ATTR_OFF,
+  HSACO_ATTR_ON,
+  HSACO_ATTR_ANY
 };
 
 #endif
diff --git a/gcc/config/gcn/gcn.cc b/gcc/config/gcn/gcn.cc
index 007730d..efb7211 100644
--- a/gcc/config/gcn/gcn.cc
+++ b/gcc/config/gcn/gcn.cc
@@ -157,8 +157,10 @@ gcn_option_override (void)
 	acc_lds_size = 32768;
     }
 
-  /* The xnack option is a placeholder, for now.  */
-  if (flag_xnack)
+  /* The xnack option is a placeholder, for now.  Before removing, update
+     gcn-hsa.h's XNACKOPT, gcn.opt's mxnack= default init+descr, and
+     invoke.texi's default description.  */
+  if (flag_xnack != HSACO_ATTR_OFF)
     sorry ("XNACK support");
 }
 
@@ -6162,11 +6164,12 @@ static void
 output_file_start (void)
 {
   /* In HSACOv4 no attribute setting means the binary supports "any" hardware
-     configuration.  In GCC binaries, this is true for SRAM ECC, but not
-     XNACK.  */
-  const char *xnack = (flag_xnack ? ":xnack+" : ":xnack-");
-  const char *sram_ecc = (flag_sram_ecc == SRAM_ECC_ON ? ":sramecc+"
-			  : flag_sram_ecc == SRAM_ECC_OFF ? ":sramecc-"
+     configuration.  */
+  const char *xnack = (flag_xnack == HSACO_ATTR_ON ? ":xnack+"
+		       : flag_xnack == HSACO_ATTR_OFF ? ":xnack-"
+		       : "");
+  const char *sram_ecc = (flag_sram_ecc == HSACO_ATTR_ON ? ":sramecc+"
+			  : flag_sram_ecc == HSACO_ATTR_OFF ? ":sramecc-"
 			  : "");
 
   const char *cpu;
@@ -6210,7 +6213,7 @@ void
 gcn_hsa_declare_function_name (FILE *file, const char *name, tree)
 {
   int sgpr, vgpr;
-  bool xnack_enabled = false;
+  bool xnack_enabled = TARGET_XNACK;
 
   fputs ("\n\n", file);
 
diff --git a/gcc/config/gcn/gcn.opt b/gcc/config/gcn/gcn.opt
index c5c32bd..36c2b53 100644
--- a/gcc/config/gcn/gcn.opt
+++ b/gcc/config/gcn/gcn.opt
@@ -81,23 +81,23 @@ Wopenacc-dims
 Target Var(warn_openacc_dims) Warning
 Warn about invalid OpenACC dimensions.
 
-mxnack
-Target Var(flag_xnack) Init(0)
-Compile for devices requiring XNACK enabled. Default off.
-
 Enum
-Name(sram_ecc_type) Type(enum sram_ecc_type)
-SRAM-ECC modes:
+Name(hsaco_attr_type) Type(enum hsaco_attr_type)
+SRAM-ECC and XNACK modes:
 
 EnumValue
-Enum(sram_ecc_type) String(off) Value(SRAM_ECC_OFF)
+Enum(hsaco_attr_type) String(off) Value(HSACO_ATTR_OFF)
 
 EnumValue
-Enum(sram_ecc_type) String(on) Value(SRAM_ECC_ON)
+Enum(hsaco_attr_type) String(on) Value(HSACO_ATTR_ON)
 
 EnumValue
-Enum(sram_ecc_type) String(any) Value(SRAM_ECC_ANY)
+Enum(hsaco_attr_type) String(any) Value(HSACO_ATTR_ANY)
+
+mxnack=
+Target RejectNegative Joined ToLower Enum(hsaco_attr_type) Var(flag_xnack) Init(HSACO_ATTR_OFF)
+Compile for devices requiring XNACK enabled. Default \"off\".
 
 msram-ecc=
-Target RejectNegative Joined ToLower Enum(sram_ecc_type) Var(flag_sram_ecc) Init(SRAM_ECC_ANY)
+Target RejectNegative Joined ToLower Enum(hsaco_attr_type) Var(flag_sram_ecc) Init(HSACO_ATTR_ANY)
 Compile for devices with the SRAM ECC feature enabled, or not. Default \"any\".
diff --git a/gcc/config/gcn/mkoffload.cc b/gcc/config/gcn/mkoffload.cc
index 61bc927..988c123 100644
--- a/gcc/config/gcn/mkoffload.cc
+++ b/gcc/config/gcn/mkoffload.cc
@@ -72,10 +72,16 @@
 
 #define SET_XNACK_ON(VAR) VAR = ((VAR & ~EF_AMDGPU_FEATURE_XNACK_V4) \
 				 | EF_AMDGPU_FEATURE_XNACK_ON_V4)
+#define SET_XNACK_ANY(VAR) VAR = ((VAR & ~EF_AMDGPU_FEATURE_XNACK_V4) \
+				  | EF_AMDGPU_FEATURE_XNACK_ANY_V4)
 #define SET_XNACK_OFF(VAR) VAR = ((VAR & ~EF_AMDGPU_FEATURE_XNACK_V4) \
 				  | EF_AMDGPU_FEATURE_XNACK_OFF_V4)
-#define TEST_XNACK(VAR) ((VAR & EF_AMDGPU_FEATURE_XNACK_V4) \
-			 == EF_AMDGPU_FEATURE_XNACK_ON_V4)
+#define TEST_XNACK_ANY(VAR) ((VAR & EF_AMDGPU_FEATURE_XNACK_V4) \
+			     == EF_AMDGPU_FEATURE_XNACK_ANY_V4)
+#define TEST_XNACK_ON(VAR) ((VAR & EF_AMDGPU_FEATURE_XNACK_V4) \
+			    == EF_AMDGPU_FEATURE_XNACK_ON_V4)
+#define TEST_XNACK_OFF(VAR) ((VAR & EF_AMDGPU_FEATURE_XNACK_V4) \
+			     == EF_AMDGPU_FEATURE_XNACK_OFF_V4)
 
 #define SET_SRAM_ECC_ON(VAR) VAR = ((VAR & ~EF_AMDGPU_FEATURE_SRAMECC_V4) \
 				    | EF_AMDGPU_FEATURE_SRAMECC_ON_V4)
@@ -907,9 +913,11 @@ main (int argc, char **argv)
 	fPIC = true;
       else if (strcmp (argv[i], "-fpic") == 0)
 	fpic = true;
-      else if (strcmp (argv[i], "-mxnack") == 0)
+      else if (strcmp (argv[i], "-mxnack=on") == 0)
 	SET_XNACK_ON (elf_flags);
-      else if (strcmp (argv[i], "-mno-xnack") == 0)
+      else if (strcmp (argv[i], "-mxnack=any") == 0)
+	SET_XNACK_ANY (elf_flags);
+      else if (strcmp (argv[i], "-mxnack=off") == 0)
 	SET_XNACK_OFF (elf_flags);
       else if (strcmp (argv[i], "-msram-ecc=on") == 0)
 	SET_SRAM_ECC_ON (elf_flags);
@@ -1073,8 +1081,9 @@ main (int argc, char **argv)
       obstack_ptr_grow (&ld_argv_obstack, gcn_s2_name);
       obstack_ptr_grow (&ld_argv_obstack, "-lgomp");
       obstack_ptr_grow (&ld_argv_obstack,
-			(TEST_XNACK (elf_flags)
-			 ? "-mxnack" : "-mno-xnack"));
+			(TEST_XNACK_ON (elf_flags) ? "-mxnack=on"
+			 : TEST_XNACK_ANY (elf_flags) ? "-mxnack=any"
+			 : "-mxnack=off"));
       obstack_ptr_grow (&ld_argv_obstack,
 			(TEST_SRAM_ECC_ON (elf_flags) ? "-msram-ecc=on"
 			 : TEST_SRAM_ECC_ANY (elf_flags) ? "-msram-ecc=any"
diff --git a/gcc/doc/invoke.texi b/gcc/doc/invoke.texi
index ee78591..898a88c 100644
--- a/gcc/doc/invoke.texi
+++ b/gcc/doc/invoke.texi
@@ -20822,12 +20822,14 @@ run-time performance.  The default is 32KB when using OpenACC or OpenMP, and
 1MB otherwise.
 
 @opindex mxnack
-@item -mxnack
-Compile binaries suitable for devices with the XNACK feature enabled.  Some
-devices always require XNACK and some allow the user to configure XNACK.  The
-compiled code must match the device mode.  The default is @samp{-mno-xnack}.
-At present this option is a placeholder for support that is not yet
-implemented.
+@item -mxnack=on
+@itemx -mxnack=off
+@itemx -mxnack=any
+Compile binaries suitable for devices with the XNACK feature enabled, disabled,
+or either mode.  Some devices always require XNACK and some allow the user to
+configure XNACK.  The compiled code must match the device mode.
+@c The default is @samp{-mxnack=any}.
+At present this option is a placeholder for support that is not yet implemented.
 
 @end table
 
diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-4.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-4.f90
new file mode 100644
index 0000000..a2dcf10
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/allocate-4.f90
@@ -0,0 +1,54 @@
+module my_omp_lib
+  use iso_c_binding, only: c_intptr_t
+  !use omp_lib
+  implicit none
+        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 my_omp_lib
+
+subroutine one(n, my_alloc)
+  use my_omp_lib
+  implicit none
+integer :: n
+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 ( 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)
+!$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 )
+!$omp allocate(   r ) allocator( omp_high_bw_mem_alloc )
+
+!common /block/
+integer :: q,x,y(2),z(5)
+common /com1/ q,x
+common /com2/ y,z
+!$omp allocate ( / com1/) align( 128 ) allocator( omp_high_bw_mem_alloc )
+!$omp allocate(/com2 / ) allocator( omp_high_bw_mem_alloc )
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-5.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-5.f90
new file mode 100644
index 0000000..bf9c781d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/allocate-5.f90
@@ -0,0 +1,93 @@
+module my_omp_lib
+  use iso_c_binding, only: c_intptr_t
+  !use omp_lib
+  implicit none
+        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
+  type t
+    integer :: a
+  end type t
+end module my_omp_lib
+
+subroutine zero()
+  !$omp assumes absent (allocators)
+
+  !$omp assume absent (allocators)
+  !$omp end assume
+end
+
+subroutine two(c,x2,y2)
+  use my_omp_lib
+  implicit none
+  integer, allocatable :: a, b(:), c(:,:)
+  type(t), allocatable :: x1
+  type(t), pointer :: x2(:)
+  class(t), allocatable :: y1
+  class(t), pointer :: y2(:)
+
+  !$omp flush  ! some executable statement
+  !$omp allocate(a)  ! { dg-message "not yet supported" }
+  allocate(a,b(4),c(3,4))
+  deallocate(a,b,c)
+
+  !$omp allocate(x1,y1,x2,y2)  ! { dg-message "not yet supported" }
+  allocate(x1,y1,x2(5),y2(5))
+  deallocate(x1,y1,x2,y2)
+
+  !$omp allocate(b,a) align ( 128 )  ! { dg-message "not yet supported" }
+  !$omp allocate align ( 64 )
+  allocate(a,b(4),c(3,4))
+  deallocate(a,b,c)
+end
+
+subroutine three(c)
+  use my_omp_lib
+  implicit none
+  integer :: q
+  integer, allocatable :: a, b(:), c(:,:)
+
+  call foo()  ! executable stmt
+  !$omp allocate allocator( omp_large_cap_mem_alloc ) , align(64)  ! { dg-message "not yet supported" }
+  !$omp allocate(b) allocator( omp_high_bw_mem_alloc )
+  !$omp allocate(c) allocator( omp_high_bw_mem_alloc )
+  allocate(a,b(4),c(3,4))
+  deallocate(a,b,c)
+
+  block
+    q = 5  ! executable stmt
+    !$omp allocate(a) align(64)  ! { dg-message "not yet supported" }
+    !$omp allocate(b) allocator( omp_high_bw_mem_alloc ), align(32)
+    !$omp allocate(c) allocator( omp_thread_mem_alloc )
+    allocate(a,b(4),c(3,4))
+    deallocate(a,b,c)
+  end block
+  call inner
+contains
+  subroutine inner
+    call foo()  ! executable stmt
+    !$omp allocate(a) align(64)  ! { dg-message "not yet supported" }
+    !$omp allocate(b) allocator( omp_high_bw_mem_alloc ), align(32)
+    !$omp allocate(c) allocator( omp_thread_mem_alloc )
+    allocate(a,b(4),c(3,4))
+    deallocate(a,b,c)
+  end subroutine inner
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-6.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-6.f90
new file mode 100644
index 0000000..73e5bbc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/allocate-6.f90
@@ -0,0 +1,103 @@
+module my_omp_lib
+  use iso_c_binding, only: c_intptr_t
+  !use omp_lib
+  implicit none
+        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
+   type t
+     integer,allocatable :: a
+     integer,pointer :: b(:,:)
+   end type t
+end module my_omp_lib
+
+subroutine zero()
+  !$omp assumes absent (allocate)  ! { dg-error "Invalid 'ALLOCATE' directive at .1. in ABSENT clause: declarative, informational and meta directives not permitted" }
+
+  !$omp assume absent (allocate)  ! { dg-error "Invalid 'ALLOCATE' directive at .1. in ABSENT clause: declarative, informational and meta directives not permitted" }
+  !!$omp end assume
+end
+
+subroutine alloc(c,x2,y2)
+  use my_omp_lib
+  implicit none
+  integer, allocatable :: a, b(:), c(:,:)
+  type(t) :: x1,x2
+  class(t) :: y1,y2
+  allocatable :: x1, y1
+
+  !$omp flush  ! some executable statement
+
+  !$omp allocate(x2%a,x2%b,y2%a,y2%b) allocator(omp_pteam_mem_alloc) align(64)  ! { dg-error "Sorry, structure-element list item at .1. in ALLOCATE directive is not yet supported" }
+  allocate(x2%a,x2%b(3,4),y2%a,y2%b(3,4))
+
+  !$omp allocate(b(3)) align ( 64 ) ! { dg-error "Unexpected expression as list item at .1. in ALLOCATE directive" }
+  allocate(b(3))
+end
+
+subroutine one(n, my_alloc)
+  use my_omp_lib
+  implicit none
+integer :: n
+integer(kind=omp_allocator_handle_kind), intent(in) :: my_alloc
+
+integer :: a,b,c(n),d(5),e(2)
+integer, save :: k,l,m(5),r(2)
+integer :: q,x,y(2),z(5)
+common /com1/ q,x
+common /com2/ y,z
+integer, allocatable :: alloc
+integer, pointer :: ptr
+
+!$omp allocate(q) ! { dg-error "'q' at .1. is part of the common block '/com1/' and may only be specificed implicitly via the named common block" }
+
+!$omp allocate(d(:)) ! { dg-error "Unexpected expression as list item at .1. in ALLOCATE directive" }
+!$omp allocate(a) align(4), align(4)  ! { dg-error "Duplicated 'align' clause" }
+!$omp allocate(   e ) allocator( omp_high_bw_mem_alloc ), align(32),allocator( omp_high_bw_mem_alloc )  ! { dg-error "Duplicated 'allocator' clause" }
+
+!$omp allocate align(32) ! { dg-error "'!.OMP ALLOCATE' directive at .1. must either have a variable argument or, if associated with an ALLOCATE stmt, must be preceded by an executable statement or OpenMP construct" }
+
+!$omp allocate(alloc) align(128)  ! { dg-error "'!.OMP ALLOCATE' directive at .1. associated with an ALLOCATE stmt must be preceded by an executable statement or OpenMP construct; note the variables in the list all have the allocatable or pointer attribute" }
+!$omp allocate(ptr) align(128)  ! { dg-error "'!.OMP ALLOCATE' directive at .1. associated with an ALLOCATE stmt must be preceded by an executable statement or OpenMP construct; note the variables in the list all have the allocatable or pointer attribute" }
+
+!$omp allocate(e) allocate(omp_thread_mem_alloc)  ! { dg-error "Expected ALIGN or ALLOCATOR clause" }
+end
+
+subroutine two()
+  integer, allocatable :: a,b,c
+
+  call foo()
+  !$omp allocate(a)
+  a = 5  ! { dg-error "Unexpected assignment at .1.; expected ALLOCATE or !.OMP ALLOCATE statement" }
+
+  !$omp allocate  ! { dg-error "!.OMP ALLOCATE statements at .1. and .2. have both no list item but only one may" }
+  !$omp allocate(b)
+  !$omp allocate  ! { dg-error "!.OMP ALLOCATE statements at .1. and .2. have both no list item but only one may" }
+   allocate(a,b,c)
+
+  !$omp allocate
+   allocate(a,b,c)  ! allocate is no block construct, hence:
+  !$omp end allocate  ! { dg-error "Unclassifiable OpenMP directive" }
+
+  !$omp allocators allocate(align(64) : a, b)
+  !$omp allocators allocate(align(128) : c)  ! { dg-error "Unexpected !.OMP ALLOCATORS at .1.; expected ALLOCATE statement after !.OMP ALLOCATORS" }
+   allocate(a,b,c)
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-7.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-7.f90
new file mode 100644
index 0000000..c46899d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/allocate-7.f90
@@ -0,0 +1,230 @@
+! { dg-additional-options "-fmax-errors=1000" }
+module my_omp_lib
+  use iso_c_binding, only: c_intptr_t
+  !use omp_lib
+  implicit none
+        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
+   type t
+     integer,allocatable :: a
+     integer,pointer :: b(:,:)
+   end type t
+   integer :: used
+end module my_omp_lib
+
+subroutine one(n, my_alloc)
+  use my_omp_lib
+  implicit none
+integer :: n
+integer(kind=omp_allocator_handle_kind), intent(in) :: my_alloc
+
+integer :: a,b,c(n),d(5),e(2)
+integer, save :: k,l,m(5),r(2)
+integer :: q,x,y(2),z(5)
+common /com1/ q,x
+common /com2/ y,z
+integer, allocatable :: alloc
+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" }
+
+!$omp allocate (x) align(128) ! { dg-error "'x' at .1. is part of the common block '/com1/' and may only be specificed implicitly via the named common block" }
+
+!$omp allocate (a, b, a) allocator (omp_pteam_mem_alloc) ! { dg-error "Duplicated variable 'a' in !.OMP ALLOCATE" }
+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
+
+subroutine three(n)
+  use my_omp_lib
+  implicit none
+integer,value :: n
+integer :: a,b,c(n),d(5),e(2)
+integer, save :: k,l,m(5)
+integer :: q,x,y(2),z(5),r
+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" }
+
+!$omp allocate(q,x)  ! { dg-error "Unexpected allocatable variable 'q' at .1. in declarative !.OMP ALLOCATE directive" }
+!$omp allocate(b,e)  ! { dg-error "Unexpected pointer variable 'b' at .1. in declarative !.OMP ALLOCATE directive" }
+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" }
+!$omp allocate (uu) align(31) ! { dg-error "ALIGN requires a scalar positive constant integer alignment expression at .1. that is a power of two" }
+end
+
+subroutine five(n,my_alloc)
+  use my_omp_lib
+  implicit none
+  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
+end
+
+
+subroutine five_SaveAll(n,my_alloc)
+  use my_omp_lib
+  implicit none
+  save
+  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" }
+end
+
+
+subroutine five_Save(n,my_alloc)
+  use my_omp_lib
+  implicit none
+  integer :: n
+  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" }
+end
+
+module five_Module
+  use my_omp_lib
+  implicit none
+  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" }
+end module
+
+program five_program
+  use my_omp_lib
+  implicit none
+  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" }
+end program
+
+
+
+subroutine six(n,my_alloc)
+  use my_omp_lib
+  implicit none
+  integer :: qq, rr, ss, tt, uu, vv,n
+  common /com6qq/ qq
+  common /com6rr/ rr
+  common /com6ss/ ss
+  common /com6tt/ tt
+  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" }
+end
+
+
+subroutine two()
+  use my_omp_lib
+  implicit none
+  integer,allocatable :: qq, rr, ss, tt, uu, vv,n
+  integer(omp_allocator_handle_kind) :: my_alloc
+
+  call foo()
+!$omp allocate (qq) allocator(3.0)  ! { dg-error "Expected integer expression of the 'omp_allocator_handle_kind' kind" }
+allocate(qq)
+!$omp allocate (rr) allocator(3_2)  ! { dg-error "Expected integer expression of the 'omp_allocator_handle_kind' kind" }
+allocate(rr)
+!$omp allocate (ss) allocator([omp_pteam_mem_alloc])  ! { dg-error "Expected integer expression of the 'omp_allocator_handle_kind' kind" }
+allocate(ss)
+!$omp allocate (tt) allocator(my_alloc)  ! OK
+allocate(tt)
+end
+
+subroutine two_ptr()
+  use my_omp_lib
+  implicit none
+  integer,pointer :: qq, rr, ss, tt, uu, vv,n
+  integer(omp_allocator_handle_kind) :: my_alloc
+
+  call foo()
+!$omp allocate (qq) align(3+n) ! { dg-error "ALIGN requires a scalar positive constant integer alignment expression at .1." }
+allocate(qq)
+!$omp allocate (rr) align([4]) ! { dg-error "ALIGN requires a scalar positive constant integer alignment expression at .1." }
+allocate(rr)
+!$omp allocate (ss) align([4]) ! { dg-error "ALIGN requires a scalar positive constant integer alignment expression at .1." }
+allocate(ss)
+!$omp allocate (tt) align(32.0) ! { dg-error "ALIGN requires a scalar positive constant integer alignment expression at .1." }
+allocate(tt)
+
+end
+
+subroutine next()
+  use my_omp_lib
+  implicit none
+  integer,allocatable :: qq, rr, ss, tt, uu, vv,n
+  integer(omp_allocator_handle_kind) :: my_alloc
+
+  !$omp allocate(qq)  ! { dg-error "'!.OMP ALLOCATE' directive at .1. associated with an ALLOCATE stmt must be preceded by an executable statement or OpenMP construct; note the variables in the list all have the allocatable or pointer attribute" }
+   allocate(qq,rr)
+
+  !$omp allocate(uu,tt)
+  !$omp allocate(tt)  ! { dg-warning "'tt' appears more than once in 'allocate" }
+   allocate(uu,tt)
+
+  !$omp allocate(uu,vv) ! { dg-error "'uu' specified in 'allocate' at .1. but not in the associated ALLOCATE statement" }
+   allocate(vv)
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/allocators-1.f90 b/gcc/testsuite/gfortran.dg/gomp/allocators-1.f90
new file mode 100644
index 0000000..b39f6d2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/allocators-1.f90
@@ -0,0 +1,28 @@
+implicit none
+integer, allocatable :: a, b
+integer :: q
+integer :: arr(2)
+
+!$omp allocators allocate(align(64): a)
+block  ! { dg-error "expected ALLOCATE statement after !.OMP ALLOCATORS" }
+end block ! { dg-error "Expecting END PROGRAM statement" }
+
+
+!$omp allocators allocate(align(64): a)
+  allocate(a, b)  ! OK
+!$omp end allocators
+
+!$omp allocators allocate(align(128): b)
+  allocate(a, b)  ! OK (assuming not allocated)
+
+
+!$omp allocators allocate(align(64): a)
+  allocate(a, b, stat=arr)  ! { dg-error "Stat-variable at .1. must be a scalar INTEGER variable" }
+!$omp end allocators
+
+
+!$omp allocators allocate(align(64): a)
+  allocate(q)  ! { dg-error "is neither a data pointer nor an allocatable variable" }
+!$omp end allocators ! { dg-error "Unexpected !.OMP END ALLOCATORS" }
+
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/allocators-2.f90 b/gcc/testsuite/gfortran.dg/gomp/allocators-2.f90
new file mode 100644
index 0000000..6fb8087
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/allocators-2.f90
@@ -0,0 +1,22 @@
+implicit none
+integer, allocatable :: a, b
+integer :: q
+integer :: arr(2)
+
+!$omp allocators allocate(align(64): a)
+  allocate(a, b)  ! OK
+!$omp end allocators
+
+!$omp allocators allocate(align(128): b)
+  allocate(a, b)  ! OK (assuming not allocated)
+
+
+!$omp allocators allocate(align(62.0): a) ! { dg-error "a scalar positive constant integer alignment expression" }
+ allocate(a)
+
+
+!$omp allocators allocate(align(64): a, b)  ! { dg-error "'b' specified in 'allocate' at \\(1\\) but not in the associated ALLOCATE statement" }
+ allocate(a)
+!$omp end allocators
+
+end