Add support for allocate clause (OpenMP 5.0).
authorHafiz Abid Qadeer <abidh@codesourcery.com>
Fri, 24 Sep 2021 09:04:12 +0000 (10:04 +0100)
committerHafiz Abid Qadeer <abidh@codesourcery.com>
Thu, 13 Jan 2022 18:57:05 +0000 (18:57 +0000)
This patch adds support for OpenMP 5.0 allocate clause for fortran. It does not
yet support the allocator-modifier as specified in OpenMP 5.1. The allocate
clause is already supported in C/C++.

gcc/fortran/ChangeLog:

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

gcc/testsuite/ChangeLog:

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

libgomp/ChangeLog:

* testsuite/libgomp.fortran/allocate-1.c: New test.
* testsuite/libgomp.fortran/allocate-1.f90: New test.
* libgomp.texi: Remove string that says that allocate clause
support is for C/C++ only.

13 files changed:
gcc/fortran/dump-parse-tree.c
gcc/fortran/gfortran.h
gcc/fortran/openmp.c
gcc/fortran/trans-openmp.c
gcc/testsuite/gfortran.dg/gomp/allocate-1.f90 [new file with mode: 0644]
gcc/testsuite/gfortran.dg/gomp/allocate-2.f90 [new file with mode: 0644]
gcc/testsuite/gfortran.dg/gomp/allocate-3.f90 [new file with mode: 0644]
gcc/testsuite/gfortran.dg/gomp/clauses-1.f90
gcc/testsuite/gfortran.dg/gomp/collapse1.f90
gcc/testsuite/gfortran.dg/gomp/openmp-simd-4.f90
libgomp/libgomp.texi
libgomp/testsuite/libgomp.fortran/allocate-1.c [new file with mode: 0644]
libgomp/testsuite/libgomp.fortran/allocate-1.f90 [new file with mode: 0644]

index 7459f4b..a618ae2 100644 (file)
@@ -1685,6 +1685,7 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses)
          case OMP_LIST_USE_DEVICE_PTR: type = "USE_DEVICE_PTR"; break;
          case OMP_LIST_USE_DEVICE_ADDR: type = "USE_DEVICE_ADDR"; break;
          case OMP_LIST_NONTEMPORAL: type = "NONTEMPORAL"; break;
+         case OMP_LIST_ALLOCATE: type = "ALLOCATE"; break;
          case OMP_LIST_SCAN_IN: type = "INCLUSIVE"; break;
          case OMP_LIST_SCAN_EX: type = "EXCLUSIVE"; break;
          default:
index 41ac6c0..26a15b1 100644 (file)
@@ -1392,6 +1392,7 @@ enum
   OMP_LIST_USE_DEVICE_PTR,
   OMP_LIST_USE_DEVICE_ADDR,
   OMP_LIST_NONTEMPORAL,
+  OMP_LIST_ALLOCATE,
   OMP_LIST_NUM
 };
 
index 86c412a..a204323 100644 (file)
@@ -912,6 +912,7 @@ enum omp_mask1
   OMP_CLAUSE_MEMORDER,  /* OpenMP 5.0.  */
   OMP_CLAUSE_DETACH,  /* OpenMP 5.0.  */
   OMP_CLAUSE_AFFINITY,  /* OpenMP 5.0.  */
+  OMP_CLAUSE_ALLOCATE,  /* OpenMP 5.0.  */
   OMP_CLAUSE_BIND,  /* OpenMP 5.0.  */
   OMP_CLAUSE_FILTER,  /* OpenMP 5.1.  */
   OMP_CLAUSE_AT,  /* OpenMP 5.1.  */
@@ -1549,6 +1550,40 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
                }
              continue;
            }
+         if ((mask & OMP_CLAUSE_ALLOCATE)
+             && gfc_match ("allocate ( ") == MATCH_YES)
+           {
+             gfc_expr *allocator = NULL;
+             old_loc = gfc_current_locus;
+             m = gfc_match_expr (&allocator);
+             if (m == MATCH_YES && gfc_match (" : ") != MATCH_YES)
+               {
+                 /* If no ":" then there is no allocator, we backtrack
+                    and read the variable list.  */
+                 gfc_free_expr (allocator);
+                 allocator = NULL;
+                 gfc_current_locus = old_loc;
+               }
+
+             gfc_omp_namelist **head = NULL;
+             m = gfc_match_omp_variable_list ("", &c->lists[OMP_LIST_ALLOCATE],
+                                              true, NULL, &head);
+
+             if (m != MATCH_YES)
+               {
+                 gfc_free_expr (allocator);
+                 gfc_error ("Expected variable list at %C");
+                 goto error;
+               }
+
+             for (gfc_omp_namelist *n = *head; n; n = n->next)
+               if (allocator)
+                 n->expr = gfc_copy_expr (allocator);
+               else
+                 n->expr = NULL;
+             gfc_free_expr (allocator);
+             continue;
+           }
          if ((mask & OMP_CLAUSE_AT)
              && (m = gfc_match_dupl_check (c->at == OMP_AT_UNSET, "at", true))
                 != MATCH_NO)
@@ -3572,7 +3607,7 @@ cleanup:
   (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE             \
    | OMP_CLAUSE_SHARED | OMP_CLAUSE_COPYIN | OMP_CLAUSE_REDUCTION      \
    | OMP_CLAUSE_IF | OMP_CLAUSE_NUM_THREADS | OMP_CLAUSE_DEFAULT       \
-   | OMP_CLAUSE_PROC_BIND)
+   | OMP_CLAUSE_PROC_BIND | OMP_CLAUSE_ALLOCATE)
 #define OMP_DECLARE_SIMD_CLAUSES \
   (omp_mask (OMP_CLAUSE_SIMDLEN) | OMP_CLAUSE_LINEAR                   \
    | OMP_CLAUSE_UNIFORM        | OMP_CLAUSE_ALIGNED | OMP_CLAUSE_INBRANCH      \
@@ -3581,15 +3616,16 @@ cleanup:
   (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE             \
    | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION                     \
    | OMP_CLAUSE_SCHEDULE | OMP_CLAUSE_ORDERED | OMP_CLAUSE_COLLAPSE    \
-   | OMP_CLAUSE_LINEAR | OMP_CLAUSE_ORDER)
+   | OMP_CLAUSE_LINEAR | OMP_CLAUSE_ORDER | OMP_CLAUSE_ALLOCATE)
 #define OMP_LOOP_CLAUSES \
   (omp_mask (OMP_CLAUSE_BIND) | OMP_CLAUSE_COLLAPSE | OMP_CLAUSE_ORDER \
    | OMP_CLAUSE_PRIVATE | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION)
+
 #define OMP_SCOPE_CLAUSES \
   (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_REDUCTION)
 #define OMP_SECTIONS_CLAUSES \
   (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE             \
-   | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION)
+   | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION | OMP_CLAUSE_ALLOCATE)
 #define OMP_SIMD_CLAUSES \
   (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_LASTPRIVATE              \
    | OMP_CLAUSE_REDUCTION | OMP_CLAUSE_COLLAPSE | OMP_CLAUSE_SAFELEN   \
@@ -3600,20 +3636,22 @@ cleanup:
    | OMP_CLAUSE_SHARED | OMP_CLAUSE_IF | OMP_CLAUSE_DEFAULT            \
    | OMP_CLAUSE_UNTIED | OMP_CLAUSE_FINAL | OMP_CLAUSE_MERGEABLE       \
    | OMP_CLAUSE_DEPEND | OMP_CLAUSE_PRIORITY | OMP_CLAUSE_IN_REDUCTION \
-   | OMP_CLAUSE_DETACH | OMP_CLAUSE_AFFINITY)
+   | OMP_CLAUSE_DETACH | OMP_CLAUSE_AFFINITY | OMP_CLAUSE_ALLOCATE)
 #define OMP_TASKLOOP_CLAUSES \
   (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE             \
    | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_SHARED | OMP_CLAUSE_IF                \
    | OMP_CLAUSE_DEFAULT | OMP_CLAUSE_UNTIED | OMP_CLAUSE_FINAL         \
    | OMP_CLAUSE_MERGEABLE | OMP_CLAUSE_PRIORITY | OMP_CLAUSE_GRAINSIZE \
    | OMP_CLAUSE_NUM_TASKS | OMP_CLAUSE_COLLAPSE | OMP_CLAUSE_NOGROUP   \
-   | OMP_CLAUSE_REDUCTION | OMP_CLAUSE_IN_REDUCTION)
+   | OMP_CLAUSE_REDUCTION | OMP_CLAUSE_IN_REDUCTION | OMP_CLAUSE_ALLOCATE)
+#define OMP_TASKGROUP_CLAUSES \
+  (omp_mask (OMP_CLAUSE_TASK_REDUCTION) | OMP_CLAUSE_ALLOCATE)
 #define OMP_TARGET_CLAUSES \
   (omp_mask (OMP_CLAUSE_DEVICE) | OMP_CLAUSE_MAP | OMP_CLAUSE_IF       \
    | OMP_CLAUSE_DEPEND | OMP_CLAUSE_NOWAIT | OMP_CLAUSE_PRIVATE                \
    | OMP_CLAUSE_FIRSTPRIVATE | OMP_CLAUSE_DEFAULTMAP                   \
    | OMP_CLAUSE_IS_DEVICE_PTR | OMP_CLAUSE_IN_REDUCTION                        \
-   | OMP_CLAUSE_THREAD_LIMIT)
+   | OMP_CLAUSE_THREAD_LIMIT | OMP_CLAUSE_ALLOCATE)
 #define OMP_TARGET_DATA_CLAUSES \
   (omp_mask (OMP_CLAUSE_DEVICE) | OMP_CLAUSE_MAP | OMP_CLAUSE_IF       \
    | OMP_CLAUSE_USE_DEVICE_PTR | OMP_CLAUSE_USE_DEVICE_ADDR)
@@ -3629,13 +3667,14 @@ cleanup:
 #define OMP_TEAMS_CLAUSES \
   (omp_mask (OMP_CLAUSE_NUM_TEAMS) | OMP_CLAUSE_THREAD_LIMIT           \
    | OMP_CLAUSE_DEFAULT | OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE \
-   | OMP_CLAUSE_SHARED | OMP_CLAUSE_REDUCTION)
+   | OMP_CLAUSE_SHARED | OMP_CLAUSE_REDUCTION | OMP_CLAUSE_ALLOCATE)
 #define OMP_DISTRIBUTE_CLAUSES \
   (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE             \
    | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_COLLAPSE | OMP_CLAUSE_DIST_SCHEDULE \
-   | OMP_CLAUSE_ORDER)
+   | OMP_CLAUSE_ORDER | OMP_CLAUSE_ALLOCATE)
 #define OMP_SINGLE_CLAUSES \
-  (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE)
+  (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE             \
+   | OMP_CLAUSE_ALLOCATE)
 #define OMP_ORDERED_CLAUSES \
   (omp_mask (OMP_CLAUSE_THREADS) | OMP_CLAUSE_SIMD)
 #define OMP_DECLARE_TARGET_CLAUSES \
@@ -5905,7 +5944,7 @@ gfc_match_omp_barrier (void)
 match
 gfc_match_omp_taskgroup (void)
 {
-  return match_omp (EXEC_OMP_TASKGROUP, OMP_CLAUSE_TASK_REDUCTION);
+  return match_omp (EXEC_OMP_TASKGROUP, OMP_TASKGROUP_CLAUSES);
 }
 
 
@@ -6243,7 +6282,7 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
        "IN_REDUCTION", "TASK_REDUCTION",
        "DEVICE_RESIDENT", "LINK", "USE_DEVICE",
        "CACHE", "IS_DEVICE_PTR", "USE_DEVICE_PTR", "USE_DEVICE_ADDR",
-       "NONTEMPORAL" };
+       "NONTEMPORAL", "ALLOCATE" };
   STATIC_ASSERT (ARRAY_SIZE (clause_names) == OMP_LIST_NUM);
 
   if (omp_clauses == NULL)
@@ -6529,7 +6568,8 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
        && list != OMP_LIST_REDUCTION_INSCAN
        && list != OMP_LIST_REDUCTION_TASK
        && list != OMP_LIST_IN_REDUCTION
-       && list != OMP_LIST_TASK_REDUCTION)
+       && list != OMP_LIST_TASK_REDUCTION
+       && list != OMP_LIST_ALLOCATE)
       for (n = omp_clauses->lists[list]; n; n = n->next)
        {
          bool component_ref_p = false;
@@ -6598,6 +6638,78 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
        n->sym->mark = 1;
     }
 
+  if (omp_clauses->lists[OMP_LIST_ALLOCATE])
+    {
+      for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; n = n->next)
+       if (n->expr && (n->expr->ts.type != BT_INTEGER
+           || n->expr->ts.kind != gfc_c_intptr_kind))
+         {
+           gfc_error ("Expected integer expression of the "
+                      "'omp_allocator_handle_kind' kind at %L",
+                      &n->expr->where);
+           break;
+         }
+
+      /* Check for 2 things here.
+     1.  There is no duplication of variable in allocate clause.
+     2.  Variable in allocate clause are also present in some
+        privatization clase (non-composite case).  */
+      for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; n = n->next)
+       n->sym->mark = 0;
+
+      gfc_omp_namelist *prev = NULL;
+      for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n;)
+       {
+         if (n->sym->mark == 1)
+           {
+             gfc_warning (0, "%qs appears more than once in %<allocate%> "
+                          "clauses at %L" , n->sym->name, &n->where);
+             /* We have already seen this variable so it is a duplicate.
+                Remove it.  */
+             if (prev != NULL && prev->next == n)
+               {
+                 prev->next = n->next;
+                 n->next = NULL;
+                 gfc_free_omp_namelist (n, 0);
+                 n = prev->next;
+               }
+             continue;
+           }
+         n->sym->mark = 1;
+         prev = n;
+         n = n->next;
+       }
+
+      /* Non-composite constructs.  */
+      if (code && code->op < EXEC_OMP_DO_SIMD)
+       {
+         for (list = 0; list < OMP_LIST_NUM; list++)
+           switch (list)
+           {
+             case OMP_LIST_PRIVATE:
+             case OMP_LIST_FIRSTPRIVATE:
+             case OMP_LIST_LASTPRIVATE:
+             case OMP_LIST_REDUCTION:
+             case OMP_LIST_REDUCTION_INSCAN:
+             case OMP_LIST_REDUCTION_TASK:
+             case OMP_LIST_IN_REDUCTION:
+             case OMP_LIST_TASK_REDUCTION:
+             case OMP_LIST_LINEAR:
+               for (n = omp_clauses->lists[list]; n; n = n->next)
+                 n->sym->mark = 0;
+               break;
+             default:
+               break;
+           }
+
+         for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; n = n->next)
+           if (n->sym->mark == 1)
+             gfc_error ("%qs specified in 'allocate' clause at %L but not "
+                        "in an explicit privatization clause",
+                        n->sym->name, &n->where);
+       }
+    }
+
   /* OpenACC reductions.  */
   if (openacc)
     {
@@ -8438,19 +8550,20 @@ resolve_omp_do (gfc_code *code)
       if (code->ext.omp_clauses)
        for (list = 0; list < OMP_LIST_NUM; list++)
          if (!is_simd || code->ext.omp_clauses->collapse > 1
-             ? (list != OMP_LIST_PRIVATE && list != OMP_LIST_LASTPRIVATE)
+             ? (list != OMP_LIST_PRIVATE && list != OMP_LIST_LASTPRIVATE
+                 && list != OMP_LIST_ALLOCATE)
              : (list != OMP_LIST_PRIVATE && list != OMP_LIST_LASTPRIVATE
-                && list != OMP_LIST_LINEAR))
+                && list != OMP_LIST_ALLOCATE && list != OMP_LIST_LINEAR))
            for (n = code->ext.omp_clauses->lists[list]; n; n = n->next)
              if (dovar == n->sym)
                {
                  if (!is_simd || code->ext.omp_clauses->collapse > 1)
                    gfc_error ("%s iteration variable present on clause "
-                              "other than PRIVATE or LASTPRIVATE at %L",
-                              name, &do_code->loc);
+                              "other than PRIVATE, LASTPRIVATE or "
+                              "ALLOCATE at %L", name, &do_code->loc);
                  else
                    gfc_error ("%s iteration variable present on clause "
-                              "other than PRIVATE, LASTPRIVATE or "
+                              "other than PRIVATE, LASTPRIVATE, ALLOCATE or "
                               "LINEAR at %L", name, &do_code->loc);
                  break;
                }
index 9661c77..d363258 100644 (file)
@@ -2649,6 +2649,28 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
                  }
              }
          break;
+       case OMP_LIST_ALLOCATE:
+         for (; n != NULL; n = n->next)
+           if (n->sym->attr.referenced)
+             {
+               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->expr)
+                     {
+                       tree allocator_;
+                       gfc_init_se (&se, NULL);
+                       gfc_conv_expr (&se, n->expr);
+                       allocator_ = gfc_evaluate_now (se.expr, block);
+                       OMP_CLAUSE_ALLOCATE_ALLOCATOR (node) = allocator_;
+                     }
+                   omp_clauses = gfc_trans_add_clause (node, omp_clauses);
+                 }
+             }
+         break;
        case OMP_LIST_LINEAR:
          {
            gfc_expr *last_step_expr = NULL;
@@ -6260,6 +6282,71 @@ gfc_split_omp_clauses (gfc_code *code,
        == (GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO))
        && !is_loop)
     clausesa[GFC_OMP_SPLIT_DO].nowait = true;
+
+   /* Distribute allocate clause to do, parallel, distribute, teams, target
+      and taskloop.  The code below itereates over variables in the
+      allocate list and checks if that available is also in any
+      privatization clause on those construct.  If yes, then we add it
+      to the list of 'allocate'ed variables for that construct.  If a
+      variable is found in none of them then we issue an error.  */
+
+   if (code->ext.omp_clauses->lists[OMP_LIST_ALLOCATE])
+     {
+       gfc_omp_namelist *alloc_nl, *priv_nl;
+       gfc_omp_namelist *tails[GFC_OMP_SPLIT_NUM];
+       for (alloc_nl = code->ext.omp_clauses->lists[OMP_LIST_ALLOCATE];
+          alloc_nl; alloc_nl = alloc_nl->next)
+        {
+          bool found = false;
+          for (int i = GFC_OMP_SPLIT_DO; i <= GFC_OMP_SPLIT_TASKLOOP; i++)
+            {
+              gfc_omp_namelist *p;
+              int list;
+              for (list = 0; list < OMP_LIST_NUM; list++)
+                {
+                  switch (list)
+                  {
+                    case OMP_LIST_PRIVATE:
+                    case OMP_LIST_FIRSTPRIVATE:
+                    case OMP_LIST_LASTPRIVATE:
+                    case OMP_LIST_REDUCTION:
+                    case OMP_LIST_REDUCTION_INSCAN:
+                    case OMP_LIST_REDUCTION_TASK:
+                    case OMP_LIST_IN_REDUCTION:
+                    case OMP_LIST_TASK_REDUCTION:
+                    case OMP_LIST_LINEAR:
+                      for (priv_nl = clausesa[i].lists[list]; priv_nl;
+                           priv_nl = priv_nl->next)
+                        if (alloc_nl->sym == priv_nl->sym)
+                          {
+                            found = true;
+                            p = gfc_get_omp_namelist ();
+                            p->sym = alloc_nl->sym;
+                            p->expr = alloc_nl->expr;
+                            p->where = alloc_nl->where;
+                            if (clausesa[i].lists[OMP_LIST_ALLOCATE] == NULL)
+                              {
+                                clausesa[i].lists[OMP_LIST_ALLOCATE] = p;
+                                tails[i] = p;
+                              }
+                            else
+                              {
+                                tails[i]->next = p;
+                                tails[i] = tails[i]->next;
+                              }
+                          }
+                      break;
+                    default:
+                      break;
+                  }
+                }
+            }
+          if (!found)
+            gfc_error ("%qs specified in 'allocate' clause at %L but not "
+                       "in an explicit privatization clause",
+                       alloc_nl->sym->name, &alloc_nl->where);
+        }
+     }
 }
 
 static tree
diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-1.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-1.f90
new file mode 100644 (file)
index 0000000..8bc6b76
--- /dev/null
@@ -0,0 +1,137 @@
+! { dg-do compile }
+
+module omp_lib_kinds
+  use iso_c_binding, only: c_int, c_intptr_t
+  implicit none
+  private :: c_int, c_intptr_t
+  integer, parameter :: omp_allocator_handle_kind = c_intptr_t
+
+  integer (kind=omp_allocator_handle_kind), &
+     parameter :: omp_null_allocator = 0
+  integer (kind=omp_allocator_handle_kind), &
+     parameter :: omp_default_mem_alloc = 1
+  integer (kind=omp_allocator_handle_kind), &
+     parameter :: omp_large_cap_mem_alloc = 2
+  integer (kind=omp_allocator_handle_kind), &
+     parameter :: omp_const_mem_alloc = 3
+  integer (kind=omp_allocator_handle_kind), &
+     parameter :: omp_high_bw_mem_alloc = 4
+  integer (kind=omp_allocator_handle_kind), &
+     parameter :: omp_low_lat_mem_alloc = 5
+  integer (kind=omp_allocator_handle_kind), &
+     parameter :: omp_cgroup_mem_alloc = 6
+  integer (kind=omp_allocator_handle_kind), &
+     parameter :: omp_pteam_mem_alloc = 7
+  integer (kind=omp_allocator_handle_kind), &
+     parameter :: omp_thread_mem_alloc = 8
+end module
+
+subroutine bar (a, b, c)
+  implicit none
+  integer  :: a
+  integer  :: b
+  integer  :: c
+  c = a + b
+end
+
+subroutine bar2 (a, b, c)
+  implicit none
+  integer  :: a
+  integer  :: b(15)
+  integer  :: c
+  c = a + b(1)
+end
+
+subroutine foo(x, y)
+  use omp_lib_kinds
+  implicit none
+  integer  :: x
+  integer  :: z
+
+  integer, dimension(15) :: y
+  integer  :: r
+  integer  :: i
+  integer  c1, c2, c3, c4
+  integer (kind=omp_allocator_handle_kind) :: h
+  common /B1/ c1, c2
+  common /B2/ c3, c4
+
+  r = 0
+  h = omp_default_mem_alloc;
+
+
+  !$omp parallel private(/B1/, c3, c4) allocate(/B1/, /B2/)
+  !$omp end parallel
+
+  !$omp parallel private(/B1/, /B2/) allocate(h:/B1/, /B2/)
+  !$omp end parallel
+  
+  !$omp parallel private(/B1/, /B2/) allocate(omp_large_cap_mem_alloc:/B1/, c3, c4)
+  !$omp end parallel
+
+  !$omp parallel allocate (x) allocate (h : y) &
+  !$omp  allocate (omp_large_cap_mem_alloc:z) firstprivate (x, y, z)
+  call bar2 (x, y, z);
+  !$omp end parallel
+
+  !$omp task private (x) firstprivate (z) allocate (omp_low_lat_mem_alloc:x,z)
+  call bar (0, x, z);
+  !$omp end task
+  
+  !$omp target teams distribute parallel do private (x) firstprivate (y) &
+  !$omp allocate ((omp_default_mem_alloc + 0):z) allocate &
+  !$omp (omp_default_mem_alloc: x, y) allocate (h: r) lastprivate (z) reduction(+:r)
+  do i = 1, 10
+    call bar (0, x, z);
+    call bar2 (1, y, r);
+  end do
+  !$omp end target teams distribute parallel do
+
+  !$omp single private (x) allocate (omp_low_lat_mem_alloc:x)
+  x=1
+  !$omp end single
+
+  !$omp single allocate (omp_low_lat_mem_alloc:x) private (x)
+  !$omp end single
+
+  !$omp parallel
+  !$omp do allocate (x) private (x)
+  do i = 1, 64
+    x = 1;
+  end do
+  !$omp end parallel
+
+  !$omp sections private (x) allocate (omp_low_lat_mem_alloc: x)
+    x = 1;
+    !$omp section
+    x = 2;
+    !$omp section
+    x = 3;
+  !$omp end sections
+
+  !$omp taskgroup task_reduction(+:r) allocate (omp_default_mem_alloc : r)
+  call bar (r, r, r);
+  !$omp end taskgroup
+
+  !$omp teams private (x) firstprivate (y) allocate (h : x, y)
+  call bar2 (x, y, r);
+  !$omp end teams
+
+  !$omp taskloop lastprivate (x) reduction (+:r) allocate (h : x, r)
+  do i = 1, 16
+    call bar (0, r, r);
+    x = i;
+  end do
+  !$omp end taskloop
+
+  !$omp taskgroup task_reduction(+:r) allocate (omp_default_mem_alloc : r)
+  !$omp taskloop firstprivate (x) in_reduction (+:r) &
+  !$omp allocate (omp_default_mem_alloc : x, r)
+  do i = 1, 16
+    call bar (x, r, r);
+  end do
+  !$omp end taskloop
+  !$omp end taskgroup
+  !$omp taskwait
+end subroutine
+
diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-2.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-2.f90
new file mode 100644 (file)
index 0000000..88b2d26
--- /dev/null
@@ -0,0 +1,45 @@
+! { dg-do compile }
+
+module omp_lib_kinds
+  use iso_c_binding, only: c_int, c_intptr_t
+  implicit none
+  private :: c_int, c_intptr_t
+  integer, parameter :: omp_allocator_handle_kind = c_intptr_t
+
+end module
+
+subroutine foo(x)
+  use omp_lib_kinds
+  implicit none
+  integer  :: x
+
+  !$omp task allocate (x) ! { dg-error "'x' specified in 'allocate' clause at .1. but not in an explicit privatization clause" }
+  x=1
+  !$omp end task
+
+  !$omp parallel allocate (x) ! { dg-error "'x' specified in 'allocate' clause at .1. but not in an explicit privatization clause" }
+  x=2
+  !$omp end parallel
+
+  !$omp parallel allocate (x) shared (x) ! { dg-error "'x' specified in 'allocate' clause at .1. but not in an explicit privatization clause" }
+  x=3
+  !$omp end parallel
+
+  !$omp parallel private (x) allocate (x) allocate (x) ! { dg-warning "'x' appears more than once in 'allocate' clauses at .1." }
+  x=4
+  !$omp end parallel
+
+  !$omp parallel private (x) allocate (x, x) ! { dg-warning "'x' appears more than once in 'allocate' clauses at .1." } 
+  x=5
+  !$omp end parallel
+
+  !$omp parallel allocate (0: x) private(x) ! { dg-error "Expected integer expression of the 'omp_allocator_handle_kind' kind at .1." }
+  x=6
+  !$omp end parallel
+  
+  !$omp parallel private (x) allocate (0.1 : x) ! { dg-error "Expected integer expression of the 'omp_allocator_handle_kind' kind at .1." }
+  x=7
+  !$omp end parallel
+
+end subroutine
+
diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-3.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-3.f90
new file mode 100644 (file)
index 0000000..7b57be9
--- /dev/null
@@ -0,0 +1,14 @@
+! { dg-do compile }
+
+subroutine foo(x)
+  implicit none
+  integer  :: x
+  integer  :: i
+
+  !$omp parallel do simd private (x) allocate (x) ! { dg-error "'x' specified in 'allocate' clause at .1. but not in an explicit privatization clause" }
+  do i = 1, 64
+    x = i
+  end do
+  !$omp end parallel do simd
+
+end subroutine
index 639f5d1..9280185 100644 (file)
@@ -36,8 +36,8 @@ subroutine foo (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd
   !$omp distribute parallel do &
   !$omp&  private (p) firstprivate (f) collapse(1) dist_schedule(static, 16) &
   !$omp&  if (parallel: i2) default(shared) shared(s) reduction(+:r) num_threads (nth) proc_bind(spread) &
-  !$omp&  lastprivate (l) schedule(static, 4) order(concurrent)
-  ! FIXME/TODO: allocate (omp_default_mem_alloc:f)
+  !$omp&  lastprivate (l) schedule(static, 4) order(concurrent) &
+  !$omp&  allocate (omp_default_mem_alloc:f)
   do i = 1, 64
     ll = ll +1
   end do
@@ -46,8 +46,8 @@ subroutine foo (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd
   !$omp&  private (p) firstprivate (f) collapse(1) dist_schedule(static, 16) &
   !$omp&  if (parallel: i2) if(simd: i1) default(shared) shared(s) reduction(+:r) num_threads (nth) proc_bind(spread) &
   !$omp&  lastprivate (l) schedule(static, 4) nontemporal(ntm) &
-  !$omp&  safelen(8) simdlen(4) aligned(q: 32) order(concurrent)
-  ! FIXME/TODO: allocate (omp_default_mem_alloc:f)
+  !$omp&  safelen(8) simdlen(4) aligned(q: 32) order(concurrent) &
+  !$omp&  allocate (omp_default_mem_alloc:f)
   do i = 1, 64
     ll = ll +1
   end do
@@ -55,8 +55,8 @@ subroutine foo (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd
   !$omp distribute simd &
   !$omp&  private (p) firstprivate (f) collapse(1) dist_schedule(static, 16) &
   !$omp&  safelen(8) simdlen(4) aligned(q: 32) reduction(+:r) if(i1) nontemporal(ntm) &
-  !$omp&  order(concurrent)
-  ! FIXME/TODO: allocate (omp_default_mem_alloc:f)
+  !$omp&  order(concurrent) &
+  !$omp&  allocate (omp_default_mem_alloc:f)
   do i = 1, 64
     ll = ll +1
   end do
@@ -81,8 +81,8 @@ subroutine baz (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd
   !$omp distribute parallel do &
   !$omp&  private (p) firstprivate (f) collapse(1) dist_schedule(static, 16) &
   !$omp&  if (parallel: i2) default(shared) shared(s) reduction(+:r) num_threads (nth) proc_bind(spread) &
-  !$omp&  lastprivate (l) schedule(static, 4) copyin(t)
-  ! FIXME/TODO: allocate (p)
+  !$omp&  lastprivate (l) schedule(static, 4) copyin(t) &
+  !$omp&  allocate (p)
   do i = 1, 64
     ll = ll +1
   end do
@@ -90,8 +90,8 @@ subroutine baz (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd
   !$omp distribute parallel do &
   !$omp&  private (p) firstprivate (f) collapse(1) dist_schedule(static, 16) &
   !$omp&  if (parallel: i2) default(shared) shared(s) reduction(+:r) num_threads (nth) proc_bind(spread) &
-  !$omp&  lastprivate (l) schedule(static, 4) order(concurrent)
-  ! FIXME/TODO: allocate (p)
+  !$omp&  lastprivate (l) schedule(static, 4) order(concurrent) &
+  !$omp&  allocate (p)
   do i = 1, 64
     ll = ll +1
   end do
@@ -100,8 +100,8 @@ subroutine baz (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd
   !$omp&  private (p) firstprivate (f) collapse(1) dist_schedule(static, 16) &
   !$omp&  if (parallel: i2) if(simd: i1) default(shared) shared(s) reduction(+:r) num_threads (nth) proc_bind(spread) &
   !$omp&  lastprivate (l) schedule(static, 4) nontemporal(ntm) &
-  !$omp&  safelen(8) simdlen(4) aligned(q: 32) copyin(t)
-  ! FIXME/TODO: allocate (f)
+  !$omp&  safelen(8) simdlen(4) aligned(q: 32) copyin(t) &
+  !$omp&  allocate (f)
   do i = 1, 64
     ll = ll + 1
   end do
@@ -110,8 +110,8 @@ subroutine baz (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd
   !$omp&  private (p) firstprivate (f) collapse(1) dist_schedule(static, 16) &
   !$omp&  if (parallel: i2) if(simd: i1) default(shared) shared(s) reduction(+:r) num_threads (nth) proc_bind(spread) &
   !$omp&  lastprivate (l) schedule(static, 4) nontemporal(ntm) &
-  !$omp&  safelen(8) simdlen(4) aligned(q: 32) order(concurrent)
-  ! FIXME/TODO: allocate (f)
+  !$omp&  safelen(8) simdlen(4) aligned(q: 32) order(concurrent) &
+  !$omp&  allocate (f)
   do i = 1, 64
     ll = ll + 1
   end do
@@ -119,8 +119,8 @@ subroutine baz (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd
   !$omp distribute simd &
   !$omp&  private (p) firstprivate (f) collapse(1) dist_schedule(static, 16) &
   !$omp&  safelen(8) simdlen(4) aligned(q: 32) reduction(+:r) if(i1) nontemporal(ntm) &
-  !$omp&  order(concurrent)
-  ! FIXME/TODO: allocate (f)
+  !$omp&  order(concurrent) &
+  !$omp&  allocate (f)
   do i = 1, 64
     ll = ll + 1
   end do
@@ -140,8 +140,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd
 
   !$omp do simd &
   !$omp&  private (p) firstprivate (f) lastprivate (l) linear (ll:1) reduction(+:r) schedule(static, 4) collapse(1) &
-  !$omp&  safelen(8) simdlen(4) aligned(q: 32) nontemporal(ntm) if(i1) order(concurrent)
-  ! FIXME/TODO: allocate (f)
+  !$omp&  safelen(8) simdlen(4) aligned(q: 32) nontemporal(ntm) if(i1) order(concurrent) &
+  !$omp&  allocate (f)
   do i = 1, 64
     ll = ll + 1
   end do
@@ -149,16 +149,16 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd
 
   !$omp parallel do &
   !$omp&  private (p) firstprivate (f) if (parallel: i2) default(shared) shared(s) copyin(t) reduction(+:r) num_threads (nth) &
-  !$omp&  proc_bind(spread) lastprivate (l) linear (ll:1) ordered schedule(static, 4) collapse(1)
-  ! FIXME/TODO: allocate (f)
+  !$omp&  proc_bind(spread) lastprivate (l) linear (ll:1) ordered schedule(static, 4) collapse(1) &
+  !$omp&  allocate (f)
   do i = 1, 64
     ll = ll + 1
   end do
 
   !$omp parallel do &
   !$omp&  private (p) firstprivate (f) if (parallel: i2) default(shared) shared(s) copyin(t) reduction(+:r) num_threads (nth) &
-  !$omp&  proc_bind(spread) lastprivate (l) linear (ll:1) schedule(static, 4) collapse(1) order(concurrent)
-  ! FIXME/TODO: allocate (f)
+  !$omp&  proc_bind(spread) lastprivate (l) linear (ll:1) schedule(static, 4) collapse(1) order(concurrent) &
+  !$omp&  allocate (f)
   do i = 1, 64
     ll = ll + 1
   end do
@@ -166,16 +166,16 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd
   !$omp parallel do simd &
   !$omp&  private (p) firstprivate (f) if (i2) default(shared) shared(s) copyin(t) reduction(+:r) num_threads (nth) &
   !$omp&  proc_bind(spread) lastprivate (l) linear (ll:1) schedule(static, 4) collapse(1) &
-  !$omp&  safelen(8) simdlen(4) aligned(q: 32) nontemporal(ntm) order(concurrent)
-  ! FIXME/TODO: allocate (f)
+  !$omp&  safelen(8) simdlen(4) aligned(q: 32) nontemporal(ntm) order(concurrent) &
+  !$omp&  allocate (f)
   do i = 1, 64
     ll = ll + 1
   end do
 
   !$omp parallel sections &
   !$omp&  private (p) firstprivate (f) if (parallel: i2) default(shared) shared(s) copyin(t) reduction(+:r) num_threads (nth) &
-  !$omp&  proc_bind(spread) lastprivate (l)
-  ! FIXME/TODO: allocate (f)
+  !$omp&  proc_bind(spread) lastprivate (l) &
+  !$omp&  allocate (f)
     !$omp section
       block; end block
     !$omp section
@@ -185,16 +185,16 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd
   !$omp target parallel &
   !$omp&  device(d) map (tofrom: m) if (target: i1) private (p) firstprivate (f) defaultmap(tofrom: scalar) is_device_ptr (idp) &
   !$omp&  if (parallel: i2) default(shared) shared(s) reduction(+:r) num_threads (nth) proc_bind(spread) &
-  !$omp&  depend(inout: dd(0)) in_reduction(+:r2)
-  ! FIXME/TODO: allocate (omp_default_mem_alloc:f)
+  !$omp&  depend(inout: dd(0)) in_reduction(+:r2) &
+  !$omp&  allocate (omp_default_mem_alloc:f)
   !$omp end target parallel nowait
 
   !$omp target parallel do &
   !$omp&  device(d) map (tofrom: m) if (target: i1) private (p) firstprivate (f) defaultmap(tofrom: scalar) is_device_ptr (idp) &
   !$omp&  if (parallel: i2) default(shared) shared(s) reduction(+:r) num_threads (nth) proc_bind(spread) &
   !$omp&  lastprivate (l) linear (ll:1) ordered schedule(static, 4) collapse(1) depend(inout: dd(0)) &
-  !$omp&  in_reduction(+:r2)
-  ! FIXME/TODO: allocate (omp_default_mem_alloc:f)
+  !$omp&  in_reduction(+:r2) &
+  !$omp&  allocate (omp_default_mem_alloc:f)
   do i = 1, 64
     ll = ll + 1
   end do
@@ -204,8 +204,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd
   !$omp&  device(d) map (tofrom: m) if (target: i1) private (p) firstprivate (f) defaultmap(tofrom: scalar) is_device_ptr (idp) &
   !$omp&  if (parallel: i2) default(shared) shared(s) reduction(+:r) num_threads (nth) proc_bind(spread) &
   !$omp&  lastprivate (l) linear (ll:1) schedule(static, 4) collapse(1) depend(inout: dd(0)) order(concurrent) &
-  !$omp&  in_reduction(+:r2)
-  ! FIXME/TODO: allocate (omp_default_mem_alloc:f)
+  !$omp&  in_reduction(+:r2) &
+  !$omp&  allocate (omp_default_mem_alloc:f)
   do i = 1, 64
     ll = ll + 1
   end do
@@ -216,8 +216,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd
   !$omp&  if (parallel: i2) default(shared) shared(s) reduction(+:r) num_threads (nth) proc_bind(spread) &
   !$omp&  lastprivate (l) linear (ll:1) schedule(static, 4) collapse(1) &
   !$omp&  safelen(8) simdlen(4) aligned(q: 32) depend(inout: dd(0)) nontemporal(ntm) if (simd: i3) order(concurrent) &
-  !$omp&  in_reduction(+:r2)
-  ! FIXME/TODO: allocate (omp_default_mem_alloc:f)
+  !$omp&  in_reduction(+:r2) &
+  !$omp&  allocate (omp_default_mem_alloc:f)
   do i = 1, 64
     ll = ll + 1
   end do
@@ -226,15 +226,15 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd
   !$omp target teams &
   !$omp&  device(d) map (tofrom: m) if (target: i1) private (p) firstprivate (f) defaultmap(tofrom: scalar) is_device_ptr (idp) &
   !$omp&  shared(s) default(shared) reduction(+:r) num_teams(nte - 1:nte) thread_limit(tl) depend(inout: dd(0)) &
-  !$omp&  in_reduction(+:r2)
-  ! FIXME/TODO: allocate (omp_default_mem_alloc:f)
+  !$omp&  in_reduction(+:r2) &
+  !$omp&  allocate (omp_default_mem_alloc:f)
   !$omp end target teams nowait
 
   !$omp target teams distribute &
   !$omp&  device(d) map (tofrom: m) if (target: i1) private (p) firstprivate (f) defaultmap(tofrom: scalar) is_device_ptr (idp) &
   !$omp&  shared(s) default(shared) reduction(+:r) num_teams(nte) thread_limit(tl) order(concurrent) &
-  !$omp&  collapse(1) dist_schedule(static, 16) depend(inout: dd(0)) in_reduction(+:r2)
-  ! FIXME/TODO: allocate (omp_default_mem_alloc:f)
+  !$omp&  collapse(1) dist_schedule(static, 16) depend(inout: dd(0)) in_reduction(+:r2) &
+  !$omp&  allocate (omp_default_mem_alloc:f)
   do i = 1, 64
   end do
   !$omp end target teams distribute nowait
@@ -245,8 +245,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd
   !$omp&  collapse(1) dist_schedule(static, 16) &
   !$omp&  if (parallel: i2) num_threads (nth) proc_bind(spread) &
   !$omp&  lastprivate (l) schedule(static, 4) depend(inout: dd(0)) order(concurrent) &
-  !$omp&  in_reduction(+:r2)
-  ! FIXME/TODO: allocate (omp_default_mem_alloc:f)
+  !$omp&  in_reduction(+:r2) &
+  !$omp&  allocate (omp_default_mem_alloc:f)
   do i = 1, 64
     ll = ll + 1
   end do
@@ -259,8 +259,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd
   !$omp&  if (parallel: i2) num_threads (nth) proc_bind(spread) &
   !$omp&  lastprivate (l) schedule(static, 4) order(concurrent) &
   !$omp&  safelen(8) simdlen(4) aligned(q: 32) depend(inout: dd(0)) nontemporal(ntm) if (simd: i3) &
-  !$omp&  in_reduction(+:r2)
-  ! FIXME/TODO: allocate (omp_default_mem_alloc:f)
+  !$omp&  in_reduction(+:r2) &
+  !$omp&  allocate (omp_default_mem_alloc:f)
   do i = 1, 64
     ll = ll + 1
   end do
@@ -271,8 +271,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd
   !$omp&  shared(s) default(shared) reduction(+:r) num_teams(nte-1:nte) thread_limit(tl) &
   !$omp&  collapse(1) dist_schedule(static, 16) order(concurrent) &
   !$omp&  safelen(8) simdlen(4) aligned(q: 32) depend(inout: dd(0)) nontemporal(ntm) &
-  !$omp&  in_reduction(+:r2)
-  ! FIXME/TODO: allocate (omp_default_mem_alloc:f)
+  !$omp&  in_reduction(+:r2) &
+  !$omp&  allocate (omp_default_mem_alloc:f)
   do i = 1, 64
     ll = ll + 1
   end do
@@ -282,34 +282,34 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd
   !$omp&  device(d) map (tofrom: m) if (target: i1) private (p) firstprivate (f) defaultmap(tofrom: scalar) is_device_ptr (idp) &
   !$omp&  safelen(8) simdlen(4) lastprivate (l) linear(ll: 1) aligned(q: 32) reduction(+:r) &
   !$omp&  depend(inout: dd(0)) nontemporal(ntm) if(simd:i3) order(concurrent) &
-  !$omp&  in_reduction(+:r2)
-  ! FIXME/TODO: allocate (omp_default_mem_alloc:f)
+  !$omp&  in_reduction(+:r2) &
+  !$omp&  allocate (omp_default_mem_alloc:f)
   do i = 1, 64
     ll = ll + 1
   end do
   !$omp end target simd nowait
 
-  !$omp taskgroup task_reduction(+:r2)
-  ! FIXME/TODO: allocate (r2)
+  !$omp taskgroup task_reduction(+:r2) &
+  !$omp&  allocate (r2)
   !$omp taskloop simd &
   !$omp&  private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) grainsize (g) collapse(1) untied &
   !$omp&  if(taskloop: i1) if(simd: i2) final(fi) mergeable priority (pp) &
   !$omp&  safelen(8) simdlen(4) linear(ll: 1) aligned(q: 32) reduction(default, +:r) in_reduction(+:r2) nontemporal(ntm) &
-  !$omp&  order(concurrent)
-  ! FIXME/TODO: allocate (f)
+  !$omp&  order(concurrent) &
+  !$omp&  allocate (f)
   do i = 1, 64
     ll = ll + 1
   end do
   !$omp end taskgroup
 
-  !$omp taskgroup task_reduction(+:r)
-  ! FIXME/TODO: allocate (r)
+  !$omp taskgroup task_reduction(+:r) &
+  !$omp&  allocate (r)
   !$omp taskloop simd &
   !$omp&  private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) grainsize (g) collapse(1) untied if(i1) &
   !$omp&  final(fi) mergeable nogroup priority (pp) &
   !$omp&  safelen(8) simdlen(4) linear(ll: 1) aligned(q: 32) in_reduction(+:r) nontemporal(ntm) &
-  !$omp&  order(concurrent)
-  ! FIXME/TODO: allocate (f)
+  !$omp&  order(concurrent) &
+  !$omp&  allocate (f)
   do i = 1, 64
     ll = ll + 1
   end do
@@ -319,8 +319,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd
   !$omp taskloop simd &
   !$omp&  private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) num_tasks (nta) collapse(1) if(taskloop: i1) &
   !$omp&  final(fi) priority (pp) safelen(8) simdlen(4) linear(ll: 1) aligned(q: 32) reduction(+:r) if (simd: i3) nontemporal(ntm) &
-  !$omp&  order(concurrent)
-  ! FIXME/TODO: allocate (f)
+  !$omp&  order(concurrent) &
+  !$omp&  allocate (f)
   do i = 1, 64
     ll = ll + 1
   end do
@@ -328,8 +328,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd
   !$omp target depend(inout: dd(0)) in_reduction(+:r2)
   !$omp teams distribute &
   !$omp&  private(p) firstprivate (f) shared(s) default(shared) reduction(+:r) num_teams(nte) thread_limit(tl) &
-  !$omp&  collapse(1) dist_schedule(static, 16) order(concurrent)
-  ! FIXME/TODO: allocate (omp_default_mem_alloc: f)
+  !$omp&  collapse(1) dist_schedule(static, 16) order(concurrent) &
+  !$omp&  allocate (omp_default_mem_alloc: f)
   do i = 1, 64
   end do
   !$omp end target nowait
@@ -339,8 +339,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd
   !$omp&  private(p) firstprivate (f) shared(s) default(shared) reduction(+:r) num_teams(nte-1:nte) thread_limit(tl) &
   !$omp&  collapse(1) dist_schedule(static, 16) &
   !$omp&  if (parallel: i2) num_threads (nth) proc_bind(spread) &
-  !$omp&  lastprivate (l) schedule(static, 4) order(concurrent)
-  ! FIXME/TODO: allocate (omp_default_mem_alloc: f)
+  !$omp&  lastprivate (l) schedule(static, 4) order(concurrent) &
+  !$omp&  allocate (omp_default_mem_alloc: f)
   do i = 1, 64
     ll = ll +1
   end do
@@ -352,8 +352,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd
   !$omp&  collapse(1) dist_schedule(static, 16) &
   !$omp&  if (parallel: i2) num_threads (nth) proc_bind(spread) &
   !$omp&  lastprivate (l) schedule(static, 4) order(concurrent) &
-  !$omp&  safelen(8) simdlen(4) aligned(q: 32) if (simd: i3) nontemporal(ntm)
-  ! FIXME/TODO: allocate (omp_default_mem_alloc: f)
+  !$omp&  safelen(8) simdlen(4) aligned(q: 32) if (simd: i3) nontemporal(ntm) &
+  !$omp&  allocate (omp_default_mem_alloc: f)
   do i = 1, 64
     ll = ll +1
   end do
@@ -363,8 +363,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd
   !$omp teams distribute simd &
   !$omp&  private(p) firstprivate (f) shared(s) default(shared) reduction(+:r) num_teams(nte-1:nte) thread_limit(tl) &
   !$omp&  collapse(1) dist_schedule(static, 16) order(concurrent) &
-  !$omp&  safelen(8) simdlen(4) aligned(q: 32) if(i3) nontemporal(ntm)
-  ! FIXME/TODO: allocate (omp_default_mem_alloc: f)
+  !$omp&  safelen(8) simdlen(4) aligned(q: 32) if(i3) nontemporal(ntm) &
+  !$omp&  allocate (omp_default_mem_alloc: f)
   do i = 1, 64
     ll = ll +1
   end do
@@ -374,8 +374,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd
   !$omp&  private(p) firstprivate (f) shared(s) default(shared) reduction(+:r) num_teams(nte) thread_limit(tl) &
   !$omp&  collapse(1) dist_schedule(static, 16) &
   !$omp&  if (parallel: i2) num_threads (nth) proc_bind(spread) &
-  !$omp&  lastprivate (l) schedule(static, 4) copyin(t)
-  ! FIXME/TODO: allocate (f)
+  !$omp&  lastprivate (l) schedule(static, 4) copyin(t) &
+  !$omp&  allocate (f)
   do i = 1, 64
     ll = ll +1
   end do
@@ -384,8 +384,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd
   !$omp&  private(p) firstprivate (f) shared(s) default(shared) reduction(+:r) num_teams(nte-1:nte) thread_limit(tl) &
   !$omp&  collapse(1) dist_schedule(static, 16) order(concurrent) &
   !$omp&  if (parallel: i2) num_threads (nth) proc_bind(spread) &
-  !$omp&  lastprivate (l) schedule(static, 4)
-  ! FIXME/TODO: allocate (f)
+  !$omp&  lastprivate (l) schedule(static, 4) &
+  !$omp&  allocate (f)
   do i = 1, 64
     ll = ll +1
   end do
@@ -395,8 +395,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd
   !$omp&  collapse(1) dist_schedule(static, 16) &
   !$omp&  if (parallel: i2) num_threads (nth) proc_bind(spread) &
   !$omp&  lastprivate (l) schedule(static, 4) &
-  !$omp&  safelen(8) simdlen(4) aligned(q: 32) if (simd: i3) nontemporal(ntm) copyin(t)
-  ! FIXME/TODO: allocate (f)
+  !$omp&  safelen(8) simdlen(4) aligned(q: 32) if (simd: i3) nontemporal(ntm) copyin(t) &
+  !$omp&  allocate (f)
   do i = 1, 64
     ll = ll +1
   end do
@@ -406,8 +406,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd
   !$omp&  collapse(1) dist_schedule(static, 16) &
   !$omp&  if (parallel: i2) num_threads (nth) proc_bind(spread) &
   !$omp&  lastprivate (l) schedule(static, 4) order(concurrent) &
-  !$omp&  safelen(8) simdlen(4) aligned(q: 32) if (simd: i3) nontemporal(ntm)
-  ! FIXME/TODO: allocate (f)
+  !$omp&  safelen(8) simdlen(4) aligned(q: 32) if (simd: i3) nontemporal(ntm) &
+  !$omp&  allocate (f)
   do i = 1, 64
     ll = ll +1
   end do
@@ -415,68 +415,68 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd
   !$omp teams distribute simd &
   !$omp&  private(p) firstprivate (f) shared(s) default(shared) reduction(+:r) num_teams(nte) thread_limit(tl) &
   !$omp&  collapse(1) dist_schedule(static, 16) order(concurrent) &
-  !$omp&  safelen(8) simdlen(4) aligned(q: 32) if(i3) nontemporal(ntm)
-  ! FIXME/TODO: allocate(f)
+  !$omp&  safelen(8) simdlen(4) aligned(q: 32) if(i3) nontemporal(ntm) &
+  !$omp&  allocate(f)
   do i = 1, 64
     ll = ll +1
   end do
 
   !$omp parallel master &
   !$omp&  private (p) firstprivate (f) if (parallel: i2) default(shared) shared(s) reduction(+:r) &
-  !$omp&  num_threads (nth) proc_bind(spread) copyin(t)
-  ! FIXME/TODO: allocate (f)
+  !$omp&  num_threads (nth) proc_bind(spread) copyin(t) &
+  !$omp&  allocate (f)
   !$omp end parallel master
 
   !$omp parallel masked &
   !$omp&  private (p) firstprivate (f) if (parallel: i2) default(shared) shared(s) reduction(+:r) &
-  !$omp&  num_threads (nth) proc_bind(spread) copyin(t) filter (d)
-  ! FIXME/TODO: allocate (f)
+  !$omp&  num_threads (nth) proc_bind(spread) copyin(t) filter (d) &
+  !$omp&  allocate (f)
   !$omp end parallel masked
 
-  !$omp taskgroup task_reduction (+:r2)
-  ! FIXME/TODO: allocate (r2)
+  !$omp taskgroup task_reduction (+:r2) &
+  !$omp&  allocate (r2)
   !$omp master taskloop &
   !$omp&  private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) grainsize (g) collapse(1) untied &
   !$omp&  if(taskloop: i1) final(fi) mergeable priority (pp) &
-  !$omp&  reduction(default, +:r) in_reduction(+:r2)
-  ! FIXME/TODO: allocate (f)
+  !$omp&  reduction(default, +:r) in_reduction(+:r2) &
+  !$omp&  allocate (f)
   do i = 1, 64
     ll = ll +1
   end do
   !$omp end taskgroup
 
-  !$omp taskgroup task_reduction (+:r2)
-  ! FIXME/TODO: allocate (r2)
+  !$omp taskgroup task_reduction (+:r2) &
+  !$omp&  allocate (r2)
   !$omp masked taskloop &
   !$omp&  private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) grainsize (g) collapse(1) untied &
-  !$omp&  if(taskloop: i1) final(fi) mergeable priority (pp) reduction(default, +:r) in_reduction(+:r2) filter (d)
-  ! FIXME/TODO: allocate (f)
+  !$omp&  if(taskloop: i1) final(fi) mergeable priority (pp) reduction(default, +:r) in_reduction(+:r2) filter (d) &
+  !$omp&  allocate (f)
   do i = 1, 64
     ll = ll +1
   end do
   !$omp end taskgroup
 
-  !$omp taskgroup task_reduction (+:r2)
-  ! FIXME/TODO: allocate (r2)
+  !$omp taskgroup task_reduction (+:r2) &
+  !$omp&  allocate (r2)
   !$omp master taskloop simd &
   !$omp&  private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) grainsize (g) collapse(1) untied &
   !$omp&  if(taskloop: i1) if(simd: i2) final(fi) mergeable priority (pp) &
   !$omp&  safelen(8) simdlen(4) linear(ll: 1) aligned(q: 32) reduction(default, +:r) in_reduction(+:r2) nontemporal(ntm) &
-  !$omp&  order(concurrent)
-  ! FIXME/TODO: allocate (f)
+  !$omp&  order(concurrent) &
+  !$omp&  allocate (f)
   do i = 1, 64
     ll = ll +1
   end do
   !$omp end taskgroup
 
-  !$omp taskgroup task_reduction (+:r2)
-  ! FIXME/TODO: allocate (r2)
+  !$omp taskgroup task_reduction (+:r2) &
+  !$omp&  allocate (r2)
   !$omp masked taskloop simd &
   !$omp&  private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) grainsize (g) collapse(1) untied &
   !$omp&  if(taskloop: i1) if(simd: i2) final(fi) mergeable priority (pp) &
   !$omp&  safelen(8) simdlen(4) linear(ll: 1) aligned(q: 32) reduction(default, +:r) in_reduction(+:r2) nontemporal(ntm) &
-  !$omp&  order(concurrent) filter (d)
-  ! FIXME/TODO: allocate (f)
+  !$omp&  order(concurrent) filter (d) &
+  !$omp&  allocate (f)
   do i = 1, 64
     ll = ll +1
   end do
@@ -485,8 +485,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd
   !$omp parallel master taskloop &
   !$omp&  private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) grainsize (g) collapse(1) untied &
   !$omp&  if(taskloop: i1) final(fi) mergeable priority (pp) &
-  !$omp&  reduction(default, +:r) if (parallel: i2) num_threads (nth) proc_bind(spread) copyin(t)
-  ! FIXME/TODO: allocate (f)
+  !$omp&  reduction(default, +:r) if (parallel: i2) num_threads (nth) proc_bind(spread) copyin(t) &
+  !$omp&  allocate (f)
   do i = 1, 64
     ll = ll +1
   end do
@@ -494,8 +494,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd
   !$omp parallel masked taskloop &
   !$omp&  private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) grainsize (g) collapse(1) untied &
   !$omp&  if(taskloop: i1) final(fi) mergeable priority (pp) &
-  !$omp&  reduction(default, +:r) if (parallel: i2) num_threads (nth) proc_bind(spread) copyin(t) filter (d)
-  ! FIXME/TODO: allocate (f)
+  !$omp&  reduction(default, +:r) if (parallel: i2) num_threads (nth) proc_bind(spread) copyin(t) filter (d) &
+  !$omp&  allocate (f)
   do i = 1, 64
     ll = ll +1
   end do
@@ -504,8 +504,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd
   !$omp&  private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) grainsize (g) collapse(1) untied &
   !$omp&  if(taskloop: i1) if(simd: i2) final(fi) mergeable priority (pp) &
   !$omp&  safelen(8) simdlen(4) linear(ll: 1) aligned(q: 32) reduction(default, +:r) nontemporal(ntm) if (parallel: i2) &
-  !$omp&  num_threads (nth) proc_bind(spread) copyin(t) order(concurrent)
-  ! FIXME/TODO: allocate (f)
+  !$omp&  num_threads (nth) proc_bind(spread) copyin(t) order(concurrent) &
+  !$omp&  allocate (f)
   do i = 1, 64
     ll = ll +1
   end do
@@ -514,14 +514,14 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd
   !$omp&  private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) grainsize (g) collapse(1) untied &
   !$omp&  if(taskloop: i1) if(simd: i2) final(fi) mergeable priority (pp) &
   !$omp&  safelen(8) simdlen(4) linear(ll: 1) aligned(q: 32) reduction(default, +:r) nontemporal(ntm) if (parallel: i2) &
-  !$omp&  num_threads (nth) proc_bind(spread) copyin(t) order(concurrent) filter (d)
-  ! FIXME/TODO: allocate (f)
+  !$omp&  num_threads (nth) proc_bind(spread) copyin(t) order(concurrent) filter (d) &
+  !$omp&  allocate (f)
   do i = 1, 64
     ll = ll +1
   end do
 
-  !$omp taskgroup task_reduction (+:r2)
-  ! FIXME/TODO: allocate (r2)
+  !$omp taskgroup task_reduction (+:r2) &
+  !$omp&  allocate (r2)
   !$omp master taskloop &
   !$omp&  private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) num_tasks (nta) collapse(1) &
   !$omp&  untied if(i1) final(fi) mergeable priority (pp) reduction(default, +:r) in_reduction(+:r2)
@@ -530,8 +530,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd
   end do
   !$omp end taskgroup
 
-  !$omp taskgroup task_reduction (+:r2)
-  ! FIXME/TODO: allocate (r2)
+  !$omp taskgroup task_reduction (+:r2) &
+  !$omp&  allocate (r2)
   !$omp masked taskloop &
   !$omp&  private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) num_tasks (nta) collapse(1) &
   !$omp&  untied if(i1) final(fi) mergeable priority (pp) reduction(default, +:r) in_reduction(+:r2) filter (d)
@@ -540,25 +540,25 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd
   end do
   !$omp end taskgroup
 
-  !$omp taskgroup task_reduction (+:r2)
-  ! FIXME/TODO: allocate (r2)
+  !$omp taskgroup task_reduction (+:r2) &
+  !$omp&  allocate (r2)
   !$omp master taskloop simd &
   !$omp&  private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) num_tasks (nta) collapse(1) untied if(i1) &
   !$omp&  final(fi) mergeable priority (pp) safelen(8) simdlen(4) linear(ll: 1) aligned(q: 32) reduction(default, +:r) &
-  !$omp&  in_reduction(+:r2) nontemporal(ntm) order(concurrent)
-  ! FIXME/TODO: allocate (f)
+  !$omp&  in_reduction(+:r2) nontemporal(ntm) order(concurrent) &
+  !$omp&  allocate (f)
   do i = 1, 64
     ll = ll +1
   end do
   !$omp end taskgroup
 
-  !$omp taskgroup task_reduction (+:r2)
-  ! FIXME/TODO: allocate (r2)
+  !$omp taskgroup task_reduction (+:r2) &
+  !$omp&  allocate (r2)
   !$omp masked taskloop simd &
   !$omp&  private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) num_tasks (nta) collapse(1) untied &
   !$omp&  if(i1) final(fi) mergeable priority (pp) safelen(8) simdlen(4) linear(ll: 1) aligned(q: 32) reduction(default, +:r) &
-  !$omp&  in_reduction(+:r2) nontemporal(ntm) order(concurrent) filter (d)
-  ! FIXME/TODO: allocate (f)
+  !$omp&  in_reduction(+:r2) nontemporal(ntm) order(concurrent) filter (d) &
+  !$omp&  allocate (f)
   do i = 1, 64
     ll = ll +1
   end do
@@ -566,8 +566,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd
 
   !$omp parallel master taskloop &
   !$omp&  private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) num_tasks (nta) collapse(1) untied &
-  !$omp&  if(i1) final(fi) mergeable priority (pp) reduction(default, +:r) num_threads (nth) proc_bind(spread) copyin(t)
-  ! FIXME/TODO: allocate (f)
+  !$omp&  if(i1) final(fi) mergeable priority (pp) reduction(default, +:r) num_threads (nth) proc_bind(spread) copyin(t) &
+  !$omp&  allocate (f)
   do i = 1, 64
     ll = ll +1
   end do
@@ -575,8 +575,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd
   !$omp parallel masked taskloop &
   !$omp&  private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) num_tasks (nta) collapse(1) untied &
   !$omp&  if(i1) final(fi) mergeable priority (pp) reduction(default, +:r) num_threads (nth) proc_bind(spread) &
-  !$omp&  copyin(t) filter (d)
-  ! FIXME/TODO: allocate (f)
+  !$omp&  copyin(t) filter (d) &
+  !$omp&  allocate (f)
   do i = 1, 64
     ll = ll +1
   end do
@@ -584,8 +584,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd
   !$omp parallel master taskloop simd &
   !$omp&  private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) num_tasks (nta) collapse(1) untied &
   !$omp&  if(i1) final(fi) mergeable priority (pp) safelen(8) simdlen(4) linear(ll: 1) aligned(q: 32) reduction(default, +:r) &
-  !$omp&  nontemporal(ntm) num_threads (nth) proc_bind(spread)copyin(t) order(concurrent)
-  ! FIXME/TODO: allocate (f)
+  !$omp&  nontemporal(ntm) num_threads (nth) proc_bind(spread)copyin(t) order(concurrent) &
+  !$omp&  allocate (f)
   do i = 1, 64
     ll = ll +1
   end do
@@ -593,8 +593,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd
   !$omp parallel masked taskloop simd &
   !$omp&  private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) num_tasks (nta) collapse(1) untied if(i1) &
   !$omp&  final(fi) mergeable priority (pp) safelen(8) simdlen(4) linear(ll: 1) aligned(q: 32) reduction(default, +:r) &
-  !$omp&  nontemporal(ntm) num_threads (nth) proc_bind(spread) copyin(t) order(concurrent) filter (d)
-  ! FIXME/TODO: allocate (f)
+  !$omp&  nontemporal(ntm) num_threads (nth) proc_bind(spread) copyin(t) order(concurrent) filter (d) &
+  !$omp&  allocate (f)
   do i = 1, 64
     ll = ll +1
   end do
@@ -607,31 +607,31 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd
 
   !$omp parallel loop &
   !$omp&  private (p) firstprivate (f) default(shared) shared(s) copyin(t) reduction(+:r) num_threads (nth) &
-  !$omp&  proc_bind(spread) lastprivate (l) collapse(1) bind(parallel) order(concurrent) if (parallel: i2)
-  ! FIXME/TODO: allocate (f)
+  !$omp&  proc_bind(spread) lastprivate (l) collapse(1) bind(parallel) order(concurrent) if (parallel: i2) &
+  !$omp&  allocate (f)
   do l = 1, 64
     ll = ll + 1
   end do
 
   !$omp parallel loop &
   !$omp&  private (p) firstprivate (f) default(shared) shared(s) copyin(t) reduction(+:r) num_threads (nth) &
-  !$omp&  proc_bind(spread) lastprivate (l) collapse(1) if (parallel: i2)
-  ! FIXME/TODO: allocate (f)
+  !$omp&  proc_bind(spread) lastprivate (l) collapse(1) if (parallel: i2) &
+  !$omp&  allocate (f)
   do l = 1, 64
     ll = ll + 1
   end do
 
   !$omp teams loop &
   !$omp&  private(p) firstprivate (f) shared(s) default(shared) reduction(+:r) num_teams(nte-1:nte) thread_limit(tl) &
-  !$omp&  collapse(1) lastprivate (l) bind(teams)
-  ! FIXME/TODO: allocate (f)
+  !$omp&  collapse(1) lastprivate (l) bind(teams) &
+  !$omp&  allocate (f)
   do l = 1, 64
   end do
 
   !$omp teams loop &
   !$omp&  private(p) firstprivate (f) shared(s) default(shared) reduction(+:r) num_teams(nte) thread_limit(tl) &
-  !$omp&  collapse(1) lastprivate (l) order(concurrent)
-  ! FIXME/TODO: allocate (f)
+  !$omp&  collapse(1) lastprivate (l) order(concurrent) &
+  !$omp&  allocate (f)
   do l = 1, 64
   end do
 
@@ -639,8 +639,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd
   !$omp&  device(d) map (tofrom: m) private (p) firstprivate (f) defaultmap(tofrom: scalar) is_device_ptr (idp) &
   !$omp&  default(shared) shared(s) reduction(+:r) num_threads (nth) proc_bind(spread) &
   !$omp&  depend(inout: dd(0)) lastprivate (l) order(concurrent) collapse(1) in_reduction(+:r2) &
-  !$omp&  if (target: i1) if (parallel: i2)
-  ! FIXME/TODO: allocate (omp_default_mem_alloc: f)
+  !$omp&  if (target: i1) if (parallel: i2) &
+  !$omp&  allocate (omp_default_mem_alloc: f)
   do l = 1, 64
   end do
   !$omp end target parallel loop nowait
@@ -648,8 +648,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd
   !$omp target teams loop &
   !$omp&  device(d) map (tofrom: m) private (p) firstprivate (f) defaultmap(tofrom: scalar) is_device_ptr (idp) &
   !$omp&  shared(s) default(shared) reduction(+:r) num_teams(nte-1:nte) thread_limit(tl) depend(inout: dd(0)) &
-  !$omp&  lastprivate (l) bind(teams) collapse(1) in_reduction(+:r2) if (target: i1)
-  ! FIXME/TODO: allocate (omp_default_mem_alloc: f)
+  !$omp&  lastprivate (l) bind(teams) collapse(1) in_reduction(+:r2) if (target: i1) &
+  !$omp&  allocate (omp_default_mem_alloc: f)
   do l = 1, 64
   end do
   !$omp end target teams loop nowait
@@ -657,8 +657,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd
   !$omp target teams loop &
   !$omp&  device(d) map (tofrom: m) private (p) firstprivate (f) defaultmap(tofrom: scalar) is_device_ptr (idp) &
   !$omp&  shared(s) default(shared) reduction(+:r) num_teams(nte) thread_limit(tl) depend(inout: dd(0)) &
-  !$omp&  lastprivate (l) order(concurrent) collapse(1) in_reduction(+:r2) if (target: i1)
-  ! FIXME/TODO: allocate (omp_default_mem_alloc: f)
+  !$omp&  lastprivate (l) order(concurrent) collapse(1) in_reduction(+:r2) if (target: i1) &
+  !$omp&  allocate (omp_default_mem_alloc: f)
   do l = 1, 64
   end do
   !$omp end target teams loop nowait
index 1a06eab..01cfc82 100644 (file)
@@ -24,7 +24,7 @@ subroutine collapse1
     end do
   !$omp parallel do collapse(2) shared(j)
     do i = 1, 3
-      do j = 4, 6              ! { dg-error "iteration variable present on clause other than PRIVATE or LASTPRIVATE" }
+      do j = 4, 6              ! { dg-error "iteration variable present on clause other than PRIVATE, LASTPRIVATE or ALLOCATE" }
       end do
     end do
   !$omp parallel do collapse(2)
index 4a17fb9..17375e0 100644 (file)
@@ -45,17 +45,17 @@ do i = 1, 5
 end do
 
 !$omp parallel do firstprivate(i)
-do i = 1, 5  ! { dg-error "PARALLEL DO iteration variable present on clause other than PRIVATE or LASTPRIVATE" }
+do i = 1, 5  ! { dg-error "PARALLEL DO iteration variable present on clause other than PRIVATE, LASTPRIVATE or ALLOCATE" }
   x(i) = 42
 end do
 
 !$omp parallel do simd firstprivate(i)
-do i = 1, 5  ! { dg-error "PARALLEL DO SIMD iteration variable present on clause other than PRIVATE, LASTPRIVATE or LINEAR" }
+do i = 1, 5  ! { dg-error "PARALLEL DO SIMD iteration variable present on clause other than PRIVATE, LASTPRIVATE, ALLOCATE or LINEAR" }
   x(i) = 42
 end do
 
 !$omp simd linear(i) collapse(2)
-do i = 1, 5  ! { dg-error "SIMD iteration variable present on clause other than PRIVATE or LASTPRIVATE" }
+do i = 1, 5  ! { dg-error "SIMD iteration variable present on clause other than PRIVATE, LASTPRIVATE or ALLOCATE" }
   do j = 1, 2
     y(j, i) = 52
   end do
index e07a66d..3be9de5 100644 (file)
@@ -219,7 +219,7 @@ The OpenMP 4.5 specification is fully supported.
       @tab Y @tab Some are only stubs
 @item Memory management routines @tab Y @tab
 @item @code{allocate} directive @tab N @tab
-@item @code{allocate} clause @tab P @tab initial support in C/C++ only
+@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 P @tab Reverse offload unsupported
diff --git a/libgomp/testsuite/libgomp.fortran/allocate-1.c b/libgomp/testsuite/libgomp.fortran/allocate-1.c
new file mode 100644 (file)
index 0000000..d33acc6
--- /dev/null
@@ -0,0 +1,7 @@
+#include <stdint.h>
+
+int
+is_64bit_aligned_ (uintptr_t a)
+{
+  return ( (a & 0x3f) == 0);
+}
diff --git a/libgomp/testsuite/libgomp.fortran/allocate-1.f90 b/libgomp/testsuite/libgomp.fortran/allocate-1.f90
new file mode 100644 (file)
index 0000000..35d1750
--- /dev/null
@@ -0,0 +1,333 @@
+! { dg-do run }
+! { dg-additional-sources allocate-1.c }
+! { dg-prune-output "command-line option '-fintrinsic-modules-path=.*' is valid for Fortran but not for C" }
+
+module m
+  use omp_lib
+  use iso_c_binding
+  implicit none
+
+  interface
+    integer(c_int) function is_64bit_aligned (a) bind(C)
+      import :: c_int
+      integer  :: a
+    end
+  end interface
+end module m
+
+subroutine foo (x, p, q, px, h, fl)
+  use omp_lib
+  use iso_c_binding
+  integer  :: x
+  integer, dimension(4) :: p
+  integer, dimension(4) :: q
+  integer  :: px
+  integer (kind=omp_allocator_handle_kind) :: h
+  integer  :: fl
+
+  integer  :: y
+  integer  :: r, i, i1, i2, i3, i4, i5
+  integer  :: l, l3, l4, l5, l6
+  integer  :: n, n1, n2, n3, n4
+  integer  :: j2, j3, j4
+  integer, dimension(4) :: l2
+  integer, dimension(4) :: r2
+  integer, target  :: xo
+  integer, target  :: yo
+  integer, dimension(x) :: v
+  integer, dimension(x) :: w
+
+  type s_type
+    integer      :: a
+    integer      :: b
+  end type
+
+  type (s_type) :: s
+  s%a = 27
+  s%b = 29
+  y = 0
+  r = 0
+  n = 8
+  n2 = 9
+  n3 = 10
+  n4 = 11
+  xo = x
+  yo = y
+
+  do i = 1, 4
+    r2(i) = 0;
+  end do
+
+  do i = 1, 4
+    p(i) = 0;
+  end do
+
+  do i = 1, 4
+    q(i) = 0;
+  end do
+
+  do i = 1, x
+    w(i) = i
+  end do
+
+  !$omp parallel private (y, v) firstprivate (x) allocate (x, y, v)
+  if (x /= 42) then
+    stop 1
+  end if
+  v(1) = 7
+  if ( (and(fl, 2) /= 0) .and.          &
+       ((is_64bit_aligned(x) == 0) .or. &
+        (is_64bit_aligned(y) == 0) .or. &
+        (is_64bit_aligned(v(1)) == 0))) then
+      stop 2
+  end if
+
+  !$omp barrier
+  y = 1;
+  x = x + 1
+  v(1) = 7
+  v(41) = 8
+  !$omp barrier
+  if (x /= 43 .or. y /= 1) then
+    stop 3
+  end if
+  if (v(1) /= 7 .or. v(41) /= 8) then
+    stop 4
+  end if
+  !$omp end parallel
+
+  !$omp teams
+  !$omp parallel private (y) firstprivate (x, w) allocate (h: x, y, w)
+
+  if (x /= 42 .or. w(17) /= 17 .or. w(41) /= 41) then
+    stop 5
+  end if
+  !$omp barrier
+  y = 1;
+  x = x + 1
+  w(19) = w(19) + 1
+  !$omp barrier
+  if (x /= 43 .or. y /= 1 .or. w(19) /= 20) then
+    stop 6
+  end if
+  if ( (and(fl, 1) /= 0) .and.          &
+       ((is_64bit_aligned(x) == 0) .or. &
+        (is_64bit_aligned(y) == 0) .or. &
+        (is_64bit_aligned(w(1)) == 0))) then
+    stop 7
+  end if
+  !$omp end parallel
+  !$omp end teams
+
+  !$omp parallel do private (y) firstprivate (x)  reduction(+: r) allocate (h: x, y, r, l, n) lastprivate (l)  linear (n: 16)
+  do i = 0, 63
+    if (x /= 42) then
+      stop 8
+    end if
+    y = 1;
+    l = i;
+    n = n + y + 15;
+    r = r + i;
+    if ( (and(fl, 1) /= 0) .and.          &
+         ((is_64bit_aligned(x) == 0) .or. &
+          (is_64bit_aligned(y) == 0) .or. &
+          (is_64bit_aligned(r) == 0) .or. &
+          (is_64bit_aligned(l) == 0) .or. &
+          (is_64bit_aligned(n) == 0))) then
+      stop 9
+    end if
+  end do
+  !$omp end parallel do
+
+  !$omp parallel
+    !$omp do lastprivate (l2) private (i1) allocate (h: l2, l3, i1) lastprivate (conditional: l3)
+    do i1 = 0, 63
+      l2(1) = i1
+      l2(2) = i1 + 1
+      l2(3) = i1 + 2
+      l2(4) = i1 + 3
+      if (i1 < 37) then
+        l3 = i1
+      end if
+      if ( (and(fl, 1) /= 0) .and.          &
+           ((is_64bit_aligned(l2(1)) == 0) .or. &
+            (is_64bit_aligned(l3) == 0) .or. &
+            (is_64bit_aligned(i1) == 0))) then
+       stop 10
+      end if
+    end do
+
+    !$omp do collapse(2) lastprivate(l4, i2, j2) linear (n2:17) allocate (h: n2, l4, i2, j2)
+    do i2 = 3, 4
+      do j2 = 17, 22, 2
+       n2 = n2 + 17
+       l4 = i2 * 31 + j2
+       if ( (and(fl, 1) /= 0) .and.          &
+         ((is_64bit_aligned(l4) == 0) .or. &
+         (is_64bit_aligned(n2) == 0) .or. &
+         (is_64bit_aligned(i2) == 0) .or. &
+         (is_64bit_aligned(j2) == 0))) then
+         stop 11
+       end if
+      end do
+    end do
+
+    !$omp do collapse(2) lastprivate(l5, i3, j3) linear (n3:17) schedule (static, 3) allocate (n3, l5, i3, j3)
+    do i3 = 3, 4
+      do j3 = 17, 22, 2
+         n3 = n3 + 17
+         l5 = i3 * 31 + j3
+         if ( (and(fl, 2) /= 0) .and.      &
+         ((is_64bit_aligned(l5) == 0) .or. &
+         (is_64bit_aligned(n3) == 0) .or. &
+         (is_64bit_aligned(i3) == 0) .or. &
+         (is_64bit_aligned(j3) == 0))) then
+         stop 12
+       end if
+      end do
+    end do
+
+    !$omp do collapse(2) lastprivate(l6, i4, j4) linear (n4:17) schedule (dynamic) allocate (h: n4, l6, i4, j4)
+    do i4 = 3, 4
+      do j4 = 17, 22,2
+         n4 = n4 + 17;
+         l6 = i4 * 31 + j4;
+       if ( (and(fl, 1) /= 0) .and.          &
+         ((is_64bit_aligned(l6) == 0) .or. &
+         (is_64bit_aligned(n4) == 0) .or. &
+         (is_64bit_aligned(i4) == 0) .or. &
+         (is_64bit_aligned(j4) == 0))) then
+         stop 13
+       end if
+      end do
+    end do
+
+    !$omp do lastprivate (i5) allocate (i5)
+    do i5 = 1, 17, 3
+      if ( (and(fl, 2) /= 0) .and.          &
+          (is_64bit_aligned(i5) == 0)) then
+       stop 14
+      end if
+    end do
+
+    !$omp do reduction(+:p, q, r2) allocate(h: p, q, r2)
+    do i = 0, 31
+       p(3) = p(3) +  i;
+       p(4) = p(4) + (2 * i)
+       q(1) = q(1) + (3 * i)
+       q(3) = q(3) + (4 * i)
+       r2(1) = r2(1) + (5 * i)
+       r2(4) = r2(4) + (6 * i)
+       if ( (and(fl, 1) /= 0) .and.          &
+         ((is_64bit_aligned(q(1)) == 0) .or. &
+         (is_64bit_aligned(p(1)) == 0) .or. &
+         (is_64bit_aligned(r2(1)) == 0) )) then
+         stop 15
+       end if
+    end do
+
+    !$omp task private(y) firstprivate(x) allocate(x, y)
+    if (x /= 42) then
+      stop 16
+    end if
+
+    if ( (and(fl, 2) /= 0) .and.          &
+      ((is_64bit_aligned(x) == 0) .or. &
+      (is_64bit_aligned(y) == 0) )) then
+      stop 17
+    end if
+    !$omp end task
+
+    !$omp task private(y) firstprivate(x) allocate(h: x, y)
+    if (x /= 42) then
+      stop 16
+    end if
+
+    if ( (and(fl, 1) /= 0) .and.          &
+      ((is_64bit_aligned(x) == 0) .or. &
+      (is_64bit_aligned(y) == 0) )) then
+      stop 17
+    end if
+    !$omp end task
+
+    !$omp task private(y) firstprivate(s) allocate(s, y)
+    if (s%a /= 27 .or. s%b /= 29) then
+      stop 18
+    end if
+
+    if ( (and(fl, 2) /= 0) .and.          &
+      ((is_64bit_aligned(s%a) == 0) .or. &
+      (is_64bit_aligned(y) == 0) )) then
+      stop 19
+    end if
+    !$omp end task
+
+    !$omp task private(y) firstprivate(s) allocate(h: s, y)
+    if (s%a /= 27 .or. s%b /= 29) then
+      stop 18
+    end if
+
+    if ( (and(fl, 1) /= 0) .and.          &
+      ((is_64bit_aligned(s%a) == 0) .or. &
+      (is_64bit_aligned(y) == 0) )) then
+      stop 19
+    end if
+    !$omp end task
+
+  !$omp end parallel
+
+  if (r /= ((64 * 63) / 2) .or. l /= 63 .or. n /= (8 + 16 * 64)) then
+    stop 20
+  end if
+
+  if (l2(1) /= 63 .or. l2(2) /= 64 .or. l2(3) /= 65 .or. l2(4) /= 66 .or. l3 /= 36) then
+    stop 21
+  end if
+
+  if (i2 /= 5 .or. j2 /= 23 .or. n2 /= (9 + (17 * 6)) .or. l4 /= (4 * 31 + 21)) then
+    stop 22
+  end if
+
+  if (i3 /= 5 .or. j3 /= 23 .or. n3 /= (10 + (17 * 6))  .or. l5 /= (4 * 31 + 21)) then
+    stop 23
+  end if
+
+  if (i4 /= 5 .or. j4 /= 23 .or. n4 /= (11 + (17 * 6))  .or. l6 /= (4 * 31 + 21)) then
+    stop 24
+  end if
+
+  if (i5 /= 19) then
+    stop 24
+  end if
+
+  if (p(3) /= ((32 * 31) / 2) .or. p(4) /= (2 * p(3))         &
+      .or. q(1) /= (3 * p(3)) .or. q(3) /= (4 * p(3))         &
+      .or. r2(1) /= (5 * p(3)) .or. r2(4) /= (6 * p(3))) then
+    stop 25
+  end if
+
+end subroutine
+
+program main
+  use omp_lib
+  integer, dimension(4) :: p
+  integer, dimension(4) :: q
+
+  type (omp_alloctrait) :: traits(3)
+  integer (omp_allocator_handle_kind) :: a
+
+  traits = [omp_alloctrait (omp_atk_alignment, 64), &
+            omp_alloctrait (omp_atk_fallback, omp_atv_null_fb), &
+            omp_alloctrait (omp_atk_pool_size, 8192)]
+  a = omp_init_allocator (omp_default_mem_space, 3, traits)
+  if (a == omp_null_allocator) stop 1
+
+  call omp_set_default_allocator (omp_default_mem_alloc);
+  call foo (42, p, q, 2, a, 0);
+  call foo (42, p, q, 2, omp_default_mem_alloc, 0);
+  call foo (42, p, q, 2, a, 1);
+  call omp_set_default_allocator (a);
+  call foo (42, p, q, 2, omp_null_allocator, 3);
+  call foo (42, p, q, 2, omp_default_mem_alloc, 2);
+  call omp_destroy_allocator (a);
+end