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

The attached patch adds 'omp allocate' support for stack/automatic variables
variables for Fortran.

I had originally a pure FE version for Fortran, which failed with 'defaultmap'/'default';
I then thought I could simply piggyback on the existing C/C++ support.

But it turns out that Fortran is completely different, e.g. there is often no BIND_EXPR
but just some (scoped / try-final-expr) code inside of it, i.e. the scope of the BIND_EXPR
has no relation to where GOMP_alloc has to be added. (GOMP_free is less critical, except
that a longer lifetime might cause memory constraints.)

Thus, RFC:
- Is the current scheme okay or should me move moved to the FE
   there is not that much happening at the ME?
- Should for the one 'if (lang_GNU_Fortran () ...' condition a lang hook
   be introduced?

Any other suggestions?

ALSO: I decided that the wording permits 'type(c_ptr)', 'type(c_funptr)' as they are
rather normal variables (of opaque type) in the Fortran sense. I decided that we do
not want to support EQUIVALENCE, Cray pointers, COMMON blocks ever (even though the
first to surely could be made to work, the latter - maybe.)
I also reject coarrays as it is really incompatible for allocate/allocators; for
the 'allocate' clause, that's different and permitted (just used for privatization).

Thoughts, suggestions?

Tobias
-----------------
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

On Tue, Oct 10, 2023 at 06:46:35PM +0200, Tobias Burnus wrote:
> 	* parse.cc (check_omp_allocate_stmt): Permit procedure pointers
> 	here (rejected later) for less mislreading diagnostic.

s/misl/mis/

> libgomp/ChangeLog:
> 
> 	* libgomp.texi:

Fill in something here.

> @@ -7220,8 +7227,7 @@ gfc_resolve_omp_allocate (gfc_namespace *ns, gfc_omp_namelist *list)
>  		     &n->where);
>  	  continue;
>  	}
> -      if (ns != n->sym->ns || n->sym->attr.use_assoc
> -	  || n->sym->attr.host_assoc || n->sym->attr.imported)
> +      if (ns != n->sym->ns || n->sym->attr.use_assoc ||  n->sym->attr.imported)

s/  n/ n/

> --- a/gcc/gimplify.cc
> +++ b/gcc/gimplify.cc
> @@ -1400,23 +1400,53 @@ gimplify_bind_expr (tree *expr_p, gimple_seq *pre_p)
>  			  "region must specify an %<allocator%> clause", t);
>  	      /* Skip for omp_default_mem_alloc (= 1),
>  		 unless align is present. */
> -	      else if (!errorcount
> -		       && (align != NULL_TREE
> -			   || alloc == NULL_TREE
> -			   || !integer_onep (alloc)))
> +	      else if (errorcount
> +		       || (align == NULL_TREE
> +			   && alloc != NULL_TREE
> +			   && integer_onep (alloc)))
> +		DECL_ATTRIBUTES (t) = remove_attribute ("omp allocate",
> +							DECL_ATTRIBUTES (t));

Probably already preexisting, by I wonder how safe remove_attribute is.
Aren't attributes shared in some cases
(like __attribute__((attr1, attr2, attr3)) int a, b, c, d;)?
Not really sure if something unshares them afterwards.
If they are shared, adding new attributes is fine, that will make the new
additions not shared and the tail shared, but remove_attribute could remove
it from all of them at once.  Perhaps I'm wrong, haven't verified.

Otherwise LGTM (though, I didn't spot anything about allocatables in the
patch, am I just looking wrong or are they still unsupported)?

	Jakub

On 13.10.23 13:01, Jakub Jelinek wrote:
> On Tue, Oct 10, 2023 at 06:46:35PM +0200, Tobias Burnus wrote:
> +++ b/gcc/gimplify.cc
>> @@ -1400,23 +1400,53 @@ gimplify_bind_expr (tree *expr_p, gimple_seq *pre_p)
>> +          else if (errorcount
>> +                   || (align == NULL_TREE
>> +                       && alloc != NULL_TREE
>> +                       && integer_onep (alloc)))
>> +            DECL_ATTRIBUTES (t) = remove_attribute ("omp allocate",
>> +                                                    DECL_ATTRIBUTES (t));
> Probably already preexisting, by I wonder how safe remove_attribute is.
> Aren't attributes shared in some cases
> (like __attribute__((attr1, attr2, attr3)) int a, b, c, d;)?

I think there should be no problem – new attributes get added as:

DECL_ATTRIBUTES (var) = tree_cons (get_identifier ("omp allocate"),
                                    t, DECL_ATTRIBUTES (var));

Thus, attr = DECL_ATTRIBUTES (var) is not shared, even if
TREE_CHAIN (attr) might be shared.

Thus, as long as new attributes get added at the head of the chain,
there should be no issue. And "omp allocate" is added once per decl
and is therefore not shared - removing might create again a shared
tree, but any following 'tree_cons' will again unshare it.

I think in your case, there would be indeed a problem when doing:
   'tree attr = remove_attr (...("attr2") ...)'
as this would remove "attr2" for 4 decls.

* * *

However, as 'omp allocate' is not used later on, I also do not need
to remove it.

=> Updated patch attached + interdiff for gimplify.cc attached.

Changes:
* Condition now the same as previously
* Keep 'omp allocate' also for DECL_VALUE_EXPR variable
* Add assert that we either have Fortran's expression the GOMP_FREE
   location - or a DECL_VALUE_EXPR.
* Make use of the assertion by keeping the HAS_DECL_VALUE expr below;
   this avoids adding an align/allocator == default check.
   => same code as old code, except for creating + using 'v' variable
   and adding a clobber.

* * *

> Otherwise LGTM (though, I didn't spot anything about allocatables in the
> patch, am I just looking wrong or are they still unsupported)?

It's unsupported – albeit Chung-Lin has some patch for it. The code path
is completely different. It already starts by 'omp allocators' (+
legacy: 'omp allocate') being not declarative but executable and
associated with a Fortran 'allocate'  statement and ...

Sorry for being slow - but I keep getting distracted by other tasks ...

Tobias
-----------------
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

Hi Tobias!

On 2023-10-13T15:29:52+0200, Tobias Burnus <tobias@codesourcery.com> wrote:
> => Updated patch attached

When cherry-picking this commit cccc2d3dbf0eff668bed5f5f168b3cafd8590c54
"Fortran: Support OpenMP's 'allocate' directive for stack vars" on top of
slightly older GCC sources (mentioning that just in case that's
relevant), in a configuration with offloading enabled (only), I see:

    +FAIL: gfortran.dg/gomp/allocate-13.f90   -O  (internal compiler error: tree code 'statement_list' is not supported in LTO streams)
    +FAIL: gfortran.dg/gomp/allocate-13.f90   -O  (test for excess errors)

    during IPA pass: modref
    [...]/gcc/testsuite/gfortran.dg/gomp/allocate-13.f90:10:3: internal compiler error: tree code 'statement_list' is not supported in LTO streams
    0x13374fd lto_write_tree
            [...]/gcc/lto-streamer-out.cc:561
    0x13374fd lto_output_tree_1
            [...]/gcc/lto-streamer-out.cc:599
    0x133f55b DFS::DFS(output_block*, tree_node*, bool, bool, bool)
            [...]/gcc/lto-streamer-out.cc:899
    0x1340287 lto_output_tree(output_block*, tree_node*, bool, bool)
            [...]/gcc/lto-streamer-out.cc:1865
    0x134197a output_function
            [...]/gcc/lto-streamer-out.cc:2436
    0x134197a lto_output()
            [...]/gcc/lto-streamer-out.cc:2807
    0x13d0551 write_lto
            [...]/gcc/passes.cc:2774
    0x13d0551 ipa_write_summaries_1
            [...]/gcc/passes.cc:2838
    0x13d0551 ipa_write_summaries()
            [...]/gcc/passes.cc:2894
    0x1002f2c ipa_passes
            [...]/gcc/cgraphunit.cc:2251
    0x1002f2c symbol_table::compile()
            [...]/gcc/cgraphunit.cc:2331
    0x10056b7 symbol_table::compile()
            [...]/gcc/cgraphunit.cc:2311
    0x10056b7 symbol_table::finalize_compilation_unit()
            [...]/gcc/cgraphunit.cc:2583

Similarly:

    +FAIL: libgomp.fortran/allocate-6.f90   -O  (internal compiler error: tree code 'statement_list' is not supported in LTO streams)

    +FAIL: libgomp.fortran/allocate-7.f90   -O  (internal compiler error: tree code 'statement_list' is not supported in LTO streams)


Grüße
 Thomas


> Fortran: Support OpenMP's 'allocate' directive for stack vars
>
> gcc/fortran/ChangeLog:
>
>       * gfortran.h (ext_attr_t): Add omp_allocate flag.
>       * match.cc (gfc_free_omp_namelist): Void deleting same
>       u2.allocator multiple times now that a sequence can use
>       the same one.
>       * openmp.cc (gfc_match_omp_clauses, gfc_match_omp_allocate): Use
>       same allocator expr multiple times.
>       (is_predefined_allocator): Make static.
>       (gfc_resolve_omp_allocate): Update/extend restriction checks;
>       remove sorry message.
>       (resolve_omp_clauses): Reject corarrays in allocate/allocators
>       directive.
>       * parse.cc (check_omp_allocate_stmt): Permit procedure pointers
>       here (rejected later) for less misleading diagnostic.
>       * trans-array.cc (gfc_trans_auto_array_allocation): Propagate
>       size for GOMP_alloc and location to which it should be added to.
>       * trans-decl.cc (gfc_trans_deferred_vars): Handle 'omp allocate'
>       for stack variables; sorry for static variables/common blocks.
>       * trans-openmp.cc (gfc_trans_omp_clauses): Evaluate 'allocate'
>       clause's allocator only once; fix adding expressions to the
>       block.
>       (gfc_trans_omp_single): Pass a block to gfc_trans_omp_clauses.
>
> gcc/ChangeLog:
>
>       * gimplify.cc (gimplify_bind_expr): Handle Fortran's
>       'omp allocate' for stack variables.
>
> libgomp/ChangeLog:
>
>       * libgomp.texi (OpenMP Impl. Status): Mention that Fortran now
>       supports the allocate directive for stack variables.
>       * testsuite/libgomp.fortran/allocate-5.f90: New test.
>       * testsuite/libgomp.fortran/allocate-6.f90: New test.
>       * testsuite/libgomp.fortran/allocate-7.f90: New test.
>       * testsuite/libgomp.fortran/allocate-8.f90: New test.
>
> gcc/testsuite/ChangeLog:
>
>       * c-c++-common/gomp/allocate-14.c: Fix directive name.
>       * c-c++-common/gomp/allocate-15.c: Likewise.
>       * c-c++-common/gomp/allocate-9.c: Fix comment typo.
>       * gfortran.dg/gomp/allocate-4.f90: Remove sorry dg-error.
>       * gfortran.dg/gomp/allocate-7.f90: Likewise.
>       * gfortran.dg/gomp/allocate-10.f90: New test.
>       * gfortran.dg/gomp/allocate-11.f90: New test.
>       * gfortran.dg/gomp/allocate-12.f90: New test.
>       * gfortran.dg/gomp/allocate-13.f90: New test.
>       * gfortran.dg/gomp/allocate-14.f90: New test.
>       * gfortran.dg/gomp/allocate-15.f90: New test.
>       * gfortran.dg/gomp/allocate-8.f90: New test.
>       * gfortran.dg/gomp/allocate-9.f90: New test.
>
>  gcc/fortran/gfortran.h                           |   1 +
>  gcc/fortran/match.cc                             |   9 +-
>  gcc/fortran/openmp.cc                            |  62 +++-
>  gcc/fortran/parse.cc                             |   8 +-
>  gcc/fortran/trans-array.cc                       |  28 +-
>  gcc/fortran/trans-decl.cc                        | 126 +++++++++
>  gcc/fortran/trans-openmp.cc                      |  77 +++--
>  gcc/gimplify.cc                                  | 166 ++++++++---
>  gcc/testsuite/c-c++-common/gomp/allocate-14.c    |   2 +-
>  gcc/testsuite/c-c++-common/gomp/allocate-15.c    |   2 +-
>  gcc/testsuite/c-c++-common/gomp/allocate-9.c     |   2 +-
>  gcc/testsuite/gfortran.dg/gomp/allocate-10.f90   |  75 +++++
>  gcc/testsuite/gfortran.dg/gomp/allocate-11.f90   |  33 +++
>  gcc/testsuite/gfortran.dg/gomp/allocate-12.f90   |  24 ++
>  gcc/testsuite/gfortran.dg/gomp/allocate-13.f90   |  25 ++
>  gcc/testsuite/gfortran.dg/gomp/allocate-14.f90   |  95 +++++++
>  gcc/testsuite/gfortran.dg/gomp/allocate-15.f90   |  38 +++
>  gcc/testsuite/gfortran.dg/gomp/allocate-4.f90    |   4 +-
>  gcc/testsuite/gfortran.dg/gomp/allocate-7.f90    |  10 -
>  gcc/testsuite/gfortran.dg/gomp/allocate-8.f90    |  29 ++
>  gcc/testsuite/gfortran.dg/gomp/allocate-9.f90    | 112 ++++++++
>  libgomp/libgomp.texi                             |   4 +-
>  libgomp/testsuite/libgomp.fortran/allocate-5.f90 |  87 ++++++
>  libgomp/testsuite/libgomp.fortran/allocate-6.f90 | 123 ++++++++
>  libgomp/testsuite/libgomp.fortran/allocate-7.f90 | 342 +++++++++++++++++++++++
>  libgomp/testsuite/libgomp.fortran/allocate-8.f90 |  99 +++++++
>  26 files changed, 1484 insertions(+), 99 deletions(-)
>
> diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
> index 6caf7765ac6..88f33b0957e 100644
> --- a/gcc/fortran/gfortran.h
> +++ b/gcc/fortran/gfortran.h
> @@ -1000,6 +1000,7 @@ typedef struct
>    unsigned omp_declare_target:1;
>    unsigned omp_declare_target_link:1;
>    ENUM_BITFIELD (gfc_omp_device_type) omp_device_type:2;
> +  unsigned omp_allocate:1;
>
>    /* Mentioned in OACC DECLARE.  */
>    unsigned oacc_declare_create:1;
> diff --git a/gcc/fortran/match.cc b/gcc/fortran/match.cc
> index c926f38058f..148a86bb436 100644
> --- a/gcc/fortran/match.cc
> +++ b/gcc/fortran/match.cc
> @@ -5541,6 +5541,7 @@ gfc_free_omp_namelist (gfc_omp_namelist *name, bool free_ns,
>                      bool free_mem_traits_space)
>  {
>    gfc_omp_namelist *n;
> +  gfc_expr *last_allocator = NULL;
>
>    for (; name; name = n)
>      {
> @@ -5552,7 +5553,13 @@ gfc_free_omp_namelist (gfc_omp_namelist *name, bool free_ns,
>        if (free_ns)
>       gfc_free_namespace (name->u2.ns);
>        else if (free_align_allocator)
> -     gfc_free_expr (name->u2.allocator);
> +     {
> +       if (last_allocator != name->u2.allocator)
> +         {
> +           last_allocator = name->u2.allocator;
> +           gfc_free_expr (name->u2.allocator);
> +         }
> +     }
>        else if (free_mem_traits_space)
>       { }  /* name->u2.traits_sym: shall not call gfc_free_symbol here. */
>        else if (name->u2.udr)
> diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc
> index 79b5ae0e4bd..1cc65d7fa49 100644
> --- a/gcc/fortran/openmp.cc
> +++ b/gcc/fortran/openmp.cc
> @@ -2032,11 +2032,9 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
>
>             for (gfc_omp_namelist *n = *head; n; n = n->next)
>               {
> -               n->u2.allocator = ((allocator)
> -                                  ? gfc_copy_expr (allocator) : NULL);
> +               n->u2.allocator = allocator;
>                 n->u.align = (align) ? gfc_copy_expr (align) : NULL;
>               }
> -           gfc_free_expr (allocator);
>             gfc_free_expr (align);
>             continue;
>           }
> @@ -4547,9 +4545,8 @@ gfc_match_omp_allocate (void)
>        for (; vars; vars = vars->next)
>       {
>         vars->u.align = (align) ? gfc_copy_expr (align) : NULL;
> -       vars->u2.allocator = ((allocator) ? gfc_copy_expr (allocator) : NULL);
> +       vars->u2.allocator = allocator;
>       }
> -      gfc_free_expr (allocator);
>        gfc_free_expr (align);
>      }
>    return MATCH_YES;
> @@ -7191,7 +7188,7 @@ resolve_omp_udr_clause (gfc_omp_namelist *n, gfc_namespace *ns,
>  /* Assume that a constant expression in the range 1 (omp_default_mem_alloc)
>     to 8 (omp_thread_mem_alloc) range is fine.  The original symbol name is
>     already lost during matching via gfc_match_expr.  */
> -bool
> +static bool
>  is_predefined_allocator (gfc_expr *expr)
>  {
>    return (gfc_resolve_expr (expr)
> @@ -7209,10 +7206,20 @@ is_predefined_allocator (gfc_expr *expr)
>  void
>  gfc_resolve_omp_allocate (gfc_namespace *ns, gfc_omp_namelist *list)
>  {
> -  for (gfc_omp_namelist *n = list; n; n = n->next)
> -    n->sym->mark = 0;
>    for (gfc_omp_namelist *n = list; n; n = n->next)
>      {
> +      if (n->sym->attr.result || n->sym->result == n->sym)
> +     {
> +       gfc_error ("Unexpected function-result variable %qs at %L in "
> +                  "declarative !$OMP ALLOCATE", n->sym->name, &n->where);
> +       continue;
> +     }
> +      if (ns->omp_allocate->sym->attr.proc_pointer)
> +     {
> +       gfc_error ("Procedure pointer %qs not supported with !$OMP "
> +                  "ALLOCATE at %L", n->sym->name, &n->where);
> +       continue;
> +     }
>        if (n->sym->attr.flavor != FL_VARIABLE)
>       {
>         gfc_error ("Argument %qs at %L to declarative !$OMP ALLOCATE "
> @@ -7220,8 +7227,7 @@ gfc_resolve_omp_allocate (gfc_namespace *ns, gfc_omp_namelist *list)
>                    &n->where);
>         continue;
>       }
> -      if (ns != n->sym->ns || n->sym->attr.use_assoc
> -       || n->sym->attr.host_assoc || n->sym->attr.imported)
> +      if (ns != n->sym->ns || n->sym->attr.use_assoc || n->sym->attr.imported)
>       {
>         gfc_error ("Argument %qs at %L to declarative !$OMP ALLOCATE shall be"
>                    " in the same scope as the variable declaration",
> @@ -7234,7 +7240,13 @@ gfc_resolve_omp_allocate (gfc_namespace *ns, gfc_omp_namelist *list)
>                    "declarative !$OMP ALLOCATE", n->sym->name, &n->where);
>         continue;
>       }
> -      if (n->sym->mark)
> +      if (n->sym->attr.codimension)
> +     {
> +       gfc_error ("Unexpected coarray argument %qs as argument at %L to "
> +                  "declarative !$OMP ALLOCATE", n->sym->name, &n->where);
> +       continue;
> +     }
> +      if (n->sym->attr.omp_allocate)
>       {
>         if (n->sym->attr.in_common)
>           {
> @@ -7249,7 +7261,28 @@ gfc_resolve_omp_allocate (gfc_namespace *ns, gfc_omp_namelist *list)
>                      n->sym->name, &n->where);
>         continue;
>       }
> -      n->sym->mark = 1;
> +      /* For 'equivalence(a,b)', a 'union_type {<type> a,b} equiv.0' is created
> +      with a value expression for 'a' as 'equiv.0.a' (likewise for b); while
> +      this can be handled, EQUIVALENCE is marked as obsolescent since Fortran
> +      2018 and also not widely used.  However, it could be supported,
> +      if needed. */
> +      if (n->sym->attr.in_equivalence)
> +     {
> +       gfc_error ("Sorry, EQUIVALENCE object %qs not supported with !$OMP "
> +                  "ALLOCATE at %L", n->sym->name, &n->where);
> +       continue;
> +     }
> +      /* Similar for Cray pointer/pointee - they could be implemented but as
> +      common vendor extension but nowadays rarely used and requiring
> +      -fcray-pointer, there is no need to support them.  */
> +      if (n->sym->attr.cray_pointer || n->sym->attr.cray_pointee)
> +     {
> +       gfc_error ("Sorry, Cray pointers and pointees such as %qs are not "
> +                  "supported with !$OMP ALLOCATE at %L",
> +                  n->sym->name, &n->where);
> +       continue;
> +     }
> +      n->sym->attr.omp_allocate = 1;
>        if ((n->sym->ts.type == BT_CLASS && n->sym->attr.class_ok
>          && CLASS_DATA (n->sym)->attr.allocatable)
>         || (n->sym->ts.type != BT_CLASS && n->sym->attr.allocatable))
> @@ -7307,8 +7340,6 @@ gfc_resolve_omp_allocate (gfc_namespace *ns, gfc_omp_namelist *list)
>                  "%<omp_allocator_handle_kind%> kind at %L",
>                  &n->u2.allocator->where);
>      }
> -  gfc_error ("Sorry, declarative !$OMP ALLOCATE at %L not yet supported",
> -          &list->where);
>  }
>
>  /* Resolve ASSUME's and ASSUMES' assumption clauses.  Note that absent/contains
> @@ -7897,6 +7928,9 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
>           {
>             if (n->sym == NULL)
>               continue;
> +           if (n->sym->attr.codimension)
> +             gfc_error ("Unexpected coarray %qs in %<allocate%> at %L",
> +                        n->sym->name, &n->where);
>             for (a = code->block->next->ext.alloc.list; a; a = a->next)
>               if (a->expr->expr_type == EXPR_VARIABLE
>                   && a->expr->symtree->n.sym == n->sym)
> diff --git a/gcc/fortran/parse.cc b/gcc/fortran/parse.cc
> index 444baf42cbd..e103ebee557 100644
> --- a/gcc/fortran/parse.cc
> +++ b/gcc/fortran/parse.cc
> @@ -833,18 +833,18 @@ check_omp_allocate_stmt (locus *loc)
>                     &n->expr->where, gfc_ascii_statement (ST_OMP_ALLOCATE));
>         return false;
>       }
> +      /* Procedure pointers are not allocatable; hence, we do not regard them as
> +      pointers here - and reject them later in gfc_resolve_omp_allocate.  */
>        bool alloc_ptr;
>        if (n->sym->ts.type == BT_CLASS && n->sym->attr.class_ok)
>       alloc_ptr = (CLASS_DATA (n->sym)->attr.allocatable
>                    || CLASS_DATA (n->sym)->attr.class_pointer);
>        else
> -     alloc_ptr = (n->sym->attr.allocatable || n->sym->attr.pointer
> -                  || n->sym->attr.proc_pointer);
> +     alloc_ptr = n->sym->attr.allocatable || n->sym->attr.pointer;
>        if (alloc_ptr
>         || (n->sym->ns && n->sym->ns->proc_name
>             && (n->sym->ns->proc_name->attr.allocatable
> -               || n->sym->ns->proc_name->attr.pointer
> -               || n->sym->ns->proc_name->attr.proc_pointer)))
> +               || n->sym->ns->proc_name->attr.pointer)))
>       has_allocatable = true;
>        else
>       has_non_allocatable = true;
> diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
> index 8e94a9a469f..bbb81f40aa9 100644
> --- a/gcc/fortran/trans-array.cc
> +++ b/gcc/fortran/trans-array.cc
> @@ -82,6 +82,9 @@ along with GCC; see the file COPYING3.  If not see
>  #include "tree.h"
>  #include "gfortran.h"
>  #include "gimple-expr.h"
> +#include "tree-iterator.h"
> +#include "stringpool.h"  /* Required by "attribs.h".  */
> +#include "attribs.h" /* For lookup_attribute.  */
>  #include "trans.h"
>  #include "fold-const.h"
>  #include "constructor.h"
> @@ -6770,6 +6773,15 @@ gfc_trans_auto_array_allocation (tree decl, gfc_symbol * sym,
>        gimplifier to allocate storage, and all that good stuff.  */
>        tmp = fold_build1_loc (input_location, DECL_EXPR, TREE_TYPE (decl), decl);
>        gfc_add_expr_to_block (&init, tmp);
> +      if (sym->attr.omp_allocate)
> +     {
> +       /* Save location of size calculation to ensure GOMP_alloc is placed
> +          after it.  */
> +       tree omp_alloc = lookup_attribute ("omp allocate",
> +                                          DECL_ATTRIBUTES (decl));
> +       TREE_CHAIN (TREE_CHAIN (TREE_VALUE (omp_alloc)))
> +         = build_tree_list (NULL_TREE, tsi_stmt (tsi_last (init.head)));
> +     }
>      }
>
>    if (onstack)
> @@ -6798,8 +6810,22 @@ gfc_trans_auto_array_allocation (tree decl, gfc_symbol * sym,
>        gfc_add_init_cleanup (block, gfc_finish_block (&init), NULL_TREE);
>        return;
>      }
> +  if (sym->attr.omp_allocate)
> +    {
> +      /* The size is the number of elements in the array, so multiply by the
> +      size of an element to get the total size.  */
> +      tmp = TYPE_SIZE_UNIT (gfc_get_element_type (type));
> +      size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
> +                           size, fold_convert (gfc_array_index_type, tmp));
> +      size = gfc_evaluate_now (size, &init);
>
> -  if (flag_stack_arrays)
> +      tree omp_alloc = lookup_attribute ("omp allocate",
> +                                      DECL_ATTRIBUTES (decl));
> +      TREE_CHAIN (TREE_CHAIN (TREE_VALUE (omp_alloc)))
> +     = build_tree_list (size, NULL_TREE);
> +      space = NULL_TREE;
> +    }
> +  else if (flag_stack_arrays)
>      {
>        gcc_assert (TREE_CODE (TREE_TYPE (decl)) == POINTER_TYPE);
>        space = build_decl (gfc_get_location (&sym->declared_at),
> diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
> index b0fd25e92a3..a3f037bd07b 100644
> --- a/gcc/fortran/trans-decl.cc
> +++ b/gcc/fortran/trans-decl.cc
> @@ -48,6 +48,7 @@ along with GCC; see the file COPYING3.  If not see
>  #include "gimplify.h"
>  #include "omp-general.h"
>  #include "attr-fnspec.h"
> +#include "tree-iterator.h"
>
>  #define MAX_LABEL_VALUE 99999
>
> @@ -4652,6 +4653,36 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block)
>    init_intent_out_dt (proc_sym, block);
>    gfc_restore_backend_locus (&loc);
>
> +  /* For some reasons, internal procedures point to the parent's
> +     namespace.  Top-level procedure and variables inside BLOCK are fine.  */
> +  gfc_namespace *omp_ns = proc_sym->ns;
> +  if (proc_sym->ns->proc_name != proc_sym)
> +    for (omp_ns = proc_sym->ns->contained; omp_ns;
> +      omp_ns = omp_ns->sibling)
> +      if (omp_ns->proc_name == proc_sym)
> +     break;
> +
> +  /* Add 'omp allocate' attribute for gfc_trans_auto_array_allocation and
> +     unset attr.omp_allocate for 'omp allocate allocator(omp_default_mem_alloc),
> +     which has the normal codepath except for an invalid-use check in the ME.
> +     The main processing happens later in this function.  */
> +  for (struct gfc_omp_namelist *n = omp_ns ? omp_ns->omp_allocate : NULL;
> +       n; n = n->next)
> +    if (!TREE_STATIC (n->sym->backend_decl))
> +      {
> +     /* Add empty entries - described and to be filled below.  */
> +     tree tmp = build_tree_list (NULL_TREE, NULL_TREE);
> +     TREE_CHAIN (tmp) = build_tree_list (NULL_TREE, NULL_TREE);
> +     DECL_ATTRIBUTES (n->sym->backend_decl)
> +       = tree_cons (get_identifier ("omp allocate"), tmp,
> +                                    DECL_ATTRIBUTES (n->sym->backend_decl));
> +     if (n->u.align == NULL
> +         && n->u2.allocator != NULL
> +         && n->u2.allocator->expr_type == EXPR_CONSTANT
> +         && mpz_cmp_si (n->u2.allocator->value.integer, 1) == 0)
> +       n->sym->attr.omp_allocate = 0;
> +       }
> +
>    for (sym = proc_sym->tlink; sym != proc_sym; sym = sym->tlink)
>      {
>        bool alloc_comp_or_fini = (sym->ts.type == BT_DERIVED)
> @@ -5105,6 +5136,101 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block)
>       gcc_unreachable ();
>      }
>
> +  /* Handle 'omp allocate'. This has to be after the block above as
> +     gfc_add_init_cleanup (..., init, ...) puts 'init' of later calls
> +     before earlier calls.  The code is a bit more complex as gfortran does
> +     not really work with bind expressions / BIND_EXPR_VARS properly, i.e.
> +     gimplify_bind_expr needs some help for placing the GOMP_alloc. Thus,
> +     we pass on the location of the allocate-assignment expression and,
> +     if the size is not constant, the size variable if Fortran computes this
> +     differently. We also might add an expression location after which the
> +     code has to be added, e.g. for character len expressions, which affect
> +     the UNIT_SIZE.  */
> +  gfc_expr *last_allocator = NULL;
> +  if (omp_ns && omp_ns->omp_allocate)
> +    {
> +      if (!block->init || TREE_CODE (block->init) != STATEMENT_LIST)
> +     {
> +       tree tmp = build1_v (LABEL_EXPR, gfc_build_label_decl (NULL_TREE));
> +       append_to_statement_list (tmp, &block->init);
> +     }
> +      if (!block->cleanup || TREE_CODE (block->cleanup) != STATEMENT_LIST)
> +     {
> +       tree tmp = build1_v (LABEL_EXPR, gfc_build_label_decl (NULL_TREE));
> +       append_to_statement_list (tmp, &block->cleanup);
> +     }
> +    }
> +  tree init_stmtlist = block->init;
> +  tree cleanup_stmtlist = block->cleanup;
> +  se.expr = NULL_TREE;
> +  for (struct gfc_omp_namelist *n = omp_ns ? omp_ns->omp_allocate : NULL;
> +       n; n = n->next)
> +    if (!TREE_STATIC (n->sym->backend_decl))
> +      {
> +     tree align = (n->u.align ? gfc_conv_constant_to_tree (n->u.align)
> +                              : NULL_TREE);
> +     if (last_allocator != n->u2.allocator)
> +       {
> +         location_t loc = input_location;
> +         gfc_init_se (&se, NULL);
> +         if (n->u2.allocator)
> +           {
> +             input_location = gfc_get_location (&n->u2.allocator->where);
> +             gfc_conv_expr (&se, n->u2.allocator);
> +           }
> +         /* We need to evalulate non-constants - also to find the location
> +            after which the GOMP_alloc has to be added to - also as BLOCK
> +            does not yield a new BIND_EXPR_BODY.  */
> +         if (n->u2.allocator
> +             && (!(CONSTANT_CLASS_P (se.expr) && DECL_P (se.expr))
> +                 || se.pre.head || se.post.head))
> +           {
> +             stmtblock_t tmpblock;
> +             gfc_init_block (&tmpblock);
> +             se.expr = gfc_evaluate_now (se.expr, &tmpblock);
> +             /* First post then pre because the new code is inserted
> +                at the top. */
> +             gfc_add_init_cleanup (block, gfc_finish_block (&se.post), NULL);
> +             gfc_add_init_cleanup (block, gfc_finish_block (&tmpblock),
> +                                   NULL);
> +             gfc_add_init_cleanup (block, gfc_finish_block (&se.pre), NULL);
> +           }
> +         last_allocator = n->u2.allocator;
> +         input_location = loc;
> +       }
> +
> +     /* 'omp allocate( {purpose: allocator, value: align},
> +                       {purpose: init-stmtlist, value: cleanup-stmtlist},
> +                       {purpose: size-var, value: last-size-expr}}
> +         where init-stmt/cleanup-stmt is the STATEMENT list to find the
> +         try-final block; last-size-expr is to find the location after
> +         which to add the code and 'size-var' is for the proper size, cf.
> +         gfc_trans_auto_array_allocation - either or both of the latter
> +         can be NULL.  */
> +     tree tmp = lookup_attribute ("omp allocate",
> +                                  DECL_ATTRIBUTES (n->sym->backend_decl));
> +     tmp = TREE_VALUE (tmp);
> +     TREE_PURPOSE (tmp) = se.expr;
> +     TREE_VALUE (tmp) = align;
> +     TREE_PURPOSE (TREE_CHAIN (tmp)) = init_stmtlist;
> +     TREE_VALUE (TREE_CHAIN (tmp)) = cleanup_stmtlist;
> +      }
> +    else if (n->sym->attr.in_common)
> +      {
> +     gfc_error ("Sorry, !$OMP allocate for COMMON block variable %qs at %L "
> +                "not supported", n->sym->common_block->name,
> +                &n->sym->common_block->where);
> +     break;
> +      }
> +    else
> +      {
> +     gfc_error ("Sorry, !$OMP allocate for variable %qs at %L with SAVE "
> +                "attribute not yet implemented", n->sym->name,
> +                &n->sym->declared_at);
> +     /* FIXME: Remember to handle last_allocator.  */
> +     break;
> +      }
> +
>    gfc_init_block (&tmpblock);
>
>    for (f = gfc_sym_get_dummy_args (proc_sym); f; f = f->next)
> diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc
> index 2f116fd6738..7930f2fd5d1 100644
> --- a/gcc/fortran/trans-openmp.cc
> +++ b/gcc/fortran/trans-openmp.cc
> @@ -2739,34 +2739,48 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
>             }
>         break;
>       case OMP_LIST_ALLOCATE:
> -       for (; n != NULL; n = n->next)
> -         if (n->sym->attr.referenced)
> -           {
> -             tree t = gfc_trans_omp_variable (n->sym, false);
> -             if (t != error_mark_node)
> -               {
> -                 tree node = build_omp_clause (input_location,
> -                                               OMP_CLAUSE_ALLOCATE);
> -                 OMP_CLAUSE_DECL (node) = t;
> -                 if (n->u2.allocator)
> -                   {
> -                     tree allocator_;
> -                     gfc_init_se (&se, NULL);
> -                     gfc_conv_expr (&se, n->u2.allocator);
> -                     allocator_ = gfc_evaluate_now (se.expr, block);
> -                     OMP_CLAUSE_ALLOCATE_ALLOCATOR (node) = allocator_;
> -                   }
> -                 if (n->u.align)
> -                   {
> -                     tree align_;
> -                     gfc_init_se (&se, NULL);
> -                     gfc_conv_expr (&se, n->u.align);
> -                     align_ = gfc_evaluate_now (se.expr, block);
> -                     OMP_CLAUSE_ALLOCATE_ALIGN (node) = align_;
> -                   }
> -                 omp_clauses = gfc_trans_add_clause (node, omp_clauses);
> -               }
> -           }
> +       {
> +         tree allocator_ = NULL_TREE;
> +         gfc_expr *alloc_expr = NULL;
> +         for (; n != NULL; n = n->next)
> +           if (n->sym->attr.referenced)
> +             {
> +               tree t = gfc_trans_omp_variable (n->sym, false);
> +               if (t != error_mark_node)
> +                 {
> +                   tree node = build_omp_clause (input_location,
> +                                                 OMP_CLAUSE_ALLOCATE);
> +                   OMP_CLAUSE_DECL (node) = t;
> +                   if (n->u2.allocator)
> +                     {
> +                       if (alloc_expr != n->u2.allocator)
> +                         {
> +                           gfc_init_se (&se, NULL);
> +                           gfc_conv_expr (&se, n->u2.allocator);
> +                           gfc_add_block_to_block (block, &se.pre);
> +                           allocator_ = gfc_evaluate_now (se.expr, block);
> +                           gfc_add_block_to_block (block, &se.post);
> +                         }
> +                       OMP_CLAUSE_ALLOCATE_ALLOCATOR (node) = allocator_;
> +                     }
> +                   alloc_expr = n->u2.allocator;
> +                   if (n->u.align)
> +                     {
> +                       tree align_;
> +                       gfc_init_se (&se, NULL);
> +                       gfc_conv_expr (&se, n->u.align);
> +                       gcc_assert (CONSTANT_CLASS_P (se.expr)
> +                                   && se.pre.head == NULL
> +                                   && se.post.head == NULL);
> +                       align_ = se.expr;
> +                       OMP_CLAUSE_ALLOCATE_ALIGN (node) = align_;
> +                     }
> +                   omp_clauses = gfc_trans_add_clause (node, omp_clauses);
> +                 }
> +             }
> +           else
> +             alloc_expr = n->u2.allocator;
> +         }
>         break;
>       case OMP_LIST_LINEAR:
>         {
> @@ -7184,11 +7198,14 @@ gfc_trans_omp_sections (gfc_code *code, gfc_omp_clauses *clauses)
>  static tree
>  gfc_trans_omp_single (gfc_code *code, gfc_omp_clauses *clauses)
>  {
> -  tree omp_clauses = gfc_trans_omp_clauses (NULL, clauses, code->loc);
> +  stmtblock_t block;
> +  gfc_start_block (&block);
> +  tree omp_clauses = gfc_trans_omp_clauses (&block, clauses, code->loc);
>    tree stmt = gfc_trans_omp_code (code->block->next, true);
>    stmt = build2_loc (gfc_get_location (&code->loc), OMP_SINGLE, void_type_node,
>                    stmt, omp_clauses);
> -  return stmt;
> +  gfc_add_expr_to_block (&block, stmt);
> +  return gfc_finish_block (&block);
>  }
>
>  static tree
> diff --git a/gcc/gimplify.cc b/gcc/gimplify.cc
> index 9f4722f7458..9c617c21381 100644
> --- a/gcc/gimplify.cc
> +++ b/gcc/gimplify.cc
> @@ -1405,18 +1405,45 @@ gimplify_bind_expr (tree *expr_p, gimple_seq *pre_p)
>                          || alloc == NULL_TREE
>                          || !integer_onep (alloc)))
>               {
> -               tree tmp = build_pointer_type (TREE_TYPE (t));
> -               tree v = create_tmp_var (tmp, get_name (t));
> -               DECL_IGNORED_P (v) = 0;
> -               tmp = remove_attribute ("omp allocate", DECL_ATTRIBUTES (t));
> -               DECL_ATTRIBUTES (v)
> -                 = tree_cons (get_identifier ("omp allocate var"),
> -                              build_tree_list (NULL_TREE, t), tmp);
> -               tmp = build_fold_indirect_ref (v);
> -               TREE_THIS_NOTRAP (tmp) = 1;
> -               SET_DECL_VALUE_EXPR (t, tmp);
> -               DECL_HAS_VALUE_EXPR_P (t) = 1;
> -               tree sz = TYPE_SIZE_UNIT (TREE_TYPE (t));
> +               /* Fortran might already use a pointer type internally;
> +                  use that pointer except for type(C_ptr) and type(C_funptr);
> +                  note that normal proc pointers are rejected.  */
> +               tree type = TREE_TYPE (t);
> +               tree tmp, v;
> +               if (lang_GNU_Fortran ()
> +                   && POINTER_TYPE_P (type)
> +                   && TREE_TYPE (type) != void_type_node
> +                   && TREE_CODE (TREE_TYPE (type)) != FUNCTION_TYPE)
> +                 {
> +                   type = TREE_TYPE (type);
> +                   v = t;
> +                 }
> +               else
> +                 {
> +                   tmp = build_pointer_type (type);
> +                   v = create_tmp_var (tmp, get_name (t));
> +                   DECL_IGNORED_P (v) = 0;
> +                   DECL_ATTRIBUTES (v)
> +                     = tree_cons (get_identifier ("omp allocate var"),
> +                                  build_tree_list (NULL_TREE, t),
> +                                  DECL_ATTRIBUTES (t));
> +                   tmp = build_fold_indirect_ref (v);
> +                   TREE_THIS_NOTRAP (tmp) = 1;
> +                   SET_DECL_VALUE_EXPR (t, tmp);
> +                   DECL_HAS_VALUE_EXPR_P (t) = 1;
> +                 }
> +               tree sz = TYPE_SIZE_UNIT (type);
> +               /* The size to use in Fortran might not match TYPE_SIZE_UNIT;
> +                  hence, for some decls, a size variable is saved in the
> +                  attributes; use it, if available.  */
> +               if (TREE_CHAIN (TREE_VALUE (attr))
> +                   && TREE_CHAIN (TREE_CHAIN (TREE_VALUE (attr)))
> +                   && TREE_PURPOSE (
> +                        TREE_CHAIN (TREE_CHAIN (TREE_VALUE (attr)))))
> +                 {
> +                   sz = TREE_CHAIN (TREE_CHAIN (TREE_VALUE (attr)));
> +                   sz = TREE_PURPOSE (sz);
> +                 }
>                 if (alloc == NULL_TREE)
>                   alloc = build_zero_cst (ptr_type_node);
>                 if (align == NULL_TREE)
> @@ -1425,28 +1452,93 @@ gimplify_bind_expr (tree *expr_p, gimple_seq *pre_p)
>                   align = build_int_cst (size_type_node,
>                                          MAX (tree_to_uhwi (align),
>                                               DECL_ALIGN_UNIT (t)));
> +               location_t loc = DECL_SOURCE_LOCATION (t);
>                 tmp = builtin_decl_explicit (BUILT_IN_GOMP_ALLOC);
> -               tmp = build_call_expr_loc (DECL_SOURCE_LOCATION (t), tmp,
> -                                          3, align, sz, alloc);
> -               tmp = fold_build2_loc (DECL_SOURCE_LOCATION (t), MODIFY_EXPR,
> -                                      TREE_TYPE (v), v,
> +               tmp = build_call_expr_loc (loc, tmp, 3, align, sz, alloc);
> +               tmp = fold_build2_loc (loc, MODIFY_EXPR, TREE_TYPE (v), v,
>                                        fold_convert (TREE_TYPE (v), tmp));
> -               gcc_assert (BIND_EXPR_BODY (bind_expr) != NULL_TREE
> -                           && (TREE_CODE (BIND_EXPR_BODY (bind_expr))
> -                               == STATEMENT_LIST));
> -               tree_stmt_iterator e = tsi_start (BIND_EXPR_BODY (bind_expr));
> -               while (!tsi_end_p (e))
> +               gcc_assert (BIND_EXPR_BODY (bind_expr) != NULL_TREE);
> +               /* Ensure that either TREE_CHAIN (TREE_VALUE (attr) is set
> +                  and GOMP_FREE added here or that DECL_HAS_VALUE_EXPR_P (t)
> +                  is set, using in a condition much further below.  */
> +               gcc_assert (DECL_HAS_VALUE_EXPR_P (t)
> +                           || TREE_CHAIN (TREE_VALUE (attr)));
> +               if (TREE_CHAIN (TREE_VALUE (attr)))
>                   {
> -                   if ((TREE_CODE (*e) == DECL_EXPR
> -                        && TREE_OPERAND (*e, 0) == t)
> -                       || (TREE_CODE (*e) == CLEANUP_POINT_EXPR
> -                           && TREE_CODE (TREE_OPERAND (*e, 0)) == DECL_EXPR
> -                           && TREE_OPERAND (TREE_OPERAND (*e, 0), 0) == t))
> -                   break;
> +                   /* Fortran is special as it does not have properly nest
> +                      declarations in blocks.  And as there is no
> +                      initializer, there is also no expression to look for.
> +                      Hence, the FE makes the statement list of the
> +                      try-finally block available. We can put the GOMP_alloc
> +                      at the top, unless an allocator or size expression
> +                      requires to put it afterward; note that the size is
> +                      always later in generated code; for strings, no
> +                      size expr but still an expr might be available.  */
> +                   tree sl = TREE_PURPOSE (TREE_CHAIN (TREE_VALUE (attr)));
> +                   tree_stmt_iterator e = tsi_start (sl);
> +                   tree needle = NULL_TREE;
> +                   if (TREE_CHAIN (TREE_CHAIN (TREE_VALUE (attr))))
> +                     {
> +                       needle = TREE_CHAIN (TREE_CHAIN (TREE_VALUE (attr)));
> +                       needle = (TREE_VALUE (needle) ? TREE_VALUE (needle)
> +                                                     : sz);
> +                     }
> +                   else if (TREE_CHAIN (TREE_CHAIN (TREE_VALUE (attr))))
> +                     needle = sz;
> +                   else if (DECL_P (alloc) && DECL_ARTIFICIAL (alloc))
> +                     needle = alloc;
> +
> +                   if (needle != NULL_TREE)
> +                     {
> +                       while (!tsi_end_p (e))
> +                         {
> +                           if (*e == needle
> +                               || (TREE_CODE (*e) == MODIFY_EXPR
> +                                   && TREE_OPERAND (*e, 0) == needle))
> +                             break;
> +                           ++e;
> +                         }
> +                       gcc_assert (!tsi_end_p (e));
> +                     }
> +                   tsi_link_after (&e, tmp, TSI_SAME_STMT);
> +
> +                   /* As the cleanup is in BIND_EXPR_BODY, GOMP_free is added
> +                      here; for C/C++ it will be added in the 'cleanup'
> +                      section after gimplification. But Fortran already has
> +                      a try-finally block.  */
> +                   sl = TREE_VALUE (TREE_CHAIN (TREE_VALUE (attr)));
> +                   e = tsi_last (sl);
> +                   tmp = builtin_decl_explicit (BUILT_IN_GOMP_FREE);
> +                   tmp = build_call_expr_loc (EXPR_LOCATION (*e), tmp, 2, v,
> +                                              build_zero_cst (ptr_type_node));
> +                   tsi_link_after (&e, tmp, TSI_SAME_STMT);
> +                   tmp = build_clobber (TREE_TYPE (v), CLOBBER_EOL);
> +                   tmp = fold_build2_loc (loc, MODIFY_EXPR, TREE_TYPE (v), v,
> +                                          fold_convert (TREE_TYPE (v), tmp));
>                     ++e;
> +                   tsi_link_after (&e, tmp, TSI_SAME_STMT);
>                   }
> -               gcc_assert (!tsi_end_p (e));
> -               tsi_link_before (&e, tmp, TSI_SAME_STMT);
> +               else
> +                 {
> +                   gcc_assert (TREE_CODE (BIND_EXPR_BODY (bind_expr))
> +                               == STATEMENT_LIST);
> +                   tree_stmt_iterator e;
> +                   e = tsi_start (BIND_EXPR_BODY (bind_expr));
> +                   while (!tsi_end_p (e))
> +                     {
> +                       if ((TREE_CODE (*e) == DECL_EXPR
> +                            && TREE_OPERAND (*e, 0) == t)
> +                           || (TREE_CODE (*e) == CLEANUP_POINT_EXPR
> +                               && (TREE_CODE (TREE_OPERAND (*e, 0))
> +                                   == DECL_EXPR)
> +                               && (TREE_OPERAND (TREE_OPERAND (*e, 0), 0)
> +                                   == t)))
> +                         break;
> +                       ++e;
> +                     }
> +                   gcc_assert (!tsi_end_p (e));
> +                   tsi_link_before (&e, tmp, TSI_SAME_STMT);
> +                }
>               }
>           }
>
> @@ -1539,16 +1631,26 @@ gimplify_bind_expr (tree *expr_p, gimple_seq *pre_p)
>         && !is_global_var (t)
>         && DECL_CONTEXT (t) == current_function_decl)
>       {
> +       tree attr;
>         if (flag_openmp
>             && DECL_HAS_VALUE_EXPR_P (t)
>             && TREE_USED (t)
> -           && lookup_attribute ("omp allocate", DECL_ATTRIBUTES (t)))
> +           && ((attr = lookup_attribute ("omp allocate",
> +                                         DECL_ATTRIBUTES (t))) != NULL_TREE)
> +           && TREE_CHAIN (TREE_VALUE (attr)) == NULL_TREE)
>           {
> +           /* For Fortran, TREE_CHAIN (TREE_VALUE (attr)) is set, which
> +              causes that the GOMP_free call is already added above.  */
> +           tree v = TREE_OPERAND (DECL_VALUE_EXPR (t), 0);
>             tree tmp = builtin_decl_explicit (BUILT_IN_GOMP_FREE);
> -           tmp = build_call_expr_loc (end_locus, tmp, 2,
> -                                      TREE_OPERAND (DECL_VALUE_EXPR (t), 0),
> +           tmp = build_call_expr_loc (end_locus, tmp, 2, v,
>                                        build_zero_cst (ptr_type_node));
>             gimplify_and_add (tmp, &cleanup);
> +           gimple *clobber_stmt;
> +           tmp = build_clobber (TREE_TYPE (v), CLOBBER_EOL);
> +           clobber_stmt = gimple_build_assign (v, tmp);
> +           gimple_set_location (clobber_stmt, end_locus);
> +           gimplify_seq_add_stmt (&cleanup, clobber_stmt);
>           }
>         if (!DECL_HARD_REGISTER (t)
>             && !TREE_THIS_VOLATILE (t)
> diff --git a/gcc/testsuite/c-c++-common/gomp/allocate-14.c b/gcc/testsuite/c-c++-common/gomp/allocate-14.c
> index b25da5497c5..894921a76d5 100644
> --- a/gcc/testsuite/c-c++-common/gomp/allocate-14.c
> +++ b/gcc/testsuite/c-c++-common/gomp/allocate-14.c
> @@ -17,7 +17,7 @@ h ()
>  {
>    #pragma omp target
>     #pragma omp parallel
> -    #pragma omp serial
> +    #pragma omp single
>       {
>         int var2[5];  /* { dg-error "'allocate' directive for 'var2' inside a target region must specify an 'allocator' clause" } */
>         #pragma omp allocate(var2)
> diff --git a/gcc/testsuite/c-c++-common/gomp/allocate-15.c b/gcc/testsuite/c-c++-common/gomp/allocate-15.c
> index 15105b9102e..52cb7686b7b 100644
> --- a/gcc/testsuite/c-c++-common/gomp/allocate-15.c
> +++ b/gcc/testsuite/c-c++-common/gomp/allocate-15.c
> @@ -19,7 +19,7 @@ h ()
>  {
>    #pragma omp target
>     #pragma omp parallel
> -    #pragma omp serial
> +    #pragma omp single
>       {
>         int var2[5];
>         #pragma omp allocate(var2)
> diff --git a/gcc/testsuite/c-c++-common/gomp/allocate-9.c b/gcc/testsuite/c-c++-common/gomp/allocate-9.c
> index 3c11080dd16..31382748be6 100644
> --- a/gcc/testsuite/c-c++-common/gomp/allocate-9.c
> +++ b/gcc/testsuite/c-c++-common/gomp/allocate-9.c
> @@ -20,7 +20,7 @@ typedef enum omp_allocator_handle_t
>  static int A[5] = {1,2,3,4,5};
>  int B, C, D;
>
> -/* If the following fails bacause of added predefined allocators, please update
> +/* If the following fails because of added predefined allocators, please update
>     - c/c-parser.c's c_parser_omp_allocate
>     - fortran/openmp.cc's is_predefined_allocator
>     - libgomp/env.c's parse_allocator
> diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-10.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-10.f90
> new file mode 100644
> index 00000000000..e50db53c1a8
> --- /dev/null
> +++ b/gcc/testsuite/gfortran.dg/gomp/allocate-10.f90
> @@ -0,0 +1,75 @@
> +! { dg-additional-options "-Wall -fdump-tree-gimple" }
> +
> +module m
> +use iso_c_binding
> +integer, parameter :: omp_allocator_handle_kind = c_intptr_t
> +        integer (kind=omp_allocator_handle_kind), &
> +                 parameter :: omp_null_allocator = 0
> +        integer (kind=omp_allocator_handle_kind), &
> +                 parameter :: omp_default_mem_alloc = 1
> +        integer (kind=omp_allocator_handle_kind), &
> +                 parameter :: omp_large_cap_mem_alloc = 2
> +        integer (kind=omp_allocator_handle_kind), &
> +                 parameter :: omp_const_mem_alloc = 3
> +        integer (kind=omp_allocator_handle_kind), &
> +                 parameter :: omp_high_bw_mem_alloc = 4
> +        integer (kind=omp_allocator_handle_kind), &
> +                 parameter :: omp_low_lat_mem_alloc = 5
> +        integer (kind=omp_allocator_handle_kind), &
> +                 parameter :: omp_cgroup_mem_alloc = 6
> +        integer (kind=omp_allocator_handle_kind), &
> +                 parameter :: omp_pteam_mem_alloc = 7
> +        integer (kind=omp_allocator_handle_kind), &
> +                 parameter :: omp_thread_mem_alloc = 8
> +end
> +
> +
> +! { dg-final { scan-tree-dump-times "__builtin_GOMP_alloc" 3 "gimple" } }
> +! { dg-final { scan-tree-dump-times "__builtin_GOMP_free" 3 "gimple" } }
> +
> +subroutine f
> +  use m
> +  implicit none
> +  integer :: n
> +  block
> +    integer :: A(n) ! { dg-warning "Unused variable 'a' declared" }
> +  end block
> +end
> +
> +subroutine f2
> +  use m
> +  implicit none
> +  integer :: n  ! { dg-note "'n' was declared here" }
> +  block
> +    integer :: A(n)  ! { dg-warning "'n' is used uninitialized" }
> +    !$omp allocate(A)
> +    ! by matching 'A' above, TREE_USE is set. Hence:
> +    ! { dg-final { scan-tree-dump-times "a = __builtin_GOMP_alloc \\(., D\.\[0-9\]+, 0B\\);" 1 "gimple" } }
> +    ! { dg-final { scan-tree-dump-times "__builtin_GOMP_free \\(a, 0B\\);" 1 "gimple" } }
> +  end block
> +end
> +
> +subroutine h1()
> +  use m
> +  implicit none
> +  integer(omp_allocator_handle_kind) my_handle  ! { dg-note "'my_handle' was declared here" }
> +  integer :: B1(3)
> +  !$omp allocate(B1) allocator(my_handle)  ! { dg-warning "31:'my_handle' is used uninitialized" }
> +  B1(1) = 5
> +  ! { dg-final { scan-tree-dump-times "b1.\[0-9\]+ = __builtin_GOMP_alloc \\(4, 12, D\.\[0-9\]+\\);" 1 "gimple" } }
> +  ! { dg-final { scan-tree-dump-times "__builtin_GOMP_free \\(b1.\[0-9\]+, 0B\\);" 1 "gimple" } }
> +end
> +
> +subroutine h2()
> +  use m
> +  implicit none
> +  integer(omp_allocator_handle_kind) my_handle  ! { dg-note "'my_handle' was declared here" }
> +  block
> +    integer :: B2(3)
> +    !$omp allocate(B2) allocator(my_handle)  ! { dg-warning "33:'my_handle' is used uninitialized" }
> +    ! Similar above; B2 is unused - but in gfortran, the match in 'allocate(B2)' already
> +    ! causes TREE_USED = 1
> +    ! { dg-final { scan-tree-dump-times "b2.\[0-9\]+ = __builtin_GOMP_alloc \\(4, 12, D\.\[0-9\]+\\);" 1 "gimple" } }
> +    ! { dg-final { scan-tree-dump-times "__builtin_GOMP_free \\(b2.\[0-9\]+, 0B\\);" 1 "gimple" } }
> +  end block
> +end
> diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-11.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-11.f90
> new file mode 100644
> index 00000000000..8a8d93930b0
> --- /dev/null
> +++ b/gcc/testsuite/gfortran.dg/gomp/allocate-11.f90
> @@ -0,0 +1,33 @@
> +module m
> +use iso_c_binding
> +integer, parameter :: omp_allocator_handle_kind = c_intptr_t
> +        integer (kind=omp_allocator_handle_kind), &
> +                 parameter :: omp_null_allocator = 0
> +        integer (kind=omp_allocator_handle_kind), &
> +                 parameter :: omp_default_mem_alloc = 1
> +        integer (kind=omp_allocator_handle_kind), &
> +                 parameter :: omp_large_cap_mem_alloc = 2
> +        integer (kind=omp_allocator_handle_kind), &
> +                 parameter :: omp_const_mem_alloc = 3
> +        integer (kind=omp_allocator_handle_kind), &
> +                 parameter :: omp_high_bw_mem_alloc = 4
> +        integer (kind=omp_allocator_handle_kind), &
> +                 parameter :: omp_low_lat_mem_alloc = 5
> +        integer (kind=omp_allocator_handle_kind), &
> +                 parameter :: omp_cgroup_mem_alloc = 6
> +        integer (kind=omp_allocator_handle_kind), &
> +                 parameter :: omp_pteam_mem_alloc = 7
> +        integer (kind=omp_allocator_handle_kind), &
> +                 parameter :: omp_thread_mem_alloc = 8
> +end
> +
> +subroutine f ()
> +  use m
> +  implicit none
> +  integer :: i
> +  !$omp parallel firstprivate(i) allocate(allocator(omp_low_latency_mem_alloc): i)
> +    ! { dg-error "Symbol 'omp_low_latency_mem_alloc' at .1. has no IMPLICIT type; did you mean 'omp_low_lat_mem_alloc'\\\?" "" { target *-*-* } .-1 }
> +    ! { dg-error "Expected integer expression of the 'omp_allocator_handle_kind' kind at .1." "" { target *-*-* } .-2 }
> +    i = 4
> +  !$omp end parallel
> +end
> diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-12.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-12.f90
> new file mode 100644
> index 00000000000..183c2941819
> --- /dev/null
> +++ b/gcc/testsuite/gfortran.dg/gomp/allocate-12.f90
> @@ -0,0 +1,24 @@
> +module m
> +  implicit none
> +contains
> +subroutine f ()
> +  !$omp declare target
> +  integer :: var  ! { dg-error "'allocate' directive for 'var' inside a target region must specify an 'allocator' clause" }
> +  !$omp allocate(var)
> +  var = 5
> +end
> +
> +subroutine h ()
> +  !$omp target
> +   !$omp parallel
> +    !$omp single
> +       block
> +       integer :: var2(5)  ! { dg-error "'allocate' directive for 'var2' inside a target region must specify an 'allocator' clause" }
> +         !$omp allocate(var2)
> +         var2(1) = 7
> +       end block
> +    !$omp end single
> +   !$omp end parallel
> +  !$omp end target
> +end
> +end module
> diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-13.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-13.f90
> new file mode 100644
> index 00000000000..bf8a5a2bee2
> --- /dev/null
> +++ b/gcc/testsuite/gfortran.dg/gomp/allocate-13.f90
> @@ -0,0 +1,25 @@
> +module m
> +  implicit none
> +  !$omp requires dynamic_allocators
> +contains
> +subroutine f ()
> +  !$omp declare target
> +  integer :: var
> +  !$omp allocate(var)
> +  var = 5
> +end
> +
> +subroutine h ()
> +  !$omp target
> +   !$omp parallel
> +    !$omp single
> +      block
> +       integer :: var2(5)
> +       !$omp allocate(var2)
> +       var2(1) = 7
> +      end block
> +    !$omp end single
> +   !$omp end parallel
> +  !$omp end target
> +end
> +end module
> diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-14.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-14.f90
> new file mode 100644
> index 00000000000..8ff9c252e49
> --- /dev/null
> +++ b/gcc/testsuite/gfortran.dg/gomp/allocate-14.f90
> @@ -0,0 +1,95 @@
> +! { dg-additional-options "-fcoarray=single -fcray-pointer" }
> +
> +module m
> +use iso_c_binding
> +integer, parameter :: omp_allocator_handle_kind = c_intptr_t
> +        integer (kind=omp_allocator_handle_kind), &
> +                 parameter :: omp_null_allocator = 0
> +        integer (kind=omp_allocator_handle_kind), &
> +                 parameter :: omp_default_mem_alloc = 1
> +        integer (kind=omp_allocator_handle_kind), &
> +                 parameter :: omp_large_cap_mem_alloc = 2
> +        integer (kind=omp_allocator_handle_kind), &
> +                 parameter :: omp_const_mem_alloc = 3
> +        integer (kind=omp_allocator_handle_kind), &
> +                 parameter :: omp_high_bw_mem_alloc = 4
> +        integer (kind=omp_allocator_handle_kind), &
> +                 parameter :: omp_low_lat_mem_alloc = 5
> +        integer (kind=omp_allocator_handle_kind), &
> +                 parameter :: omp_cgroup_mem_alloc = 6
> +        integer (kind=omp_allocator_handle_kind), &
> +                 parameter :: omp_pteam_mem_alloc = 7
> +        integer (kind=omp_allocator_handle_kind), &
> +                 parameter :: omp_thread_mem_alloc = 8
> +end
> +
> +subroutine coarrays(x)
> +  use m
> +  implicit none
> +
> +  integer :: x[*]
> +  integer, allocatable :: y[:], z(:)[:]
> +
> +  !$omp allocate(x)  ! { dg-error "Unexpected dummy argument 'x' as argument at .1. to declarative !.OMP ALLOCATE" }
> +
> +  !$omp allocators allocate(y) ! { dg-error "28:Unexpected coarray 'y' in 'allocate' at .1." }
> +    allocate(y[*])
> +
> +  !$omp allocate(z) ! { dg-error "17:Unexpected coarray 'z' in 'allocate' at .1." }
> +    allocate(z(5)[*])
> +  x = 5
> +end
> +
> +
> +integer function f() result(res)
> +  !$omp allocate(f)   ! { dg-error "Argument 'f' at .1. to declarative !.OMP ALLOCATE directive must be a variable" }
> +  !$omp allocate(res) ! { dg-error "Unexpected function-result variable 'res' at .1. in declarative !.OMP ALLOCATE" }
> +  res = 5
> +end
> +
> +integer function g() result(res)
> +  allocatable :: res
> +  !$omp allocators allocate(g)   ! { dg-error "Expected variable list at .1." }
> +
> +  !$omp allocators allocate (res)
> +  allocate(res, source=5)
> +  deallocate(res)
> +
> +  !$omp allocate (res)
> +  allocate(res, source=5)
> +end
> +
> +
> +subroutine cray_ptr()
> +   real pointee(10)
> +   pointer (ipt, pointee)
> +   !$omp allocate(pointee)  ! { dg-error "Sorry, Cray pointers and pointees such as 'pointee' are not supported with !.OMP ALLOCATE at .1." }
> +   !$omp allocate(ipt)      ! { dg-error "Sorry, Cray pointers and pointees such as 'ipt' are not supported with !.OMP ALLOCATE at .1." }
> +end
> +
> +subroutine equiv
> +  integer :: A
> +  real :: B(2)
> +  equivalence(A,B)
> +  !$omp allocate (A)  ! { dg-error "Sorry, EQUIVALENCE object 'a' not supported with !.OMP ALLOCATE at .1." }
> +  !$omp allocate (B)  ! { dg-error "Sorry, EQUIVALENCE object 'b' not supported with !.OMP ALLOCATE at .1." }
> +end
> +
> +subroutine common
> +  use m
> +  integer :: a,b,c(5)
> +  common /my/ a,b,c
> +  !$omp allocate(b) allocator(omp_cgroup_mem_alloc)  ! { dg-error "'b' at .1. is part of the common block '/my/' and may only be specificed implicitly via the named common block" }
> +end
> +
> +subroutine c_and_func_ptrs
> +  use iso_c_binding
> +  implicit none
> +  procedure(), pointer :: p
> +  type(c_ptr) :: cptr
> +  type(c_ptr) :: cfunptr
> +
> +  !$omp allocate(cptr)  ! OK
> +  !$omp allocate(cfunptr) ! OK? A normal derived-type var?
> +  !$omp allocate(p)  ! { dg-error "Argument 'p' at .1. to declarative !.OMP ALLOCATE directive must be a variable" }
> +end
> diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-15.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-15.f90
> new file mode 100644
> index 00000000000..a0690a56394
> --- /dev/null
> +++ b/gcc/testsuite/gfortran.dg/gomp/allocate-15.f90
> @@ -0,0 +1,38 @@
> +module m
> +use iso_c_binding
> +integer, parameter :: omp_allocator_handle_kind = c_intptr_t
> +        integer (kind=omp_allocator_handle_kind), &
> +                 parameter :: omp_null_allocator = 0
> +        integer (kind=omp_allocator_handle_kind), &
> +                 parameter :: omp_default_mem_alloc = 1
> +        integer (kind=omp_allocator_handle_kind), &
> +                 parameter :: omp_large_cap_mem_alloc = 2
> +        integer (kind=omp_allocator_handle_kind), &
> +                 parameter :: omp_const_mem_alloc = 3
> +        integer (kind=omp_allocator_handle_kind), &
> +                 parameter :: omp_high_bw_mem_alloc = 4
> +        integer (kind=omp_allocator_handle_kind), &
> +                 parameter :: omp_low_lat_mem_alloc = 5
> +        integer (kind=omp_allocator_handle_kind), &
> +                 parameter :: omp_cgroup_mem_alloc = 6
> +        integer (kind=omp_allocator_handle_kind), &
> +                 parameter :: omp_pteam_mem_alloc = 7
> +        integer (kind=omp_allocator_handle_kind), &
> +                 parameter :: omp_thread_mem_alloc = 8
> +end
> +
> +subroutine common
> +  use m
> +  integer :: a,b,c(5)
> +  common /my/ a,b,c  ! { dg-error "Sorry, !.OMP allocate for COMMON block variable 'my' at .1. not supported" }
> +  !$omp allocate(/my/) allocator(omp_cgroup_mem_alloc)
> +end
> +
> +integer function allocators() result(res)
> +  use m
> +  integer, save :: a(5) = [1,2,3,4,5]  ! { dg-error "Sorry, !.OMP allocate for variable 'a' at .1. with SAVE attribute not yet implemented" }
> +  !$omp allocate(a) allocator(omp_high_bw_mem_alloc)
> +  res = a(4)
> +end
> +
> +
> diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-4.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-4.f90
> index a2dcf105ee1..b93a37c780c 100644
> --- a/gcc/testsuite/gfortran.dg/gomp/allocate-4.f90
> +++ b/gcc/testsuite/gfortran.dg/gomp/allocate-4.f90
> @@ -33,13 +33,13 @@ integer(kind=omp_allocator_handle_kind), intent(in) :: my_alloc
>
>  !stack variables:
>  integer :: a,b,c(n),d(5),e(2)
> -!$omp allocate(a)   ! { dg-error "Sorry, declarative !.OMP ALLOCATE at .1. not yet supported" }
> +!$omp allocate(a)
>  !$omp allocate ( b , c ) align ( 32) allocator (my_alloc)
>  !$omp allocate (d) align( 128 )
>  !$omp allocate(   e ) allocator( omp_high_bw_mem_alloc )
>
>  !saved vars
> -integer, save :: k,l,m(5),r(2)
> +integer, save :: k,l,m(5),r(2)  ! { dg-error "Sorry, !.OMP allocate for variable 'k' at .1. with SAVE attribute not yet implemented" }
>  !$omp allocate(k)  align(16) , allocator (omp_large_cap_mem_alloc)
>  !$omp allocate ( l ) allocator (omp_large_cap_mem_alloc) , align ( 32)
>  !$omp allocate (m) align( 128 ),allocator( omp_high_bw_mem_alloc )
> diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-7.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-7.f90
> index b856204d48a..ab85e327795 100644
> --- a/gcc/testsuite/gfortran.dg/gomp/allocate-7.f90
> +++ b/gcc/testsuite/gfortran.dg/gomp/allocate-7.f90
> @@ -47,7 +47,6 @@ integer, pointer :: ptr
>  integer, parameter :: prm=5
>
>  !$omp allocate(prm) align(64) ! { dg-error "Argument 'prm' at .1. to declarative !.OMP ALLOCATE directive must be a variable" }
> -! { dg-error "Sorry, declarative !.OMP ALLOCATE at .1. not yet supported" "" { target *-*-* } .-1 }
>
>  !$omp allocate(used) allocator(omp_pteam_mem_alloc)  ! { dg-error "Argument 'used' at .1. to declarative !.OMP ALLOCATE shall be in the same scope as the variable declaration" }
>  !$omp allocate(n) allocator(omp_pteam_mem_alloc) ! { dg-error "Unexpected dummy argument 'n' as argument at .1. to declarative !.OMP ALLOCATE" }
> @@ -59,7 +58,6 @@ contains
>
>    subroutine inner
>      !$omp allocate(a) allocator(omp_pteam_mem_alloc)  ! { dg-error "Argument 'a' at .1. to declarative !.OMP ALLOCATE shall be in the same scope as the variable declaration" }
> -! { dg-error "Sorry, declarative !.OMP ALLOCATE at .1. not yet supported" "" { target *-*-* } .-1 }
>    end
>  end
>
> @@ -74,7 +72,6 @@ common /com4/ y,z
>  allocatable :: q
>  pointer :: b
>  !$omp allocate (c, d) allocator (omp_pteam_mem_alloc)
> -! { dg-error "Sorry, declarative !.OMP ALLOCATE at .1. not yet supported" "" { target *-*-* } .-1 }
>  !$omp allocate (/com4/) allocator (omp_pteam_mem_alloc)
>  !$omp allocate (c) allocator (omp_pteam_mem_alloc) ! { dg-error "Duplicated variable 'c' in !.OMP ALLOCATE" }
>  !$omp allocate (/com4/) allocator (omp_pteam_mem_alloc) ! { dg-error "Duplicated common block '/com4/' in !.OMP ALLOCATE" }
> @@ -86,7 +83,6 @@ end
>  subroutine four(n)
>    integer :: qq, rr, ss, tt, uu, vv,n
>  !$omp allocate (qq) align(3+n) ! { dg-error "ALIGN requires a scalar positive constant integer alignment expression at .1. that is a power of two" }
> -! { dg-error "Sorry, declarative !.OMP ALLOCATE at .1. not yet supported" "" { target *-*-* } .-1 }
>  !$omp allocate (rr) align([4]) ! { dg-error "ALIGN requires a scalar positive constant integer alignment expression at .1. that is a power of two" }
>  !$omp allocate (ss) align([4]) ! { dg-error "ALIGN requires a scalar positive constant integer alignment expression at .1. that is a power of two" }
>  !$omp allocate (tt) align(32.0) ! { dg-error "ALIGN requires a scalar positive constant integer alignment expression at .1. that is a power of two" }
> @@ -99,7 +95,6 @@ subroutine five(n,my_alloc)
>    integer :: qq, rr, ss, tt, uu, vv,n
>    integer(omp_allocator_handle_kind) :: my_alloc
>  !$omp allocate (qq) allocator(3.0)  ! { dg-error "Expected integer expression of the 'omp_allocator_handle_kind' kind" }
> -! { dg-error "Sorry, declarative !.OMP ALLOCATE at .1. not yet supported" "" { target *-*-* } .-1 }
>  !$omp allocate (rr) allocator(3_2)  ! { dg-error "Expected integer expression of the 'omp_allocator_handle_kind' kind" }
>  !$omp allocate (ss) allocator([omp_pteam_mem_alloc])  ! { dg-error "Expected integer expression of the 'omp_allocator_handle_kind' kind" }
>  !$omp allocate (tt) allocator(my_alloc)  ! OK
> @@ -113,7 +108,6 @@ subroutine five_SaveAll(n,my_alloc)
>    integer :: qq, rr, ss, tt, uu, vv,n
>    integer(omp_allocator_handle_kind) :: my_alloc
>  !$omp allocate (qq) allocator(3.0)  ! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item 'qq' at .2. has the SAVE attribute" }
> -! { dg-error "Sorry, declarative !.OMP ALLOCATE at .1. not yet supported" "" { target *-*-* } .-1 }
>  !$omp allocate (rr) allocator(3_2)  ! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item 'rr' at .2. has the SAVE attribute" }
>  !$omp allocate (ss) allocator([omp_pteam_mem_alloc])  ! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item 'ss' at .2. has the SAVE attribute" }
>  !$omp allocate (tt) allocator(my_alloc)  ! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item 'tt' at .2. has the SAVE attribute" }
> @@ -127,7 +121,6 @@ subroutine five_Save(n,my_alloc)
>    integer, save :: qq, rr, ss, tt, uu, vv
>    integer(omp_allocator_handle_kind) :: my_alloc
>  !$omp allocate (qq) allocator(3.0)  ! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item 'qq' at .2. has the SAVE attribute" }
> -! { dg-error "Sorry, declarative !.OMP ALLOCATE at .1. not yet supported" "" { target *-*-* } .-1 }
>  !$omp allocate (rr) allocator(3_2)  ! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item 'rr' at .2. has the SAVE attribute" }
>  !$omp allocate (ss) allocator([omp_pteam_mem_alloc])  ! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item 'ss' at .2. has the SAVE attribute" }
>  !$omp allocate (tt) allocator(my_alloc)  ! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item 'tt' at .2. has the SAVE attribute" }
> @@ -139,7 +132,6 @@ module five_Module
>    integer, save :: qq, rr, ss, tt, uu, vv,n
>    integer(omp_allocator_handle_kind) :: my_alloc
>  !$omp allocate (qq) allocator(3.0)  ! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item 'qq' at .2. has the SAVE attribute" }
> -! { dg-error "Sorry, declarative !.OMP ALLOCATE at .1. not yet supported" "" { target *-*-* } .-1 }
>  !$omp allocate (rr) allocator(3_2)  ! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item 'rr' at .2. has the SAVE attribute" }
>  !$omp allocate (ss) allocator([omp_pteam_mem_alloc])  ! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item 'ss' at .2. has the SAVE attribute" }
>  !$omp allocate (tt) allocator(my_alloc)  ! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item 'tt' at .2. has the SAVE attribute" }
> @@ -151,7 +143,6 @@ program five_program
>    integer, save :: qq, rr, ss, tt, uu, vv,n
>    integer(omp_allocator_handle_kind) :: my_alloc
>  !$omp allocate (qq) allocator(3.0)  ! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item 'qq' at .2. has the SAVE attribute" }
> -! { dg-error "Sorry, declarative !.OMP ALLOCATE at .1. not yet supported" "" { target *-*-* } .-1 }
>  !$omp allocate (rr) allocator(3_2)  ! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item 'rr' at .2. has the SAVE attribute" }
>  !$omp allocate (ss) allocator([omp_pteam_mem_alloc])  ! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item 'ss' at .2. has the SAVE attribute" }
>  !$omp allocate (tt) allocator(my_alloc)  ! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item 'tt' at .2. has the SAVE attribute" }
> @@ -170,7 +161,6 @@ subroutine six(n,my_alloc)
>    integer(omp_allocator_handle_kind) :: my_alloc
>
>  !$omp allocate (/com6qq/) allocator(3.0)  ! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item '/com6qq/' at .2. has the SAVE attribute" }
> -! { dg-error "Sorry, declarative !.OMP ALLOCATE at .1. not yet supported" "" { target *-*-* } .-1 }
>  !$omp allocate (/com6rr/) allocator(3_2)  ! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item '/com6rr/' at .2. has the SAVE attribute" }
>  !$omp allocate (/com6ss/) allocator([omp_pteam_mem_alloc])  ! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item '/com6ss/' at .2. has the SAVE attribute" }
>  !$omp allocate (/com6tt/) allocator(my_alloc)  ! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item '/com6tt/' at .2. has the SAVE attribute" }
> diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-8.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-8.f90
> new file mode 100644
> index 00000000000..bb4d07d0c73
> --- /dev/null
> +++ b/gcc/testsuite/gfortran.dg/gomp/allocate-8.f90
> @@ -0,0 +1,29 @@
> +! { dg-additional-options "-fdump-tree-original" }
> +
> +module m
> +  use iso_c_binding
> +  !use omp_lib, only: omp_allocator_handle_kind
> +  implicit none
> +  integer, parameter :: omp_allocator_handle_kind = c_intptr_t
> +  integer :: a = 0, b = 42, c = 0
> +
> +contains
> +  integer(omp_allocator_handle_kind) function get_alloc()
> +    allocatable :: get_alloc
> +    get_alloc = 2_omp_allocator_handle_kind
> +  end
> +  subroutine foo ()
> +  !$omp scope private (a) firstprivate (b) reduction (+: c) allocate ( get_alloc() : a , b , c)
> +    if (b /= 42) &
> +      error stop
> +    a = 36
> +    b = 15
> +    c = c + 1
> +  !$omp end scope
> +  end
> +end
> +
> +! { dg-final { scan-tree-dump "omp scope private\\(a\\) firstprivate\\(b\\) reduction\\(\\+:c\\) allocate\\(allocator\\(D\\.\[0-9\]+\\):a\\) allocate\\(allocator\\(D\\.\[0-9\]+\\):b\\) allocate\\(allocator\\(D\\.\[0-9\]+\\):c\\)" "original" } }
> +
> +! { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ = get_alloc \\(\\);\[\n\r\]+ *D\\.\[0-9\]+ = \\*D\\.\[0-9\]+;\[\n\r\]+ *__builtin_free \\(\\(void \\*\\) D\\.\[0-9\]+\\);" 1 "original" } }
> +
> diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-9.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-9.f90
> new file mode 100644
> index 00000000000..4d9553686c4
> --- /dev/null
> +++ b/gcc/testsuite/gfortran.dg/gomp/allocate-9.f90
> @@ -0,0 +1,112 @@
> +module m
> +use iso_c_binding
> +integer, parameter :: omp_allocator_handle_kind = c_intptr_t
> +        integer (kind=omp_allocator_handle_kind), &
> +                 parameter :: omp_null_allocator = 0
> +        integer (kind=omp_allocator_handle_kind), &
> +                 parameter :: omp_default_mem_alloc = 1
> +        integer (kind=omp_allocator_handle_kind), &
> +                 parameter :: omp_large_cap_mem_alloc = 2
> +        integer (kind=omp_allocator_handle_kind), &
> +                 parameter :: omp_const_mem_alloc = 3
> +        integer (kind=omp_allocator_handle_kind), &
> +                 parameter :: omp_high_bw_mem_alloc = 4
> +        integer (kind=omp_allocator_handle_kind), &
> +                 parameter :: omp_low_lat_mem_alloc = 5
> +        integer (kind=omp_allocator_handle_kind), &
> +                 parameter :: omp_cgroup_mem_alloc = 6
> +        integer (kind=omp_allocator_handle_kind), &
> +                 parameter :: omp_pteam_mem_alloc = 7
> +        integer (kind=omp_allocator_handle_kind), &
> +                 parameter :: omp_thread_mem_alloc = 8
> +end
> +
> +
> +module m2
> +  use m
> +  implicit none
> +  integer :: A(5) = [1,2,3,4,5], A2, A3, A4, A5
> +  integer :: B, C, D
> +
> +! If the following fails because of added predefined allocators, please update
> +! - c/c-parser.c's c_parser_omp_allocate
> +! - fortran/openmp.cc's is_predefined_allocator
> +! - libgomp/env.c's parse_allocator
> +! - libgomp/libgomp.texi (document the new values - multiple locations)
> +! + ensure that the memory-spaces are also up to date.
> +
> +!$omp allocate(A) align(32) allocator(9_omp_allocator_handle_kind)  ! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item 'a' at .2. has the SAVE attribute" }
> +
> +! typo in allocator name:
> +!$omp allocate(A2) allocator(omp_low_latency_mem_alloc)  ! { dg-error "Symbol 'omp_low_latency_mem_alloc' at .1. has no IMPLICIT type; did you mean 'omp_low_lat_mem_alloc'\\?" }
> +! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item 'a2' at .2. has the SAVE attribute" "" { target *-*-* } .-1 }
> +
> +! align be const multiple of 2
> +!$omp allocate(A3) align(31) allocator(omp_default_mem_alloc) ! { dg-error "ALIGN requires a scalar positive constant integer alignment expression at .1. that is a power of two" }
> +
> +! allocator missing (required as A is static)
> +!$omp allocate(A4) align(32) ! { dg-error "An ALLOCATOR clause is required as the list item 'a4' at .1. has the SAVE attribute" }
> +
> +! "expression in the clause must be a constant expression that evaluates to one of the
> +! predefined memory allocator values -> omp_low_lat_mem_alloc"
> +!$omp allocate(B) allocator(omp_high_bw_mem_alloc+1_omp_allocator_handle_kind) align(32) ! OK: omp_low_lat_mem_alloc
> +
> +!$omp allocate(C) allocator(2_omp_allocator_handle_kind) ! OK: omp_large_cap_mem_alloc
> +
> +!$omp allocate(A5) align(32) allocator(omp_null_allocator) ! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item 'a5' at .2. has the SAVE attribute" }
> +
> +!$omp allocate(C) align(32) allocator(omp_large_cap_mem_alloc)  ! { dg-error "Duplicated variable 'c' in !.OMP ALLOCATE at .1." }
> +
> +contains
> +
> +integer function f()
> +  !$omp allocate(D) align(32) allocator(omp_large_cap_mem_alloc) ! { dg-error "Argument 'd' at .1. to declarative !.OMP ALLOCATE shall be in the same scope as the variable declaration" }
> +  f = A(1)
> +end
> +
> +integer function g()
> +  integer :: a2, b2
> +  !$omp allocate(a2)
> +  !$omp allocate(a2)  ! { dg-error "Duplicated variable 'a2' in !.OMP ALLOCATE at .1." }
> +  a2=1; b2=2
> +  block
> +    integer :: c2
> +    !$omp allocate(c2, b2) ! { dg-error "Argument 'b2' at .1. to declarative !.OMP ALLOCATE shall be in the same scope as the variable declaration" }
> +    c2 = 3
> +    g = c2+a2+b2
> +  end block
> +end
> +
> +integer function h(q)
> +  integer :: q
> +  !$omp allocate(q)  ! { dg-error "Unexpected dummy argument 'q' as argument at .1. to declarative !.OMP ALLOCATE" }
> +  h = q
> +end
> +
> +integer function k ()
> +  integer, save :: var3 = 8
> +  !$omp allocate(var3) allocator(-1_omp_allocator_handle_kind)  ! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item 'var3' at .2. has the SAVE attribute" }
> +  k = var3
> +end
> +end module
> +
> +
> +subroutine foo
> +  integer :: a, b
> +  integer :: c, d,h
> +  !$omp allocate(a,b)
> +  b = 1; d = 5
> +contains
> +subroutine internal
> +  integer :: e,f
> +  !$omp allocate(c,d)
> +  ! { dg-error "Argument 'c' at .1. to declarative !.OMP ALLOCATE shall be in the same scope as the variable declaration" "" { target *-*-* } .-1 }
> +  ! { dg-error "Argument 'd' at .1. to declarative !.OMP ALLOCATE shall be in the same scope as the variable declaration" "" { target *-*-* } .-2 }
> +  !$omp allocate(e)
> +  a = 1; c = 2; e = 4
> +  block
> +    !$omp allocate(f) ! { dg-error "Argument 'f' at .1. to declarative !.OMP ALLOCATE shall be in the same scope as the variable declaration" }
> +    !$omp allocate(h) ! { dg-error "Argument 'h' at .1. to declarative !.OMP ALLOCATE shall be in the same scope as the variable declaration" }
> +  end block
> +end
> +end
> diff --git a/libgomp/libgomp.texi b/libgomp/libgomp.texi
> index 6a7770084d2..c163411c529 100644
> --- a/libgomp/libgomp.texi
> +++ b/libgomp/libgomp.texi
> @@ -225,7 +225,7 @@ 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, only stack variables
> +@item @code{allocate} directive @tab P @tab Only C and Fortran, only stack 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
> @@ -297,7 +297,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 only stack variables)
> +      @tab Only C and Fortran (and only stack 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
> diff --git a/libgomp/testsuite/libgomp.fortran/allocate-5.f90 b/libgomp/testsuite/libgomp.fortran/allocate-5.f90
> new file mode 100644
> index 00000000000..de9cd5a302e
> --- /dev/null
> +++ b/libgomp/testsuite/libgomp.fortran/allocate-5.f90
> @@ -0,0 +1,87 @@
> +! { dg-additional-options "-fdump-tree-gimple" }
> +
> +! { dg-final { scan-tree-dump-times "__builtin_GOMP_alloc \\(" 5 "gimple" } }
> +! { dg-final { scan-tree-dump-times "__builtin_GOMP_free \\(" 5 "gimple" } }
> +
> +
> +module m
> +  use omp_lib
> +  use iso_c_binding
> +  implicit none (type, external)
> +  integer(c_intptr_t) :: intptr
> +contains
> +
> +integer function one ()
> +  integer :: sum, i
> +  !$omp allocate(sum)
> +  ! { dg-final { scan-tree-dump-times "sum\\.\[0-9\]+ = __builtin_GOMP_alloc \\(4, 4, 0B\\);" 1 "gimple" } }
> +  ! { dg-final { scan-tree-dump-times "__builtin_GOMP_free \\(sum\\.\[0-9\]+, 0B\\);" 1 "gimple" } }
> +
> +  ! NOTE: Initializer cannot be omp_init_allocator - as 'A' is
> +  ! in the same scope and the auto-omp_free comes later than
> +  ! any omp_destroy_allocator.
> +  integer(omp_allocator_handle_kind) :: my_allocator = omp_low_lat_mem_alloc
> +  integer :: n = 25
> +  sum = 0
> + block
> +  type(omp_alloctrait) :: traits(1) = [ omp_alloctrait(omp_atk_alignment, 64) ]
> +  integer :: A(n)
> +  !$omp allocate(A) align(128) allocator(my_allocator)
> +  ! { dg-final { scan-tree-dump-times "a = __builtin_GOMP_alloc \\(128, D\\.\[0-9\]+, D\\.\[0-9\]+\\);" 1 "gimple" } }
> +  ! { dg-final { scan-tree-dump-times "__builtin_GOMP_free \\(a, 0B\\);" 1 "gimple" } }
> +
> +  if (mod (transfer(loc(A), intptr), 128_c_intptr_t) /= 0) &
> +    stop 2
> +  do i = 1, n
> +    A(i) = i
> +  end do
> +
> +  my_allocator = omp_init_allocator(omp_low_lat_mem_space,1,traits)
> +  block
> +    integer B(n)
> +    integer C(5)
> +    !$omp allocate(B,C) allocator(my_allocator)
> +    ! { dg-final { scan-tree-dump-times "b = __builtin_GOMP_alloc \\(\[0-9\]+, D\\.\[0-9\]+, D\\.\[0-9\]+\\);" 1 "gimple" } }
> +    ! { dg-final { scan-tree-dump-times "c\\.\[0-9\]+ = __builtin_GOMP_alloc \\(\[0-9\]+, 20, D\\.\[0-9\]+\\);" 1 "gimple" } }
> +    ! { dg-final { scan-tree-dump-times "__builtin_GOMP_free \\(b, 0B\\);" 1 "gimple" } }
> +    ! { dg-final { scan-tree-dump-times "__builtin_GOMP_free \\(c\\.\[0-9\]+, 0B\\);" 1 "gimple" } }
> +
> +    integer :: D(5)
> +    !$omp allocate(D) align(256)
> +    ! { dg-final { scan-tree-dump-times "d\\.\[0-9\]+ = __builtin_GOMP_alloc \\(256, 20, 0B\\);" 1 "gimple" } }
> +    ! { dg-final { scan-tree-dump-times "__builtin_GOMP_free \\(d\\.\[0-9\]+, 0B\\);" 1 "gimple" } }
> +
> +    B = 0
> +    C = [1,2,3,4,5]
> +    D = [11,22,33,44,55]
> +
> +    if (mod (transfer(loc(B), intptr), 64_c_intptr_t) /= 0) &
> +      stop 3
> +    if (mod (transfer(loc(C), intptr), 64_c_intptr_t) /= 0) &
> +      stop 4
> +    if (mod (transfer(loc(D), intptr), 256_c_intptr_t) /= 0) &
> +      stop 5
> +
> +    do i = 1, 5
> +      if (C(i) /= i) &
> +        stop 6
> +      if (D(i) /= i + 10*i) &
> +        stop 7
> +    end do
> +
> +    do i = 1, n
> +      if (B(i) /= 0) &
> +        stop 9
> +      sum = sum + A(i)+B(i)+C(mod(i,5)+1)+D(mod(i,5)+1)
> +    end do
> +  end block
> +  call omp_destroy_allocator (my_allocator)
> + end block
> + one = sum
> +end
> +end module
> +
> +use m
> +if (one () /= 1225) &
> +  stop 1
> +end
> diff --git a/libgomp/testsuite/libgomp.fortran/allocate-6.f90 b/libgomp/testsuite/libgomp.fortran/allocate-6.f90
> new file mode 100644
> index 00000000000..5c32652f2a6
> --- /dev/null
> +++ b/libgomp/testsuite/libgomp.fortran/allocate-6.f90
> @@ -0,0 +1,123 @@
> +module m
> +  use iso_c_binding
> +  use omp_lib
> +  implicit none (type, external)
> +  integer(c_intptr_t) :: intptr
> +
> +! { dg-final { scan-tree-dump-not "__builtin_stack_save" "gimple" } }
> +! { dg-final { scan-tree-dump-not "__builtin_alloca" "gimple" } }
> +! { dg-final { scan-tree-dump-not "__builtin_stack_restore" "gimple" } }
> +
> +! { dg-final { scan-tree-dump-times "__builtin_GOMP_alloc \\(" 5 "gimple" } }
> +! { dg-final { scan-tree-dump-times "__builtin_GOMP_free \\(" 5 "gimple" } }
> +
> +contains
> +
> +subroutine one ()
> +  integer :: result, n, i
> +  result = 0
> +  n = 3
> +  !$omp target map(tofrom: result) firstprivate(n)
> +    block
> +      integer :: var, var2(n)
> +      !$omp allocate(var,var2) align(128) allocator(omp_low_lat_mem_alloc)
> +      var = 5
> +! { dg-final { scan-tree-dump-times "var\\.\[0-9\]+ = __builtin_GOMP_alloc \\(128, 4, 5\\);" 1 "gimple" } } */
> +! { dg-final { scan-tree-dump-times "var2\\.\[0-9\]+ = __builtin_GOMP_alloc \\(128, D\\.\[0-9\]+, 5\\);" 1 "gimple" } } */
> +
> +! { dg-final { scan-tree-dump-times "__builtin_GOMP_free \\(var\\.\[0-9\]+, 0B\\);" 1 "gimple" } } */
> +! { dg-final { scan-tree-dump-times "__builtin_GOMP_free \\(var2\\.\[0-9\]+, 0B\\);" 1 "gimple" } } */
> +
> +      if (mod(transfer(loc(var), intptr), 128_c_intptr_t) /= 0) &
> +        stop 1
> +      if (mod(transfer(loc(var2), intptr), 128_c_intptr_t) /= 0) &
> +        stop 2
> +      if (var /= 5) &
> +        stop 3
> +
> +      !$omp parallel do
> +      do i = 1, n
> +        var2(i) = (i+32);
> +      end do
> +
> +      !$omp parallel loop reduction(+:result)
> +      do i = 1, n
> +        result = result + var + var2(i)
> +      end do
> +    end block
> +  if (result /= (3*5 + 33 + 34 + 35)) &
> +    stop 4
> +end
> +
> +subroutine two ()
> +  type st
> +    integer :: a, b
> +  end type
> +  integer :: scalar, array(5), i
> +  type(st) s
> +  !$omp allocate(scalar, array, s)
> +! { dg-final { scan-tree-dump-times "scalar\\.\[0-9\]+ = __builtin_GOMP_alloc \\(4, 4, 0B\\);" 1 "gimple" } }
> +! { dg-final { scan-tree-dump-times "array\\.\[0-9\]+ = __builtin_GOMP_alloc \\(4, 20, 0B\\);" 1 "gimple" } }
> +! { dg-final { scan-tree-dump-times "s\\.\[0-9\]+ = __builtin_GOMP_alloc \\(4, 8, 0B\\);" 1 "gimple" } }
> +! { dg-final { scan-tree-dump-times "__builtin_GOMP_free \\(scalar\\.\[0-9\]+, 0B\\);" 1 "gimple" } }
> +! { dg-final { scan-tree-dump-times "__builtin_GOMP_free \\(array\\.\[0-9\]+, 0B\\);" 1 "gimple" } }
> +! { dg-final { scan-tree-dump-times "__builtin_GOMP_free \\(s\\.\[0-9\]+, 0B\\);" 1 "gimple" } }
> +
> +  scalar = 44
> +  array = [1,2,3,4,5]
> +  s = st(a=11, b=56)
> +
> +  !$omp parallel firstprivate(scalar) firstprivate(array) firstprivate(s)
> +    if (scalar /= 44) &
> +      stop 5
> +    scalar = 33;
> +    if (any (array /= [1,2,3,4,5])) &
> +      stop 6
> +    array = [10,20,30,40,50]
> +    if (s%a /= 11 .or. s%b /= 56) &
> +      stop 7
> +    s%a = 74
> +    s%b = 674
> +  !$omp end parallel
> +
> +  if (scalar /= 44) &
> +    stop 8
> +  if (any (array /= [1,2,3,4,5])) &
> +    stop 9
> +  if (s%a /= 11 .or. s%b /= 56) &
> +    stop 10
> +
> +  !$omp target defaultmap(firstprivate : scalar) defaultmap(none : aggregate) defaultmap(none : pointer)
> +    if (scalar /= 44) &
> +      stop 11
> +    scalar = 33;
> +  !$omp end target
> +
> +  if (scalar /= 44) &
> +    stop 12
> +
> +  !$omp target defaultmap(none : scalar) defaultmap(firstprivate : aggregate) defaultmap(none : pointer) private(i)
> +    if (any (array /= [1,2,3,4,5])) &
> +      stop 13
> +    do i = 1, 5
> +      array(i) = 10*i
> +    end do
> +  !$omp end target
> +
> +  if (any(array /= [1,2,3,4,5])) &
> +    stop 13
> +  !$omp target defaultmap(none : scalar) defaultmap(firstprivate : aggregate) defaultmap(none : pointer)
> +    if (s%a /= 11 .or. s%b /= 56) &
> +      stop 14
> +    s%a = 74
> +    s%b = 674
> +  !$omp end target
> +  if (s%a /= 11 .or. s%b /= 56) &
> +    stop 15
> +end
> +end module
> +
> +use m
> +  call one ()
> +  call two ()
> +end
> diff --git a/libgomp/testsuite/libgomp.fortran/allocate-7.f90 b/libgomp/testsuite/libgomp.fortran/allocate-7.f90
> new file mode 100644
> index 00000000000..83f3eabfc3e
> --- /dev/null
> +++ b/libgomp/testsuite/libgomp.fortran/allocate-7.f90
> @@ -0,0 +1,342 @@
> +! { dg-additional-options "-fdump-tree-omplower" }
> +
> +! For the 4 vars in omp_parallel, 4 in omp_target and 2 in no_alloc2_func.
> +! { dg-final { scan-tree-dump-times "__builtin_GOMP_alloc \\(" 10 "omplower" } }
> +! { dg-final { scan-tree-dump-times "__builtin_GOMP_free \\(" 10 "omplower" } }
> +
> +module m
> +  use iso_c_binding
> +  use omp_lib
> +  implicit none (type, external)
> +  integer(c_intptr_t) :: intptr
> +
> +contains
> +
> +subroutine check_int (x, y)
> +  integer :: x, y
> +  value :: y
> +  if (x /= y) &
> +    stop 1
> +end
> +
> +subroutine check_ptr (x, y)
> +  type(c_ptr) :: x
> +  integer(c_intptr_t), value :: y
> +  if (transfer(x,intptr) /= y) &
> +    stop 2
> +end
> +
> +integer function no_alloc_func () result(res)
> +  ! There is no __builtin_GOMP_alloc / __builtin_GOMP_free as
> +  ! allocator == omp_default_mem_alloc (known at compile time.
> +  integer :: no_alloc
> +  !$omp allocate(no_alloc) allocator(omp_default_mem_alloc)
> +  no_alloc = 7
> +  res = no_alloc
> +end
> +
> +integer function no_alloc2_func() result(res)
> +  ! If no_alloc2 were TREE_UNUSED, there would be no
> +  ! __builtin_GOMP_alloc / __builtin_GOMP_free
> +  ! However, as the parser already marks no_alloc2
> +  ! and is_alloc2 as used, the tree is generated for both vars.
> +  integer :: no_alloc2, is_alloc2
> +  !$omp allocate(no_alloc2, is_alloc2)
> +  is_alloc2 = 7
> +  res = is_alloc2
> +end
> +
> +
> +subroutine omp_parallel ()
> +  integer :: i, n, iii, jjj(5)
> +  type(c_ptr) :: ptr
> +  !$omp allocate(iii, jjj, ptr)
> +  n = 6
> +  iii = 5
> +  ptr = transfer (int(z'1234', c_intptr_t), ptr)
> + block
> +  integer :: kkk(n)
> +  !$omp allocate(kkk)
> +
> +  do i = 1, 5
> +    jjj(i) = 3*i
> +  end do
> +  do i = 1, 6
> +    kkk(i) = 7*i
> +  end do
> +
> +  !$omp parallel default(none) firstprivate(iii, jjj, kkk, ptr) if(.false.)
> +    if (iii /= 5) &
> +      stop 3
> +    iii = 7
> +    call check_int (iii, 7)
> +    do i = 1, 5
> +      if (jjj(i) /= 3*i) &
> +        stop 4
> +    end do
> +    do i = 1, 6
> +      if (kkk(i) /= 7*i) &
> +        stop 5
> +    end do
> +    do i = 1, 5
> +      jjj(i) = 4*i
> +    end do
> +    do i = 1, 6
> +      kkk(i) = 8*i
> +    end do
> +    do i = 1, 5
> +      call check_int (jjj(i), 4*i)
> +    end do
> +    do i = 1, 6
> +      call check_int (kkk(i), 8*i)
> +    end do
> +    if (transfer (ptr, intptr) /= int(z'1234', c_intptr_t)) &
> +      stop 6
> +    ptr = transfer (int(z'abcd', c_intptr_t), ptr)
> +    if (transfer (ptr, intptr) /= int(z'abcd', c_intptr_t)) &
> +      stop 7
> +    call check_ptr (ptr,  int(z'abcd', c_intptr_t))
> +  !$omp end parallel
> +
> +  if (iii /= 5) &
> +    stop 8
> +  call check_int (iii, 5)
> +  do i = 1, 5
> +    if (jjj(i) /= 3*i) &
> +      stop 9
> +    call check_int (jjj(i), 3*i)
> +  end do
> +  do i = 1, 6
> +    if (kkk(i) /= 7*i) &
> +      stop 10
> +    call check_int (kkk(i), 7*i)
> +  end do
> +  if (transfer (ptr, intptr) /= int(z'1234', c_intptr_t)) &
> +    stop 11
> +  call check_ptr (ptr, int(z'1234', c_intptr_t))
> +
> +  !$omp parallel default(firstprivate) if(.false.)
> +    if (iii /= 5) &
> +      stop 12
> +    iii = 7
> +    call check_int (iii, 7)
> +    do i = 1, 5
> +      if (jjj(i) /= 3*i) &
> +        stop 13
> +    end do
> +    do i = 1, 6
> +      if (kkk(i) /= 7*i) &
> +        stop 14
> +    end do
> +    do i = 1, 5
> +      jjj(i) = 4*i
> +    end do
> +    do i = 1, 6
> +      kkk(i) = 8*i
> +    end do
> +    do i = 1, 5
> +      call check_int (jjj(i), 4*i)
> +    end do
> +    do i = 1, 6
> +      call check_int (kkk(i), 8*i)
> +    end do
> +    if (transfer (ptr, intptr) /= int(z'1234', c_intptr_t)) &
> +      stop 15
> +    ptr = transfer (int (z'abcd', c_intptr_t), ptr)
> +    if (transfer (ptr, intptr) /= int(z'abcd', c_intptr_t)) &
> +      stop 16
> +    call check_ptr (ptr, int (z'abcd', c_intptr_t))
> +  !$omp end parallel
> +  if (iii /= 5) &
> +    stop 17
> +  call check_int (iii, 5)
> +  do i = 1, 5
> +    if (jjj(i) /= 3*i) &
> +      stop 18
> +    call check_int (jjj(i), 3*i)
> +  end do
> +  do i = 1, 6
> +    if (kkk(i) /= 7*i) &
> +      stop 19
> +    call check_int (kkk(i), 7*i)
> +  end do
> +  if (transfer (ptr, intptr) /= int(z'1234', c_intptr_t)) &
> +    stop 20
> +  call check_ptr (ptr, int (z'1234', c_intptr_t))
> + end block
> +end
> +
> +subroutine omp_target ()
> +  integer :: i, n, iii, jjj(5)
> +  type(c_ptr) :: ptr
> +  !$omp allocate(iii, jjj, ptr)
> +  n = 6
> +  iii = 5
> +  ptr = transfer (int (z'1234', c_intptr_t), ptr)
> + block
> +  integer :: kkk(n)
> +  !$omp allocate(kkk)
> +  do i = 1, 5
> +    jjj(i) = 3*i
> +  end do
> +  do i = 1, 6
> +    kkk(i) = 7*i
> +  end do
> +
> +  !$omp target defaultmap(none) firstprivate(iii, jjj, kkk, ptr) private(i)
> +    if (iii /= 5) &
> +      stop 21
> +    iii = 7
> +    call check_int (iii, 7)
> +    do i = 1, 5
> +      if (jjj(i) /= 3*i) &
> +        stop 22
> +    end do
> +    do i = 1, 6
> +      if (kkk(i) /= 7*i) &
> +        stop 23
> +    end do
> +    do i = 1, 5
> +      jjj(i) = 4*i
> +    end do
> +    do i = 1, 6
> +      kkk(i) = 8*i
> +    end do
> +    do i = 1, 5
> +      call check_int (jjj(i), 4*i)
> +    end do
> +    do i = 1, 6
> +      call check_int (kkk(i), 8*i)
> +    end do
> +    if (transfer (ptr, intptr) /= int(z'1234', c_intptr_t)) &
> +      stop 24
> +    ptr = transfer (int (z'abcd', c_intptr_t), ptr)
> +    if (transfer (ptr, intptr) /= int(z'abcd', c_intptr_t)) &
> +      stop 25
> +    call check_ptr (ptr, int (z'abcd', c_intptr_t))
> +  !$omp end target
> +
> +  if (iii /= 5) &
> +    stop 26
> +  call check_int (iii, 5)
> +  do i = 1, 5
> +    if (jjj(i) /= 3*i) &
> +      stop 27
> +    call check_int (jjj(i), 3*i)
> +  end do
> +  do i = 1, 6
> +    if (kkk(i) /= 7*i) &
> +      stop 28
> +    call check_int (kkk(i), 7*i)
> +  end do
> +  if (transfer (ptr, intptr) /= int(z'1234', c_intptr_t)) &
> +    stop 29
> +  call check_ptr (ptr, int (z'1234', c_intptr_t))
> +
> +  !$omp target defaultmap(firstprivate)
> +    if (iii /= 5) &
> +      stop 30
> +    iii = 7
> +    call check_int (iii, 7)
> +    do i = 1, 5
> +      if (jjj(i) /= 3*i) &
> +        stop 31
> +    end do
> +    do i = 1, 6
> +      if (kkk(i) /= 7*i) &
> +        stop 32
> +    end do
> +    do i = 1, 5
> +      jjj(i) = 4*i
> +    end do
> +    do i = 1, 6
> +      kkk(i) = 8*i
> +    end do
> +    do i = 1, 5
> +      call check_int (jjj(i), 4*i)
> +    end do
> +    do i = 1, 6
> +      call check_int (kkk(i), 8*i)
> +    end do
> +    if (transfer (ptr, intptr) /= int(z'1234', c_intptr_t)) &
> +      stop 33
> +    ptr = transfer (int (z'abcd', c_intptr_t), ptr)
> +    if (transfer (ptr, intptr) /= int(z'abcd', c_intptr_t)) &
> +      stop 34
> +    call check_ptr (ptr, int (z'abcd', c_intptr_t))
> +  !$omp end target
> +  if (iii /= 5) &
> +    stop 35
> +  call check_int (iii, 5)
> +  do i = 1, 5
> +    if (jjj(i) /= 3*i) &
> +      stop 36
> +    call check_int (jjj(i), 3*i)
> +  end do
> +  do i = 1, 6
> +    if (kkk(i) /= 7*i) &
> +      stop 37
> +    call check_int (kkk(i), 7*i)
> +  end do
> +  if (transfer (ptr, intptr) /= int(z'1234', c_intptr_t)) &
> +    stop 38
> +  call check_ptr (ptr, int (z'1234', c_intptr_t))
> +
> +  !$omp target defaultmap(tofrom)
> +    if (iii /= 5) &
> +      stop 39
> +    iii = 7
> +    call check_int (iii, 7)
> +    do i = 1, 5
> +      if (jjj(i) /= 3*i) &
> +        stop 40
> +    end do
> +    do i = 1, 6
> +      if (kkk(i) /= 7*i) &
> +        stop 41
> +    end do
> +    do i = 1, 5
> +      jjj(i) = 4*i
> +    end do
> +    do i = 1, 6
> +      kkk(i) = 8*i
> +    end do
> +    do i = 1, 5
> +      call check_int (jjj(i), 4*i)
> +    end do
> +    do i = 1, 6
> +      call check_int (kkk(i), 8*i)
> +    end do
> +    if (transfer (ptr, intptr) /= int(z'1234', c_intptr_t)) &
> +      stop 42
> +    ptr = transfer (int(z'abcd',c_intptr_t), ptr)
> +    if (transfer (ptr, intptr) /= int(z'abcd', c_intptr_t)) &
> +      stop 43
> +    call check_ptr (ptr, int (z'abcd', c_intptr_t))
> +  !$omp end target
> +
> +  if (iii /= 7) &
> +    stop 44
> +  call check_int (iii, 7)
> +  do i = 1, 5
> +    if (jjj(i) /= 4*i) &
> +      stop 45
> +    call check_int (jjj(i), 4*i)
> +  end do
> +  do i = 1, 6
> +    if (kkk(i) /= 8*i) &
> +      stop 46
> +    call check_int (kkk(i), 8*i)
> +  end do
> +  if (transfer (ptr, intptr) /= int(z'abcd', c_intptr_t)) &
> +    stop 47
> +  call check_ptr (ptr, int (z'abcd', c_intptr_t))
> + end block
> +end
> +end module
> +
> +
> +use m
> +  call omp_parallel ()
> +  call omp_target ()
> +end
> diff --git a/libgomp/testsuite/libgomp.fortran/allocate-8.f90 b/libgomp/testsuite/libgomp.fortran/allocate-8.f90
> new file mode 100644
> index 00000000000..b9dea6c5148
> --- /dev/null
> +++ b/libgomp/testsuite/libgomp.fortran/allocate-8.f90
> @@ -0,0 +1,99 @@
> +module m
> +use omp_lib
> +implicit none
> +!!$omp requires dynamic_allocators
> +
> +integer :: final_count
> +
> +type t
> +  integer :: i = 0
> +  integer, allocatable :: A(:,:)
> +contains
> +  final :: count_finalization
> +end type t
> +
> +contains
> +
> +elemental impure subroutine count_finalization(self)
> +  type(t), intent(in) :: self
> +  final_count = final_count + 1
> +end
> +
> +subroutine test(allocator)
> +integer(omp_allocator_handle_kind), optional, value :: allocator
> +call zero_size(allocator)
> +call finalization_test(allocator)
> +end subroutine test
> +
> +subroutine finalization_test(allocator)
> +integer(omp_allocator_handle_kind), optional, value :: allocator
> +integer :: n = 5
> +
> +final_count = 0;
> +block
> +  type(t) :: A
> +!  !$omp allocate(A) allocator(allocator)
> +  A%i = 1
> +end block
> +if (final_count /= 1) &
> +  stop 10
> +
> +final_count = 0;
> +block
> +  type(t) :: B(7)
> +  !$omp allocate(B) allocator(allocator)
> +  B(1)%i = 1
> +end block
> +if (final_count /= 7) stop 10
> +
> +final_count = 0;
> +block
> +  type(t) :: C(n)
> +!  !$omp allocate(C) allocator(allocator)
> +  C(1)%i = 1
> +end block
> +if (final_count /= 5) stop 10
> +
> +final_count = 0;
> +block
> +  type(t) :: D(0)
> +!  !$omp allocate(D) allocator(allocator)
> +  D(1:0)%i = 1
> +end block
> +if (final_count /= 0) stop 10
> +end subroutine
> +
> +subroutine zero_size(allocator)
> +integer(omp_allocator_handle_kind), optional, value :: allocator
> +integer :: n
> +n = -3
> +
> +block
> +  integer :: A(n)
> +  character(len=n) :: B
> +!  !$omp allocate(A,b) allocator(allocator)
> +  if (size(A) /= 0 .or. len(b) /= 0) &
> +    stop 1
> +  B(1:len(b)) ='A'
> +end block
> +
> +!!$omp target
> +block
> +  integer :: A(n)
> +  character(len=n) :: B
> +!  !$omp allocate(A,b) allocator(allocator)
> +  if (size(A) /= 0 .or. len(b) /= 0) &
> +    stop 2
> +  B(1:len(b)) ='A'
> +end block
> +end
> +end module
> +
> +use m
> +call test()
> +call test(omp_default_mem_alloc)
> +call test(omp_large_cap_mem_alloc)
> +call test(omp_high_bw_mem_alloc)
> +call test(omp_low_lat_mem_alloc)
> +call test(omp_cgroup_mem_alloc)
> +end
-----------------
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

On Wed, Oct 18, 2023 at 11:12:44AM +0200, Thomas Schwinge wrote:
> Hi Tobias!
> 
> On 2023-10-13T15:29:52+0200, Tobias Burnus <tobias@codesourcery.com> wrote:
> > => Updated patch attached
> 
> When cherry-picking this commit cccc2d3dbf0eff668bed5f5f168b3cafd8590c54
> "Fortran: Support OpenMP's 'allocate' directive for stack vars" on top of
> slightly older GCC sources (mentioning that just in case that's
> relevant), in a configuration with offloading enabled (only), I see:
> 
>     +FAIL: gfortran.dg/gomp/allocate-13.f90   -O  (internal compiler error: tree code 'statement_list' is not supported in LTO streams)
>     +FAIL: gfortran.dg/gomp/allocate-13.f90   -O  (test for excess errors)

Any references to GENERIC code in clauses etc. should have been gimplified
or cleared during gimplification, we shouldn't support STATEMENT_LIST
in LTO streaming.

	Jakub