OpenMP/Fortran: Implement omp allocators/allocate for ptr/allocatables

This commit adds -fopenmp-allocators which enables support for
'omp allocators' and 'omp allocate' that are associated with a Fortran
allocate-stmt. If such a construct is encountered, an error is shown,
unless the -fopenmp-allocators flag is present.

With -fopenmp -fopenmp-allocators, those constructs get turned into
GOMP_alloc allocations, while -fopenmp-allocators (also without -fopenmp)
ensures deallocation and reallocation (via intrinsic assignments) are
properly directed to GOMP_free/omp_realloc - while normal Fortran
allocations are processed by free/realloc.

In order to distinguish a 'malloc'ed from a 'GOMP_alloc'ed memory, the
version field of the Fortran array discriptor is (mis)used: 0 indicates
the normal Fortran allocation while 1 denotes GOMP_alloc. For scalars,
there is record keeping in libgomp: GOMP_add_alloc(ptr) will add the
pointer address to a splay_tree while GOMP_is_alloc(ptr) will return
true it was previously added but also removes it from the list.

Besides Fortran FE work, BUILT_IN_GOMP_REALLOC is no part of
omp-builtins.def and libgomp gains the mentioned two new function.

gcc/ChangeLog:

	* builtin-types.def (BT_FN_PTR_PTR_SIZE_PTRMODE_PTRMODE): New.
	* omp-builtins.def (BUILT_IN_GOMP_REALLOC): New.
	* builtins.cc (builtin_fnspec): Handle it.
	* gimple-ssa-warn-access.cc (fndecl_alloc_p,
	matching_alloc_calls_p): Likewise.
	* gimple.cc (nonfreeing_call_p): Likewise.
	* predict.cc (expr_expected_value_1): Likewise.
	* tree-ssa-ccp.cc (evaluate_stmt): Likewise.
	* tree.cc (fndecl_dealloc_argno): Likewise.

gcc/fortran/ChangeLog:

	* dump-parse-tree.cc (show_omp_node): Handle EXEC_OMP_ALLOCATE
	and EXEC_OMP_ALLOCATORS.
	* f95-lang.cc (ATTR_ALLOC_WARN_UNUSED_RESULT_SIZE_2_NOTHROW_LIST):
	Add 'ECF_LEAF | ECF_MALLOC' to existing 'ECF_NOTHROW'.
	(ATTR_ALLOC_WARN_UNUSED_RESULT_SIZE_2_NOTHROW_LEAF_LIST): Define.
	* gfortran.h (gfc_omp_clauses): Add contained_in_target_construct.
	* invoke.texi (-fopenacc, -fopenmp): Update based on C version.
	(-fopenmp-simd): New, based on C version.
	(-fopenmp-allocators): New.
	* lang.opt (fopenmp-allocators): Add.
	* openmp.cc (resolve_omp_clauses): For allocators/allocate directive,
	add target and no dynamic_allocators diagnostic and more invalid
	diagnostic.
	* parse.cc (decode_omp_directive): Set contains_teams_construct.
	* trans-array.h (gfc_array_allocate): Update prototype.
	(gfc_conv_descriptor_version): New prototype.
	* trans-decl.cc (gfc_init_default_dt): Fix comment.
	* trans-array.cc (gfc_conv_descriptor_version): New.
	(gfc_array_allocate): Support GOMP_alloc allocation.
	(gfc_alloc_allocatable_for_assignment, structure_alloc_comps):
	Handle GOMP_free/omp_realloc as needed.
	* trans-expr.cc (gfc_conv_procedure_call): Likewise.
	(alloc_scalar_allocatable_for_assignment): Likewise.
	* trans-intrinsic.cc (conv_intrinsic_move_alloc): Likewise.
	* trans-openmp.cc (gfc_trans_omp_allocators,
	gfc_trans_omp_directive): Handle allocators/allocate directive.
	(gfc_omp_call_add_alloc, gfc_omp_call_is_alloc): New.
	* trans-stmt.h (gfc_trans_allocate): Update prototype.
	* trans-stmt.cc (gfc_trans_allocate): Support GOMP_alloc.
	* trans-types.cc (gfc_get_dtype_rank_type): Set version field.
	* trans.cc (gfc_allocate_using_malloc, gfc_allocate_allocatable):
	Update to handle GOMP_alloc.
	(gfc_deallocate_with_status, gfc_deallocate_scalar_with_status):
	Handle GOMP_free.
	(trans_code): Update call.
	* trans.h (gfc_allocate_allocatable, gfc_allocate_using_malloc):
	Update prototype.
	(gfc_omp_call_add_alloc, gfc_omp_call_is_alloc): New prototype.
	* types.def (BT_FN_PTR_PTR_SIZE_PTRMODE_PTRMODE): New.

libgomp/ChangeLog:

	* allocator.c (struct fort_alloc_splay_tree_key_s,
	fort_alloc_splay_compare, GOMP_add_alloc, GOMP_is_alloc): New.
	* libgomp.h: Define splay_tree_static for 'reverse' splay tree.
	* libgomp.map (GOMP_5.1.2): New; add GOMP_add_alloc and
	GOMP_is_alloc; move GOMP_target_map_indirect_ptr from ...
	(GOMP_5.1.1): ... here.
	* libgomp.texi (Impl. Status, Memory management): Update for
	allocators/allocate directives.
	* splay-tree.c: Handle splay_tree_static define to declare all
	functions as static.
	(splay_tree_lookup_node): New.
	* splay-tree.h: Handle splay_tree_decl_only define.
	(splay_tree_lookup_node): New prototype.
	* target.c: Define splay_tree_static for 'reverse'.
	* testsuite/libgomp.fortran/allocators-1.f90: New test.
	* testsuite/libgomp.fortran/allocators-2.f90: New test.
	* testsuite/libgomp.fortran/allocators-3.f90: New test.
	* testsuite/libgomp.fortran/allocators-4.f90: New test.
	* testsuite/libgomp.fortran/allocators-5.f90: New test.

gcc/testsuite/ChangeLog:

	* gfortran.dg/gomp/allocate-14.f90: Add coarray and
	not-listed tests.
	* gfortran.dg/gomp/allocate-5.f90: Remove sorry dg-message.
	* gfortran.dg/bind_c_array_params_2.f90: Update expected
	dump for dtype '.version=0'.
	* gfortran.dg/gomp/allocate-16.f90: New test.
	* gfortran.dg/gomp/allocators-3.f90: New test.
	* gfortran.dg/gomp/allocators-4.f90: New test.

12 files changed, 417 insertions, 7 deletions

diff --git a/libgomp/allocator.c b/libgomp/allocator.c
index a8a80f8..58a4c57 100644
--- a/libgomp/allocator.c
+++ b/libgomp/allocator.c
@@ -35,6 +35,69 @@
 #include <dlfcn.h>
 #endif
 
+/* Keeping track whether a Fortran scalar allocatable/pointer has been
+   allocated via 'omp allocators'/'omp allocate'.  */
+
+struct fort_alloc_splay_tree_key_s {
+  void *ptr;
+};
+
+typedef struct fort_alloc_splay_tree_node_s *fort_alloc_splay_tree_node;
+typedef struct fort_alloc_splay_tree_s *fort_alloc_splay_tree;
+typedef struct fort_alloc_splay_tree_key_s *fort_alloc_splay_tree_key;
+
+static inline int
+fort_alloc_splay_compare (fort_alloc_splay_tree_key x, fort_alloc_splay_tree_key y)
+{
+  if (x->ptr < y->ptr)
+    return -1;
+  if (x->ptr > y->ptr)
+    return 1;
+  return 0;
+}
+#define splay_tree_prefix fort_alloc
+#define splay_tree_static
+#include "splay-tree.h"
+
+#define splay_tree_prefix fort_alloc
+#define splay_tree_static
+#define splay_tree_c
+#include "splay-tree.h"
+
+static struct fort_alloc_splay_tree_s fort_alloc_scalars;
+
+/* Add pointer as being alloced by GOMP_alloc.  */
+void
+GOMP_add_alloc (void *ptr)
+{
+  if (ptr == NULL)
+    return;
+  fort_alloc_splay_tree_node item;
+  item = gomp_malloc (sizeof (struct splay_tree_node_s));
+  item->key.ptr = ptr;
+  item->left = NULL;
+  item->right = NULL;
+  fort_alloc_splay_tree_insert (&fort_alloc_scalars, item);
+}
+
+/* Remove pointer, either called by FREE or by REALLOC,
+   either of them can change the allocation status.  */
+bool
+GOMP_is_alloc (void *ptr)
+{
+  struct fort_alloc_splay_tree_key_s needle;
+  fort_alloc_splay_tree_node n;
+  needle.ptr = ptr;
+  n = fort_alloc_splay_tree_lookup_node (&fort_alloc_scalars, &needle);
+  if (n)
+    {
+      fort_alloc_splay_tree_remove (&fort_alloc_scalars, &n->key);
+      free (n);
+    }
+  return n != NULL;
+}
+
+
 #define omp_max_predefined_alloc omp_thread_mem_alloc
 
 /* These macros may be overridden in config/<target>/allocator.c.
diff --git a/libgomp/libgomp.h b/libgomp/libgomp.h
index fa29f42..7831e7b 100644
--- a/libgomp/libgomp.h
+++ b/libgomp/libgomp.h
@@ -1269,6 +1269,7 @@ reverse_splay_compare (reverse_splay_tree_key x, reverse_splay_tree_key y)
 }
 
 #define splay_tree_prefix reverse
+#define splay_tree_static
 #include "splay-tree.h"
 
 /* Indirect target function splay-tree handling.  */
diff --git a/libgomp/libgomp.map b/libgomp/libgomp.map
index 90c4014..65901df 100644
--- a/libgomp/libgomp.map
+++ b/libgomp/libgomp.map
@@ -419,9 +419,15 @@ GOMP_5.1 {
 GOMP_5.1.1 {
   global:
 	GOMP_taskwait_depend_nowait;
-	GOMP_target_map_indirect_ptr;
 } GOMP_5.1;
 
+GOMP_5.1.2 {
+  global:
+	GOMP_add_alloc;
+	GOMP_is_alloc;
+	GOMP_target_map_indirect_ptr;
+} GOMP_5.1.1;
+
 OACC_2.0 {
   global:
 	acc_get_num_devices;
diff --git a/libgomp/libgomp.texi b/libgomp/libgomp.texi
index 67a1112..cff2a2a 100644
--- a/libgomp/libgomp.texi
+++ b/libgomp/libgomp.texi
@@ -232,7 +232,9 @@ The OpenMP 4.5 specification is fully supported.
 @item Predefined memory spaces, memory allocators, allocator traits
       @tab Y @tab See also @ref{Memory allocation}
 @item Memory management routines @tab Y @tab
-@item @code{allocate} directive @tab P @tab Only C and Fortran, only stack variables
+@item @code{allocate} directive @tab P
+      @tab Only C for stack/automatic and Fortran for stack/automatic
+      and allocatable/pointer variables
 @item @code{allocate} clause @tab P @tab Initial support
 @item @code{use_device_addr} clause on @code{target data} @tab Y @tab
 @item @code{ancestor} modifier on @code{device} clause @tab Y @tab
@@ -304,7 +306,7 @@ The OpenMP 4.5 specification is fully supported.
 @item @code{strict} modifier in the @code{grainsize} and @code{num_tasks}
       clauses of the @code{taskloop} construct @tab Y @tab
 @item @code{align} clause in @code{allocate} directive @tab P
-      @tab Only C and Fortran (and only stack variables)
+      @tab Only C and Fortran (and not for static variables)
 @item @code{align} modifier in @code{allocate} clause @tab Y @tab
 @item @code{thread_limit} clause to @code{target} construct @tab Y @tab
 @item @code{has_device_addr} clause to @code{target} construct @tab Y @tab
@@ -402,7 +404,7 @@ to address of matching mapped list item per 5.1, Sect. 2.21.7.2 @tab N @tab
 @item Deprecation of @code{to} clause on declare target directive @tab N @tab
 @item Extended list of directives permitted in Fortran pure procedures
       @tab Y @tab
-@item New @code{allocators} directive for Fortran @tab N @tab
+@item New @code{allocators} directive for Fortran @tab Y @tab
 @item Deprecation of @code{allocate} directive for Fortran
       allocatables/pointers @tab N @tab
 @item Optional paired @code{end} directive with @code{dispatch} @tab N @tab
@@ -5697,8 +5699,12 @@ The description below applies to:
       @option{-fstack-arrays}].)
 @item Using the @code{allocate} directive for variable in static memory is
       currently not supported (compile time error).
-@item Using the @code{allocators} directive for Fortran pointers and
-      allocatables is currently not supported (compile time error).
+@item In Fortran, the @code{allocators} directive and the executable
+      @code{allocate} directive for Fortran pointers and allocatables is
+      supported, but requires that files containing those directives has to be
+      compiled with @option{-fopenmp-allocators}.  Additionally, all files that
+      might explicitly or implicitly deallocate memory allocated that way must
+      also be compiled with that option.
 @end itemize
 
 For the available predefined allocators and, as applicable, their associated
diff --git a/libgomp/splay-tree.c b/libgomp/splay-tree.c
index 02695d4..9e076f5 100644
--- a/libgomp/splay-tree.c
+++ b/libgomp/splay-tree.c
@@ -131,7 +131,11 @@ splay_tree_splay (splay_tree sp, splay_tree_key key)
 
 /* Insert a new NODE into SP.  The NODE shouldn't exist in the tree.  */
 
+#ifdef splay_tree_static
+__attribute__((unused)) static void
+#else
 attribute_hidden void
+#endif
 splay_tree_insert (splay_tree sp, splay_tree_node node)
 {
   int comparison = 0;
@@ -167,7 +171,11 @@ splay_tree_insert (splay_tree sp, splay_tree_node node)
 
 /* Remove node with KEY from SP.  It is not an error if it did not exist.  */
 
+#ifdef splay_tree_static
+__attribute__((unused)) static void
+#else
 attribute_hidden void
+#endif
 splay_tree_remove (splay_tree sp, splay_tree_key key)
 {
   splay_tree_splay (sp, key);
@@ -202,7 +210,28 @@ splay_tree_remove (splay_tree sp, splay_tree_key key)
 /* Lookup KEY in SP, returning NODE if present, and NULL
    otherwise.  */
 
+#ifdef splay_tree_static
+__attribute__((unused)) static splay_tree_node
+#else
+attribute_hidden splay_tree_node
+#endif
+splay_tree_lookup_node (splay_tree sp, splay_tree_key key)
+{
+  splay_tree_splay (sp, key);
+
+  if (sp->root && splay_compare (&sp->root->key, key) == 0)
+    return sp->root;
+  else
+    return NULL;
+}
+
+/* Likewise but return the key.  */
+
+#ifdef splay_tree_static
+__attribute__((unused)) static splay_tree_key
+#else
 attribute_hidden splay_tree_key
+#endif
 splay_tree_lookup (splay_tree sp, splay_tree_key key)
 {
   splay_tree_splay (sp, key);
@@ -231,7 +260,11 @@ splay_tree_foreach_internal (splay_tree_node node, splay_tree_callback func,
 
 /* Run FUNC on each of the nodes in SP.  */
 
+#ifdef splay_tree_static
+__attribute__((unused)) static void
+#else
 attribute_hidden void
+#endif
 splay_tree_foreach (splay_tree sp, splay_tree_callback func, void *data)
 {
   splay_tree_foreach_internal (sp->root, func, data);
@@ -253,8 +286,13 @@ splay_tree_foreach_internal_lazy (splay_tree_node node,
   return splay_tree_foreach_internal_lazy (node->right, func, data);
 }
 
+#ifdef splay_tree_static
+__attribute__((unused)) static void
+#else
 attribute_hidden void
-splay_tree_foreach_lazy (splay_tree sp, splay_tree_callback_stop func, void *data)
+#endif
+splay_tree_foreach_lazy (splay_tree sp, splay_tree_callback_stop func,
+			 void *data)
 {
   splay_tree_foreach_internal_lazy (sp->root, func, data);
 }
diff --git a/libgomp/splay-tree.h b/libgomp/splay-tree.h
index 978f1e4..04ff9473 100644
--- a/libgomp/splay-tree.h
+++ b/libgomp/splay-tree.h
@@ -35,6 +35,8 @@ typedef struct splay_tree_key_s *splay_tree_key;
    define splay_tree_key_s structure, and define
    splay_compare inline function.
 
+   Define splay_tree_static to mark all functions as static.
+
    Alternatively, they can define splay_tree_prefix macro before
    including this header and then all the above types, the
    splay_compare function and the splay_tree_{lookup,insert_remove}
@@ -72,6 +74,8 @@ typedef struct splay_tree_key_s *splay_tree_key;
     splay_tree_name (splay_tree_prefix, splay_compare)
 # define splay_tree_lookup	\
     splay_tree_name (splay_tree_prefix, splay_tree_lookup)
+# define splay_tree_lookup_node	\
+    splay_tree_name (splay_tree_prefix, splay_tree_lookup_node)
 # define splay_tree_insert	\
     splay_tree_name (splay_tree_prefix, splay_tree_insert)
 # define splay_tree_remove	\
@@ -105,11 +109,19 @@ struct splay_tree_s {
 typedef void (*splay_tree_callback) (splay_tree_key, void *);
 typedef int (*splay_tree_callback_stop) (splay_tree_key, void *);
 
+#ifndef splay_tree_static
 extern splay_tree_key splay_tree_lookup (splay_tree, splay_tree_key);
+extern splay_tree_node splay_tree_lookup_node (splay_tree, splay_tree_key);
 extern void splay_tree_insert (splay_tree, splay_tree_node);
 extern void splay_tree_remove (splay_tree, splay_tree_key);
 extern void splay_tree_foreach (splay_tree, splay_tree_callback, void *);
 extern void splay_tree_foreach_lazy (splay_tree, splay_tree_callback_stop, void *);
+#endif
+
+#ifdef splay_tree_static_unused_attr
+#  undef splay_tree_static_unused_attr
+#endif
+
 #else  /* splay_tree_c */
 #  ifdef splay_tree_prefix
 #    include "splay-tree.c"
@@ -117,6 +129,10 @@ extern void splay_tree_foreach_lazy (splay_tree, splay_tree_callback_stop, void
 #  undef splay_tree_c
 #endif /* #ifndef splay_tree_c */
 
+#ifdef splay_tree_static
+#  undef splay_tree_static
+#endif
+
 #ifdef splay_tree_prefix
 #  undef splay_tree_name_1
 #  undef splay_tree_name
@@ -128,6 +144,7 @@ extern void splay_tree_foreach_lazy (splay_tree, splay_tree_callback_stop, void
 #  undef splay_tree_key
 #  undef splay_compare
 #  undef splay_tree_lookup
+#  undef splay_tree_lookup_node
 #  undef splay_tree_insert
 #  undef splay_tree_remove
 #  undef splay_tree_foreach
diff --git a/libgomp/target.c b/libgomp/target.c
index f30c202..0637d34 100644
--- a/libgomp/target.c
+++ b/libgomp/target.c
@@ -47,6 +47,7 @@
 
 /* Define another splay tree instantiation - for reverse offload.  */
 #define splay_tree_prefix reverse
+#define splay_tree_static
 #define splay_tree_c
 #include "splay-tree.h"
 
diff --git a/libgomp/testsuite/libgomp.fortran/allocators-1.f90 b/libgomp/testsuite/libgomp.fortran/allocators-1.f90
new file mode 100644
index 0000000..935a37c
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/allocators-1.f90
@@ -0,0 +1,68 @@
+! { dg-additional-options "-fopenmp-allocators -fdump-tree-original" }
+module m
+  use omp_lib
+  use iso_c_binding, only: c_intptr_t
+  implicit none (type,external)
+  integer(omp_allocator_handle_kind) :: handle  
+  integer(c_intptr_t) :: iptr
+end module m
+
+subroutine scalar
+  use m
+  implicit none (type,external)
+  integer :: i
+  integer, allocatable :: SSS
+  i = 5  ! required executive statement before 'omp allocators'
+  !$omp allocate allocator(handle)
+  allocate(SSS)
+  if (mod (loc (sss), 64) /= 0) stop 1
+  deallocate(SSS)
+  allocate(SSS)
+end
+! { dg-final { scan-tree-dump-times "sss = \\(integer\\(kind=4\\) \\*\\) __builtin_GOMP_alloc \\(4, 4, D\\.\[0-9\]+\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "GOMP_add_alloc \\(sss\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "if \\(GOMP_is_alloc \\(sss\\)\\)" 2 "original" } }
+! { dg-final { scan-tree-dump-times "__builtin_GOMP_free \\(sss, 0B\\);" 2 "original" } }
+
+subroutine array
+  use m
+  implicit none (type,external)
+  integer :: i
+  integer, allocatable :: A(:)
+  i = 5  ! required executive statement before 'omp allocators'
+  !$omp allocate allocator(handle) align(512)
+  allocate(A(5))
+  if (mod (loc (A), 512) /= 0) stop 2
+  A=[1]
+  if (mod (loc (A), 64) /= 0) stop 3
+  deallocate(A)
+  A=[1]
+  deallocate(A)
+  call omp_set_default_allocator (handle)
+  !$omp allocate
+  allocate(A(7))
+  if (mod (loc (A), 64) /= 0) stop 4
+end
+! { dg-final { scan-tree-dump-times "a.dtype = {.elem_len=4, .version=0, .rank=1, .type=1};" 5 "original" } }
+! { dg-final { scan-tree-dump-times "\\.elem_len=4" 5 "original" } }
+! { dg-final { scan-tree-dump-times "a.data = \\(void \\* restrict\\) __builtin_GOMP_alloc \\(512, 20, D\\.\[0-9\]+\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "a.data = \\(void \\* restrict\\) __builtin_GOMP_alloc \\(4, 28, 0B\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "a.dtype.version = 1;" 2 "original" } }
+! { dg-final { scan-tree-dump-times "a.data = \\(void \\* restrict\\) \\(a.dtype.version == 1 \\? __builtin_omp_realloc \\(\\(void \\*\\) a.data, 4, 0B, 0B\\) : __builtin_realloc \\(\\(void \\*\\) a.data, 4\\)\\);" 2 "original" } }
+! { dg-final { scan-tree-dump-times "if \\(a.dtype.version == 1\\)" 3 "original" } }
+! { dg-final { scan-tree-dump-times "__builtin_GOMP_free \\(\\(integer\\(kind=4\\)\\\[0:\\\] \\* restrict\\) a.data, 0B\\);" 3 "original" } }
+! { dg-final { scan-tree-dump-times "a.dtype.version = 0;" 3 "original" } }
+
+program main
+  use m
+  implicit none (type,external)
+  external :: scalar, array
+  type (omp_alloctrait), parameter :: traits(*) &
+      = [omp_alloctrait(omp_atk_sync_hint, omp_atv_contended), &
+         omp_alloctrait(omp_atk_alignment, 64)]
+  handle = omp_init_allocator (omp_high_bw_mem_alloc, size(traits), traits)
+  call scalar
+  call array
+  call omp_destroy_allocator (handle)
+end
+
diff --git a/libgomp/testsuite/libgomp.fortran/allocators-2.f90 b/libgomp/testsuite/libgomp.fortran/allocators-2.f90
new file mode 100644
index 0000000..c42fbd3
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/allocators-2.f90
@@ -0,0 +1,101 @@
+! { dg-additional-options "-fopenmp-allocators" }
+module m
+  implicit none (type, external)
+  type t
+    integer, allocatable :: Acomp, Bcomp(:)
+  end type t
+
+contains
+
+subroutine intent_out(aa, bb, cc, dd, ee, ff)
+  integer, allocatable,intent(out) :: aa, bb(:)
+  type(t), intent(out) :: cc, dd(4)
+  type(t), allocatable, intent(out) :: ee, ff(:)
+end
+
+subroutine q(qa, qb, qc, qd, qe, qf)
+  integer, allocatable :: qa, qb(:)
+  type(t) :: qc, qd(4)
+  type(t), allocatable :: qe, qf(:)
+  call intent_out (qa, qb, qc, qd, qe, qf)
+end subroutine q
+
+subroutine r
+  integer, allocatable :: r1, r2(:)
+  type(t) :: r3, r4(4)
+  type(t), allocatable :: r5, r6(:)
+
+  call q(r1,r2,r3,r4,r5,r6)
+
+  allocate(r1,r2(3))
+  allocate(r5,r6(4))
+  allocate(r3%Acomp, r3%Bcomp(2))
+  allocate(r4(2)%Acomp, r4(2)%Bcomp(2))
+  allocate(r5%Acomp, r5%Bcomp(2))
+  allocate(r6(3)%Acomp, r6(3)%Bcomp(2))
+  !$omp allocate align(128)
+  allocate(r4(3)%Acomp, r4(3)%Bcomp(2), &
+           r6(1)%Acomp, r6(1)%Bcomp(2))
+  if (mod (loc (r4(3)%Acomp), 128) /= 0) stop 1
+  if (mod (loc (r4(3)%Bcomp), 128) /= 0) stop 2
+  if (mod (loc (r6(1)%Acomp), 128) /= 0) stop 3
+  if (mod (loc (r6(1)%Bcomp), 128) /= 0) stop 3
+  call q(r1,r2,r3,r4,r5,r6)
+
+  !$omp allocate align(64)
+  allocate(r1,r2(3))
+  if (mod (loc (r1), 64) /= 0) stop 1
+  if (mod (loc (r2), 64) /= 0) stop 1
+  !$omp allocate align(64)
+  allocate(r5,r6(4))
+  if (mod (loc (r5), 64) /= 0) stop 1
+  if (mod (loc (r6), 64) /= 0) stop 1
+  !$omp allocate align(64)
+  allocate(r3%Acomp, r3%Bcomp(2))
+  if (mod (loc (r3%Acomp), 64) /= 0) stop 1
+  if (mod (loc (r3%Bcomp), 64) /= 0) stop 1
+  !$omp allocate align(64)
+  allocate(r4(2)%Acomp, r4(2)%Bcomp(2))
+  if (mod (loc (r4(2)%Acomp), 64) /= 0) stop 1
+  if (mod (loc (r4(2)%Bcomp), 64) /= 0) stop 1
+  !$omp allocate align(64)
+  allocate(r5%Acomp, r5%Bcomp(2))
+  if (mod (loc (r5%Acomp), 64) /= 0) stop 1
+  if (mod (loc (r5%Bcomp), 64) /= 0) stop 1
+  !$omp allocate align(64)
+  allocate(r6(3)%Acomp, r6(3)%Bcomp(2))
+  if (mod (loc (r6(3)%Acomp), 64) /= 0) stop 1
+  if (mod (loc (r6(3)%Bcomp), 64) /= 0) stop 1
+  !$omp allocate align(128)
+  allocate(r4(3)%Acomp, r4(3)%Bcomp(2), &
+           r6(1)%Acomp, r6(1)%Bcomp(2))
+  if (mod (loc (r4(3)%Acomp), 128) /= 0) stop 1
+  if (mod (loc (r4(3)%Bcomp), 128) /= 0) stop 2
+  if (mod (loc (r6(1)%Acomp), 128) /= 0) stop 3
+  if (mod (loc (r6(1)%Bcomp), 128) /= 0) stop 3
+  call q(r1,r2,r3,r4,r5,r6)
+end subroutine r
+end
+
+subroutine s
+  use m, only : t
+  implicit none (type, external)
+  type(t) :: xx
+  integer :: i, iiiiii
+  i = 4
+  !$omp allocate
+  allocate(xx%Acomp, xx%Bcomp(4))
+  deallocate(xx%Acomp, xx%Bcomp)
+
+  !$omp allocate
+  allocate(xx%Acomp, xx%Bcomp(4))
+  xx = t(1, [1,2])
+end
+
+program main
+  use m, only: r
+  implicit none (type, external)
+  external s
+  call s
+  call r
+end
diff --git a/libgomp/testsuite/libgomp.fortran/allocators-3.f90 b/libgomp/testsuite/libgomp.fortran/allocators-3.f90
new file mode 100644
index 0000000..2e05939
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/allocators-3.f90
@@ -0,0 +1,25 @@
+! { dg-additional-options "-fdump-tree-original -fopenmp-allocators" }
+
+subroutine s
+  character(:), allocatable :: s1,s2
+
+  !$omp allocators allocate(s1)
+  allocate(character(len=3) :: s1)
+
+  !$omp allocators allocate(s2)
+  allocate(character(len=5) :: s2)
+
+  s2(1:5) = "12"
+  s1 = trim(s2)
+end
+! { dg-final { scan-tree-dump-times "s1 = \\(character\\(kind=1\\)\\\[1:.s1\\\] \\*\\) __builtin_GOMP_alloc \\(1, 3, 0B\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "s2 = \\(character\\(kind=1\\)\\\[1:.s2\\\] \\*\\) __builtin_GOMP_alloc \\(1, 5, 0B\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "s1 = \\(character\\(kind=1\\)\\\[1:.s1\\\] \\*\\) \\(D\\.\[0-9\]+ \\? __builtin_omp_realloc \\(\\(void \\*\\) s1, MAX_EXPR <\\(sizetype\\) len.1, 1>, 0B, 0B\\) : __builtin_realloc \\(\\(void \\*\\) s1, MAX_EXPR <\\(sizetype\\) len.1, 1>\\)\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "GOMP_add_alloc \\(s1\\);" 2 "original" } }
+! { dg-final { scan-tree-dump-times "OMP_add_alloc \\(s2\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "if \\(GOMP_is_alloc \\(s2\\)\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "__builtin_GOMP_free \\(s2, 0B\\);" 1 "original" } }
+
+
+call s
+end
diff --git a/libgomp/testsuite/libgomp.fortran/allocators-4.f90 b/libgomp/testsuite/libgomp.fortran/allocators-4.f90
new file mode 100644
index 0000000..12689ea
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/allocators-4.f90
@@ -0,0 +1,57 @@
+! { dg-additional-options "-fopenmp-allocators" }
+module m
+implicit none
+type t
+  integer, allocatable :: Acomp, Bcomp(:)
+  class(*), allocatable :: Ccomp, Dcomp(:)
+end type t
+contains
+
+subroutine intout(c,d,e,f)
+implicit none
+class(t), intent(out) :: c,d(4)
+class(t), allocatable, intent(out) :: e,f(:)
+end
+
+subroutine q(c,d,e,f)
+implicit none
+class(t) :: c,d(4)
+class(t), allocatable :: e,f(:)
+call intout(c,d,e,f)
+end subroutine q
+
+subroutine s
+implicit none
+type(t) :: xx
+class(t), allocatable :: yy
+integer :: i, iiiiii
+i = 4
+!$omp allocate
+allocate(xx%Acomp, xx%Bcomp(4))
+deallocate(xx%Acomp, xx%Bcomp)
+
+!$omp allocate
+allocate(integer :: xx%Ccomp, xx%Dcomp(4))
+deallocate(xx%Ccomp, xx%Dcomp)
+
+!$omp allocators allocate(yy)
+allocate(t :: yy)
+
+!$omp allocate
+allocate(real :: xx%Ccomp, xx%Dcomp(4))
+deallocate(xx%Ccomp, xx%Dcomp)
+
+!$omp allocate
+allocate(xx%Acomp, xx%Bcomp(4))
+!$omp allocate
+allocate(logical :: xx%Ccomp, xx%Dcomp(4))
+
+iiiiii = 555
+xx = t(1, [1,2])
+end
+
+end module
+
+use m
+call s
+end
diff --git a/libgomp/testsuite/libgomp.fortran/allocators-5.f90 b/libgomp/testsuite/libgomp.fortran/allocators-5.f90
new file mode 100644
index 0000000..8708863
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/allocators-5.f90
@@ -0,0 +1,27 @@
+! { dg-additional-options "-fopenmp-allocators" }
+module m
+contains
+subroutine s(a,b,c,d)
+integer, allocatable :: A, B
+integer, allocatable :: C(:), D(:)
+
+!$omp allocators allocate(A,B)
+allocate(A,B)
+call move_alloc(A,B)
+
+!$omp allocators allocate(C,D)
+allocate(C(5),D(5))
+call move_alloc(C,D)
+end
+
+subroutine q()
+integer, allocatable :: A, B
+integer, allocatable :: C(:), D(:)
+
+call s(a,b,c,d)
+end
+end
+
+use m
+call q
+end