]> gcc.gnu.org Git - gcc.git/commitdiff
Fortran/openmp: Partial OpenMP 5.2 doacross and omp_cur_iteration support
authorTobias Burnus <tobias@codesourcery.com>
Mon, 5 Sep 2022 16:05:24 +0000 (18:05 +0200)
committerTobias Burnus <tobias@codesourcery.com>
Mon, 5 Sep 2022 16:06:06 +0000 (18:06 +0200)
Add the Fortran support to the ME/C/C++ commit
r13-2388-ga651e6d59188da8992f8bfae2df1cb4e6316f9e6

gcc/fortran/ChangeLog:

* dump-parse-tree.cc (show_omp_namelist, show_omp_clauses): Handle
omp_cur_iteration and distinguish doacross/depend.
* gfortran.h (enum gfc_omp_depend_doacross_op): Renamed from
gfc_omp_depend_op.
(enum gfc_omp_depend_doacross_op): Add OMP_DOACROSS_SINK_FIRST,
Rename OMP_DEPEND_SINK to OMP_DOACROSS_SINK.
(gfc_omp_namelist) Handle renaming, rename depend_op to
depend_doacross_op.
(struct gfc_omp_clauses): Add doacross_source.
* openmp.cc (gfc_match_omp_depend_sink): Renamed to ...
(gfc_match_omp_doacross_sink): ... this; handle omp_all_memory.
(enum omp_mask2): Add OMP_CLAUSE_DOACROSS.
(gfc_match_omp_clauses): Handle 'doacross' and syntax changes to
depend.
(gfc_match_omp_depobj): Simplify as sink/source are now impossible.
(gfc_match_omp_ordered_depend): Request OMP_CLAUSE_DOACROSS.
(resolve_omp_clauses): Update sink/source checks.
(gfc_resolve_omp_directive): Resolve EXEC_OMP_ORDERED clauses.
* parse.cc (decode_omp_directive): Handle 'ordered doacross'.
* trans-openmp.cc (gfc_trans_omp_clauses): Handle doacross.
(gfc_trans_omp_do): Fix OMP_FOR_ORIG_DECLS handling if 'ordered'
clause is present.
(gfc_trans_omp_depobj): Update for member name change.

libgomp/ChangeLog:

* libgomp.texi (OpenMP 5.2): Update doacross/omp_cur_iteration status.

gcc/testsuite/ChangeLog:

* gfortran.dg/gomp/all-memory-1.f90: Update dg-error.
* gfortran.dg/gomp/depend-iterator-2.f90: Likewise.
* gfortran.dg/gomp/depobj-2.f90: Likewise.
* gfortran.dg/gomp/doacross-5.f90: New test.
* gfortran.dg/gomp/doacross-6.f90: New test.

gcc/fortran/dump-parse-tree.cc
gcc/fortran/gfortran.h
gcc/fortran/openmp.cc
gcc/fortran/parse.cc
gcc/fortran/trans-openmp.cc
gcc/testsuite/gfortran.dg/gomp/all-memory-1.f90
gcc/testsuite/gfortran.dg/gomp/depend-iterator-2.f90
gcc/testsuite/gfortran.dg/gomp/depobj-2.f90
gcc/testsuite/gfortran.dg/gomp/doacross-5.f90 [new file with mode: 0644]
gcc/testsuite/gfortran.dg/gomp/doacross-6.f90 [new file with mode: 0644]
libgomp/libgomp.texi

index 5352008a63dd0a95ae3e9fd4b052cce89257f01f..40c690c9ae8d68a68f99b5c2e6923b96aec7d572 100644 (file)
@@ -1337,8 +1337,15 @@ show_omp_namelist (int list_type, gfc_omp_namelist *n)
          if (n->u2.ns != ns_iter)
            {
              if (n != n2)
-               fputs (list_type == OMP_LIST_AFFINITY
-                      ? ") AFFINITY(" : ") DEPEND(", dumpfile);
+               {
+                 fputs (") ", dumpfile);
+                 if (list_type == OMP_LIST_AFFINITY)
+                   fputs ("AFFINITY (", dumpfile);
+                 else if (n->u.depend_doacross_op == OMP_DOACROSS_SINK_FIRST)
+                   fputs ("DOACROSS (", dumpfile);
+                 else
+                   fputs ("DEPEND (", dumpfile);
+               }
              if (n->u2.ns)
                {
                  fputs ("ITERATOR(", dumpfile);
@@ -1374,7 +1381,7 @@ show_omp_namelist (int list_type, gfc_omp_namelist *n)
          default: break;
          }
       else if (list_type == OMP_LIST_DEPEND)
-       switch (n->u.depend_op)
+       switch (n->u.depend_doacross_op)
          {
          case OMP_DEPEND_IN: fputs ("in:", dumpfile); break;
          case OMP_DEPEND_OUT: fputs ("out:", dumpfile); break;
@@ -1385,10 +1392,14 @@ show_omp_namelist (int list_type, gfc_omp_namelist *n)
            fputs ("mutexinoutset:", dumpfile);
            break;
          case OMP_DEPEND_SINK_FIRST:
+         case OMP_DOACROSS_SINK_FIRST:
            fputs ("sink:", dumpfile);
            while (1)
              {
-               fprintf (dumpfile, "%s", n->sym->name);
+               if (!n->sym)
+                 fputs ("omp_cur_iteration", dumpfile);
+               else
+                 fprintf (dumpfile, "%s", n->sym->name);
                if (n->expr)
                  {
                    fputc ('+', dumpfile);
@@ -1396,9 +1407,13 @@ show_omp_namelist (int list_type, gfc_omp_namelist *n)
                  }
                if (n->next == NULL)
                  break;
-               else if (n->next->u.depend_op != OMP_DEPEND_SINK)
+               else if (n->next->u.depend_doacross_op != OMP_DOACROSS_SINK)
                  {
-                   fputs (") DEPEND(", dumpfile);
+                   if (n->next->u.depend_doacross_op
+                       == OMP_DOACROSS_SINK_FIRST)
+                     fputs (") DOACROSS(", dumpfile);
+                   else
+                     fputs (") DEPEND(", dumpfile);
                    break;
                  }
                fputc (',', dumpfile);
@@ -1674,7 +1689,14 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses)
          case OMP_LIST_AFFINITY: type = "AFFINITY"; break;
          case OMP_LIST_ALIGNED: type = "ALIGNED"; break;
          case OMP_LIST_LINEAR: type = "LINEAR"; break;
-         case OMP_LIST_DEPEND: type = "DEPEND"; break;
+         case OMP_LIST_DEPEND:
+           if (omp_clauses->lists[list_type]
+               && (omp_clauses->lists[list_type]->u.depend_doacross_op
+                   == OMP_DOACROSS_SINK_FIRST))
+             type = "DOACROSS";
+           else
+             type = "DEPEND";
+           break;
          case OMP_LIST_MAP: type = "MAP"; break;
          case OMP_LIST_TO: type = "TO"; break;
          case OMP_LIST_FROM: type = "FROM"; break;
@@ -1894,6 +1916,8 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses)
     fputs (" DESTROY", dumpfile);
   if (omp_clauses->depend_source)
     fputs (" DEPEND(source)", dumpfile);
+  if (omp_clauses->doacross_source)
+    fputs (" DOACROSS(source:)", dumpfile);
   if (omp_clauses->capture)
     fputs (" CAPTURE", dumpfile);
   if (omp_clauses->depobj_update != OMP_DEPEND_UNSET)
index 696aadd7db660667a9b735b25fb1ec98a801224d..4babd77924b063d812737faa9f733aa4415de853 100644 (file)
@@ -1265,7 +1265,7 @@ enum gfc_omp_reduction_op
   OMP_REDUCTION_USER
 };
 
-enum gfc_omp_depend_op
+enum gfc_omp_depend_doacross_op
 {
   OMP_DEPEND_UNSET,
   OMP_DEPEND_IN,
@@ -1275,7 +1275,8 @@ enum gfc_omp_depend_op
   OMP_DEPEND_MUTEXINOUTSET,
   OMP_DEPEND_DEPOBJ,
   OMP_DEPEND_SINK_FIRST,
-  OMP_DEPEND_SINK
+  OMP_DOACROSS_SINK_FIRST,
+  OMP_DOACROSS_SINK
 };
 
 enum gfc_omp_map_op
@@ -1343,7 +1344,7 @@ typedef struct gfc_omp_namelist
   union
     {
       gfc_omp_reduction_op reduction_op;
-      gfc_omp_depend_op depend_op;
+      gfc_omp_depend_doacross_op depend_doacross_op;
       gfc_omp_map_op map_op;
       struct
        {
@@ -1536,17 +1537,17 @@ typedef struct gfc_omp_clauses
   unsigned nowait:1, ordered:1, untied:1, mergeable:1, ancestor:1;
   unsigned inbranch:1, notinbranch:1, nogroup:1;
   unsigned sched_simd:1, sched_monotonic:1, sched_nonmonotonic:1;
-  unsigned simd:1, threads:1, depend_source:1, destroy:1, order_concurrent:1;
+  unsigned simd:1, threads:1, doacross_source:1, depend_source:1, destroy:1;
   unsigned order_unconstrained:1, order_reproducible:1, capture:1;
   unsigned grainsize_strict:1, num_tasks_strict:1, compare:1, weak:1;
-  unsigned non_rectangular:1;
+  unsigned non_rectangular:1, order_concurrent:1;
   ENUM_BITFIELD (gfc_omp_sched_kind) sched_kind:3;
   ENUM_BITFIELD (gfc_omp_device_type) device_type:2;
   ENUM_BITFIELD (gfc_omp_memorder) memorder:3;
   ENUM_BITFIELD (gfc_omp_memorder) fail:3;
   ENUM_BITFIELD (gfc_omp_cancel_kind) cancel:3;
   ENUM_BITFIELD (gfc_omp_proc_bind_kind) proc_bind:3;
-  ENUM_BITFIELD (gfc_omp_depend_op) depobj_update:4;
+  ENUM_BITFIELD (gfc_omp_depend_doacross_op) depobj_update:4;
   ENUM_BITFIELD (gfc_omp_bind_type) bind:2;
   ENUM_BITFIELD (gfc_omp_at_type) at:2;
   ENUM_BITFIELD (gfc_omp_severity_type) severity:2;
index 594907714ffd3003ea9044ea19cba0edd15187b6..5142fd7c608f9ff47c9f6f9c3040b9c6b14da292 100644 (file)
@@ -575,11 +575,13 @@ syntax_error:
 
 }
 
-/* Match depend(sink : ...) construct a namelist from it.  */
+/* Match doacross(sink : ...) construct a namelist from it;
+   if depend is true, match legacy 'depend(sink : ...)'.  */
 
 static match
-gfc_match_omp_depend_sink (gfc_omp_namelist **list)
+gfc_match_omp_doacross_sink (gfc_omp_namelist **list, bool depend)
 {
+  char n[GFC_MAX_SYMBOL_LEN+1];
   gfc_omp_namelist *head, *tail, *p;
   locus old_loc, cur_loc;
   gfc_symbol *sym;
@@ -591,49 +593,51 @@ gfc_match_omp_depend_sink (gfc_omp_namelist **list)
   for (;;)
     {
       cur_loc = gfc_current_locus;
-      switch (gfc_match_symbol (&sym, 1))
+
+      if (gfc_match_name (n) != MATCH_YES)
+       goto syntax;
+      if (UNLIKELY (strcmp (n, "omp_all_memory") == 0))
        {
-       case MATCH_YES:
-         gfc_set_sym_referenced (sym);
-         p = gfc_get_omp_namelist ();
-         if (head == NULL)
-           {
-             head = tail = p;
-             head->u.depend_op = OMP_DEPEND_SINK_FIRST;
-           }
-         else
-           {
-             tail->next = p;
-             tail = tail->next;
-             tail->u.depend_op = OMP_DEPEND_SINK;
-           }
-         tail->sym = sym;
-         tail->expr = NULL;
-         tail->where = cur_loc;
-         if (UNLIKELY (strcmp (sym->name, "omp_all_memory") == 0))
-           {
-             gfc_error ("%<omp_all_memory%> used with DEPEND kind "
-                        "other than OUT or INOUT at %C");
-             goto cleanup;
-           }
-         if (gfc_match_char ('+') == MATCH_YES)
-           {
-             if (gfc_match_literal_constant (&tail->expr, 0) != MATCH_YES)
-               goto syntax;
-           }
-         else if (gfc_match_char ('-') == MATCH_YES)
-           {
-             if (gfc_match_literal_constant (&tail->expr, 0) != MATCH_YES)
-               goto syntax;
-             tail->expr = gfc_uminus (tail->expr);
-           }
-         break;
-       case MATCH_NO:
-         goto syntax;
-       case MATCH_ERROR:
+         gfc_error ("%<omp_all_memory%> used with dependence-type "
+                    "other than OUT or INOUT at %C");
          goto cleanup;
        }
-
+      sym = NULL;
+      if (!(strcmp (n, "omp_cur_iteration") == 0))
+       {
+         gfc_symtree *st;
+         if (gfc_get_ha_sym_tree (n, &st))
+           goto syntax;
+         sym = st->n.sym;
+         gfc_set_sym_referenced (sym);
+       }
+      p = gfc_get_omp_namelist ();
+      if (head == NULL)
+       {
+         head = tail = p;
+         head->u.depend_doacross_op = (depend ? OMP_DEPEND_SINK_FIRST
+                                              : OMP_DOACROSS_SINK_FIRST);
+       }
+      else
+       {
+         tail->next = p;
+         tail = tail->next;
+         tail->u.depend_doacross_op = OMP_DOACROSS_SINK;
+       }
+      tail->sym = sym;
+      tail->expr = NULL;
+      tail->where = cur_loc;
+      if (gfc_match_char ('+') == MATCH_YES)
+       {
+         if (gfc_match_literal_constant (&tail->expr, 0) != MATCH_YES)
+           goto syntax;
+       }
+      else if (gfc_match_char ('-') == MATCH_YES)
+       {
+         if (gfc_match_literal_constant (&tail->expr, 0) != MATCH_YES)
+           goto syntax;
+         tail->expr = gfc_uminus (tail->expr);
+       }
       if (gfc_match_char (')') == MATCH_YES)
        break;
       if (gfc_match_char (',') != MATCH_YES)
@@ -647,7 +651,7 @@ gfc_match_omp_depend_sink (gfc_omp_namelist **list)
   return MATCH_YES;
 
 syntax:
-  gfc_error ("Syntax error in OpenMP DEPEND SINK list at %C");
+  gfc_error ("Syntax error in OpenMP SINK dependence-type list at %C");
 
 cleanup:
   gfc_free_omp_namelist (head, false);
@@ -987,6 +991,7 @@ enum omp_mask2
   OMP_CLAUSE_NOHOST,
   OMP_CLAUSE_HAS_DEVICE_ADDR,  /* OpenMP 5.1  */
   OMP_CLAUSE_ENTER, /* OpenMP 5.2 */
+  OMP_CLAUSE_DOACROSS, /* OpenMP 5.2 */
   /* This must come last.  */
   OMP_MASK2_LAST
 };
@@ -1903,18 +1908,26 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
                                           OMP_MAP_RELEASE, true,
                                           allow_derived))
            continue;
-         if ((mask & OMP_CLAUSE_DEPEND)
-             && gfc_match ("depend ( ") == MATCH_YES)
+         /* DOACROSS: match 'doacross' and 'depend' with sink/source.
+            DEPEND: match 'depend' but not sink/source.  */
+         m = MATCH_NO;
+         if (((mask & OMP_CLAUSE_DOACROSS)
+              && gfc_match ("doacross ( ") == MATCH_YES)
+             || (((mask & OMP_CLAUSE_DEPEND) || (mask & OMP_CLAUSE_DOACROSS))
+                 && (m = gfc_match ("depend ( ")) == MATCH_YES))
            {
              bool has_omp_all_memory;
+             bool is_depend = m == MATCH_YES;
              gfc_namespace *ns_iter = NULL, *ns_curr = gfc_current_ns;
-             match m_it = gfc_match_iterator (&ns_iter, false);
+             match m_it = MATCH_NO;
+             if (is_depend)
+               m_it = gfc_match_iterator (&ns_iter, false);
              if (m_it == MATCH_ERROR)
                break;
              if (m_it == MATCH_YES && gfc_match (" , ") != MATCH_YES)
                break;
              m = MATCH_YES;
-             gfc_omp_depend_op depend_op = OMP_DEPEND_OUT;
+             gfc_omp_depend_doacross_op depend_op = OMP_DEPEND_OUT;
              if (gfc_match ("inoutset") == MATCH_YES)
                depend_op = OMP_DEPEND_INOUTSET;
              else if (gfc_match ("inout") == MATCH_YES)
@@ -1927,34 +1940,77 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
                depend_op = OMP_DEPEND_MUTEXINOUTSET;
              else if (gfc_match ("depobj") == MATCH_YES)
                depend_op = OMP_DEPEND_DEPOBJ;
-             else if (!c->depend_source
-                      && gfc_match ("source )") == MATCH_YES)
+             else if (gfc_match ("source") == MATCH_YES)
                {
                  if (m_it == MATCH_YES)
                    {
                      gfc_error ("ITERATOR may not be combined with SOURCE "
                                 "at %C");
-                     gfc_free_omp_clauses (c);
-                     return MATCH_ERROR;
+                     goto error;
+                   }
+                 if (!(mask & OMP_CLAUSE_DOACROSS))
+                   {
+                     gfc_error ("SOURCE at %C not permitted as dependence-type"
+                                " for this directive");
+                     goto error;
+                   }
+                 if (c->doacross_source)
+                   {
+                     gfc_error ("Duplicated clause with SOURCE dependence-type"
+                                " at %C");
+                     goto error;
+                   }
+                 gfc_gobble_whitespace ();
+                 m = gfc_match (": ");
+                 if (m != MATCH_YES && !is_depend)
+                   {
+                     gfc_error ("Expected %<:%> at %C");
+                     goto error;
                    }
-                 c->depend_source = true;
+                 if (gfc_match (")") != MATCH_YES
+                     && !(m == MATCH_YES
+                          && gfc_match ("omp_cur_iteration )") == MATCH_YES))
+                   {
+                     gfc_error ("Expected %<)%> or %<omp_cur_iteration)%> "
+                                "at %C");
+                     goto error;
+                   }
+                 c->doacross_source = true;
+                 c->depend_source = is_depend;
                  continue;
                }
-             else if (gfc_match ("sink ") == MATCH_YES)
+             else if (gfc_match ("sink ") == MATCH_YES)
                {
+                 if (!(mask & OMP_CLAUSE_DOACROSS))
+                   {
+                     gfc_error ("SINK at %C not permitted as dependence-type "
+                                "for this directive");
+                     goto error;
+                   }
+                 if (gfc_match (": ") != MATCH_YES)
+                   {
+                     gfc_error ("Expected %<:%> at %C");
+                     goto error;
+                   }
                  if (m_it == MATCH_YES)
                    {
                      gfc_error ("ITERATOR may not be combined with SINK "
                                 "at %C");
-                     break;
+                     goto error;
                    }
-                 if (gfc_match_omp_depend_sink (&c->lists[OMP_LIST_DEPEND])
-                     == MATCH_YES)
+                 m = gfc_match_omp_doacross_sink (&c->lists[OMP_LIST_DEPEND],
+                                                  is_depend);
+                 if (m == MATCH_YES)
                    continue;
-                 m = MATCH_NO;
+                 goto error;
                }
              else
                m = MATCH_NO;
+             if (!(mask & OMP_CLAUSE_DEPEND))
+               {
+                 gfc_error ("Expected dependence-type SINK or SOURCE at %C");
+                 goto error;
+               }
              head = NULL;
              if (ns_iter)
                gfc_current_ns = ns_iter;
@@ -1976,7 +2032,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
              gfc_omp_namelist *n;
              for (n = *head; n; n = n->next)
                {
-                 n->u.depend_op = depend_op;
+                 n->u.depend_doacross_op = depend_op;
                  n->u2.ns = ns_iter;
                  if (ns_iter)
                    ns_iter->refs++;
@@ -3971,18 +4027,15 @@ gfc_match_omp_depobj (void)
 
   if (c->depobj_update == OMP_DEPEND_UNSET && !c->destroy)
     {
-      if (!c->depend_source && !c->lists[OMP_LIST_DEPEND])
+      if (!c->doacross_source && !c->lists[OMP_LIST_DEPEND])
        {
          gfc_error ("Expected DEPEND, UPDATE, or DESTROY clause at %C");
          goto error;
        }
-      if (c->depend_source
-         || c->lists[OMP_LIST_DEPEND]->u.depend_op == OMP_DEPEND_SINK_FIRST
-         || c->lists[OMP_LIST_DEPEND]->u.depend_op == OMP_DEPEND_SINK
-         || c->lists[OMP_LIST_DEPEND]->u.depend_op == OMP_DEPEND_DEPOBJ)
+      if (c->lists[OMP_LIST_DEPEND]->u.depend_doacross_op == OMP_DEPEND_DEPOBJ)
        {
          gfc_error ("DEPEND clause at %L of OMP DEPOBJ construct shall not "
-                    "have dependence-type SOURCE, SINK or DEPOBJ",
+                    "have dependence-type DEPOBJ",
                     c->lists[OMP_LIST_DEPEND]
                     ? &c->lists[OMP_LIST_DEPEND]->where : &gfc_current_locus);
          goto error;
@@ -5988,7 +6041,7 @@ gfc_match_omp_nothing (void)
 match
 gfc_match_omp_ordered_depend (void)
 {
-  return match_omp (EXEC_OMP_ORDERED, omp_mask (OMP_CLAUSE_DEPEND));
+  return match_omp (EXEC_OMP_ORDERED, omp_mask (OMP_CLAUSE_DOACROSS));
 }
 
 
@@ -7057,18 +7110,16 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
 
                if (list == OMP_LIST_DEPEND)
                  {
-                   if (n->u.depend_op == OMP_DEPEND_SINK_FIRST
-                       || n->u.depend_op == OMP_DEPEND_SINK)
+                   if (n->u.depend_doacross_op == OMP_DEPEND_SINK_FIRST
+                       || n->u.depend_doacross_op == OMP_DOACROSS_SINK_FIRST
+                       || n->u.depend_doacross_op == OMP_DOACROSS_SINK)
                      {
-                       if (code->op != EXEC_OMP_ORDERED)
-                         gfc_error ("SINK dependence type only allowed "
-                                    "on ORDERED directive at %L", &n->where);
-                       else if (omp_clauses->depend_source)
+                       if (omp_clauses->doacross_source)
                          {
-                           gfc_error ("DEPEND SINK used together with "
-                                      "DEPEND SOURCE on the same construct "
-                                      "at %L", &n->where);
-                           omp_clauses->depend_source = false;
+                           gfc_error ("Dependence-type SINK used together with"
+                                      " SOURCE on the same construct at %L",
+                                      &n->where);
+                           omp_clauses->doacross_source = false;
                          }
                        else if (n->expr)
                          {
@@ -7078,13 +7129,14 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
                              gfc_error ("SINK addend not a constant integer "
                                         "at %L", &n->where);
                          }
+                       if (n->sym == NULL
+                           && (n->expr == NULL
+                               || mpz_cmp_si (n->expr->value.integer, -1) != 0))
+                         gfc_error ("omp_cur_iteration at %L requires %<-1%> "
+                                    "as logical offset", &n->where);
                        continue;
                      }
-                   else if (code->op == EXEC_OMP_ORDERED)
-                     gfc_error ("Only SOURCE or SINK dependence types "
-                                "are allowed on ORDERED directive at %L",
-                                &n->where);
-                   else if (n->u.depend_op == OMP_DEPEND_DEPOBJ
+                   else if (n->u.depend_doacross_op == OMP_DEPEND_DEPOBJ
                             && !n->expr
                             && (n->sym->ts.type != BT_INTEGER
                                 || n->sym->ts.kind
@@ -7094,7 +7146,7 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
                                 "type shall be a scalar integer of "
                                 "OMP_DEPEND_KIND kind", n->sym->name,
                                 &n->where);
-                   else if (n->u.depend_op == OMP_DEPEND_DEPOBJ
+                   else if (n->u.depend_doacross_op == OMP_DEPEND_DEPOBJ
                             && n->expr
                             && (!gfc_resolve_expr (n->expr)
                                 || n->expr->ts.type != BT_INTEGER
@@ -7760,9 +7812,6 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
     resolve_scalar_int_expr (el->expr, "WAIT");
   if (omp_clauses->collapse && omp_clauses->tile_list)
     gfc_error ("Incompatible use of TILE and COLLAPSE at %L", &code->loc);
-  if (omp_clauses->depend_source && code->op != EXEC_OMP_ORDERED)
-    gfc_error ("SOURCE dependence type only allowed "
-              "on ORDERED directive at %L", &code->loc);
   if (omp_clauses->message)
     {
       gfc_expr *expr = omp_clauses->message;
@@ -9565,6 +9614,7 @@ gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns)
     case EXEC_OMP_CANCEL:
     case EXEC_OMP_ERROR:
     case EXEC_OMP_MASKED:
+    case EXEC_OMP_ORDERED:
     case EXEC_OMP_PARALLEL_WORKSHARE:
     case EXEC_OMP_PARALLEL:
     case EXEC_OMP_PARALLEL_MASKED:
index 80492c952aa0ded6dba90697b215dcd704fc2bf4..5b13441912a062b7fbb1a5c8e0f5faa597cabb32 100644 (file)
@@ -1026,7 +1026,8 @@ decode_omp_directive (void)
       matcho ("loop", gfc_match_omp_loop, ST_OMP_LOOP);
       break;
     case 'o':
-      if (gfc_match ("ordered depend (") == MATCH_YES)
+      if (gfc_match ("ordered depend (") == MATCH_YES
+         || gfc_match ("ordered doacross (") == MATCH_YES)
        {
          gfc_current_locus = old_locus;
          if (!flag_openmp)
index 82c1079bc2893afeab4ba325dbb297d884f100f0..1be7d23f86bab352182427016a5b5c9a3e85b0c3 100644 (file)
@@ -2864,15 +2864,18 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
                gfc_init_block (&iter_block);
              prev = n;
              if (list == OMP_LIST_DEPEND
-                 && n->u.depend_op == OMP_DEPEND_SINK_FIRST)
+                 && (n->u.depend_doacross_op == OMP_DOACROSS_SINK_FIRST
+                     || n->u.depend_doacross_op == OMP_DEPEND_SINK_FIRST))
                {
                  tree vec = NULL_TREE;
                  unsigned int i;
+                 bool is_depend
+                   = n->u.depend_doacross_op == OMP_DEPEND_SINK_FIRST;
                  for (i = 0; ; i++)
                    {
                      tree addend = integer_zero_node, t;
                      bool neg = false;
-                     if (n->expr)
+                     if (n->sym && n->expr)
                        {
                          addend = gfc_conv_constant_to_tree (n->expr);
                          if (TREE_CODE (addend) == INTEGER_CST
@@ -2883,7 +2886,11 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
                                                   TREE_TYPE (addend), addend);
                            }
                        }
-                     t = gfc_trans_omp_variable (n->sym, false);
+
+                     if (n->sym == NULL)
+                       t = null_pointer_node;  /* "omp_cur_iteration - 1".  */
+                     else
+                       t = gfc_trans_omp_variable (n->sym, false);
                      if (t != error_mark_node)
                        {
                          if (i < vec_safe_length (doacross_steps)
@@ -2900,7 +2907,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
                            OMP_CLAUSE_DOACROSS_SINK_NEGATIVE (vec) = 1;
                        }
                      if (n->next == NULL
-                         || n->next->u.depend_op != OMP_DEPEND_SINK)
+                         || n->next->u.depend_doacross_op != OMP_DOACROSS_SINK)
                        break;
                      n = n->next;
                    }
@@ -2910,7 +2917,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
                  tree node = build_omp_clause (input_location,
                                                OMP_CLAUSE_DOACROSS);
                  OMP_CLAUSE_DOACROSS_KIND (node) = OMP_CLAUSE_DOACROSS_SINK;
-                 OMP_CLAUSE_DOACROSS_DEPEND (node) = 1;
+                 OMP_CLAUSE_DOACROSS_DEPEND (node) = is_depend;
                  OMP_CLAUSE_DECL (node) = nreverse (vec);
                  omp_clauses = gfc_trans_add_clause (node, omp_clauses);
                  continue;
@@ -2962,7 +2969,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
                  OMP_CLAUSE_DECL (node) = build_fold_indirect_ref (ptr);
                }
              if (list == OMP_LIST_DEPEND)
-               switch (n->u.depend_op)
+               switch (n->u.depend_doacross_op)
                  {
                  case OMP_DEPEND_IN:
                    OMP_CLAUSE_DEPEND_KIND (node) = OMP_CLAUSE_DEPEND_IN;
@@ -4253,11 +4260,11 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
     }
 
-  if (clauses->depend_source)
+  if (clauses->doacross_source)
     {
       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_DOACROSS);
       OMP_CLAUSE_DOACROSS_KIND (c) = OMP_CLAUSE_DOACROSS_SOURCE;
-      OMP_CLAUSE_DOACROSS_DEPEND (c) = 1;
+      OMP_CLAUSE_DOACROSS_DEPEND (c) = clauses->depend_source;
       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
     }
 
@@ -5119,7 +5126,7 @@ gfc_trans_omp_do (gfc_code *code, gfc_exec_op op, stmtblock_t *pblock,
   init = make_tree_vec (collapse);
   cond = make_tree_vec (collapse);
   incr = make_tree_vec (collapse);
-  orig_decls = clauses->orderedc ? make_tree_vec (collapse) : NULL_TREE;
+  orig_decls = clauses->ordered ? make_tree_vec (collapse) : NULL_TREE;
 
   if (pblock == NULL)
     {
@@ -5219,6 +5226,10 @@ gfc_trans_omp_do (gfc_code *code, gfc_exec_op op, stmtblock_t *pblock,
                                                    MODIFY_EXPR,
                                                    type, dovar,
                                                    TREE_VEC_ELT (incr, i));
+         if (orig_decls && !clauses->orderedc)
+           orig_decls = NULL;
+         else if (orig_decls)
+           TREE_VEC_ELT (orig_decls, i) = dovar_decl;
        }
       else
        {
@@ -5259,9 +5270,9 @@ gfc_trans_omp_do (gfc_code *code, gfc_exec_op op, stmtblock_t *pblock,
                vec_safe_grow_cleared (doacross_steps, clauses->orderedc, true);
              (*doacross_steps)[i] = step;
            }
+         if (orig_decls)
+           TREE_VEC_ELT (orig_decls, i) = dovar_decl;
        }
-      if (orig_decls)
-       TREE_VEC_ELT (orig_decls, i) = dovar_decl;
 
       if (dovar_found == 3
          && op == EXEC_OMP_SIMD
@@ -5628,7 +5639,7 @@ gfc_trans_omp_depobj (gfc_code *code)
   int k = -1; /* omp_clauses->destroy */
   if (!code->ext.omp_clauses->destroy)
     switch (code->ext.omp_clauses->depobj_update != OMP_DEPEND_UNSET
-           ? code->ext.omp_clauses->depobj_update : n->u.depend_op)
+           ? code->ext.omp_clauses->depobj_update : n->u.depend_doacross_op)
       {
       case OMP_DEPEND_IN: k = GOMP_DEPEND_IN; break;
       case OMP_DEPEND_OUT: k = GOMP_DEPEND_OUT; break;
index f8f34f0c887b94e13abf5f2fe74724509797c53b..51b5633adbab6bdd6fb4475250dac57b16c3e2b2 100644 (file)
@@ -50,5 +50,5 @@ subroutine f6
   !$omp target depend ( depobj : omp_all_memory)  ! { dg-error "'omp_all_memory' used with DEPEND kind other than OUT or INOUT" }
   !!$omp end target
 
-  !$omp ordered depend ( sink : omp_all_memory)  ! { dg-error "'omp_all_memory' used with DEPEND kind other than OUT or INOUT" }
+  !$omp ordered depend ( sink : omp_all_memory)  ! { dg-error "used with dependence-type other than OUT or INOUT" }
 end
index 21fc3272974afbfb79666b3a925bcf2e6122b389..cadd9a06cfec21b44cbd5b66e89e3fd315aa4052 100644 (file)
@@ -34,7 +34,7 @@ program main
       !!$omp end task
     !$omp task depend(iterator(i=1:5), source )  ! { dg-error "ITERATOR may not be combined with SOURCE" }
   !!$omp end task
-  !$omp task affinity (iterator(i=1:5): a) depend(iterator(i=1:5), sink : x) ! { dg-error "ITERATOR may not be combined with SINK" }
+  !$omp task affinity (iterator(i=1:5): a) depend(iterator(i=1:5), sink : x) ! { dg-error "SINK at .1. not permitted as dependence-type for this directive" }
   !!$omp end task
 
     end do
index cb67c3ce9d1b8f266d940618377ef76466def961..6e7441d8d00e19db565abe8436a45676e5c5b388 100644 (file)
@@ -21,13 +21,13 @@ subroutine f1
   !$omp depobj(d) depend( inout : a)                 ! { dg-error "DEPOBJ in DEPOBJ construct at .1. shall be a scalar integer of OMP_DEPEND_KIND kind" }
   !$omp depobj(depobj) depend( inout : a, b)         ! { dg-error "DEPEND clause at .1. of OMP DEPOBJ construct shall have only a single locator" }
   !$omp depobj(depobj) depend(mutexinoutset : a)     ! OK
-  !$omp depobj(depobj) depend(source)                ! { dg-error "DEPEND clause at .1. of OMP DEPOBJ construct shall not have dependence-type SOURCE, SINK or DEPOBJ" }
-  !$omp depobj(depobj) depend(sink : i + 1)          ! { dg-error "DEPEND clause at .1. of OMP DEPOBJ construct shall not have dependence-type SOURCE, SINK or DEPOBJ" }
+  !$omp depobj(depobj) depend(source)                ! { dg-error "SOURCE at .1. not permitted as dependence-type for this directive" }
+  !$omp depobj(depobj) depend(sink : i + 1)          ! { dg-error "SINK at .1. not permitted as dependence-type for this directive" }
   !$omp depobj(depobj) update(source)                ! { dg-error "Expected IN, OUT, INOUT, INOUTSET or MUTEXINOUTSET followed by '\\)'" }
   !$omp depobj(depobj) update(sink)                  ! { dg-error "Expected IN, OUT, INOUT, INOUTSET or MUTEXINOUTSET followed by '\\)'" }
   !$omp depobj(depobj) update(depobj)                ! { dg-error "Expected IN, OUT, INOUT, INOUTSET or MUTEXINOUTSET followed by '\\)'" }
 
   ! Valid in OpenMP 5.1:
-  !$omp depobj(depobj5) depend(depobj: depobj3)      ! { dg-error "DEPEND clause at .1. of OMP DEPOBJ construct shall not have dependence-type SOURCE, SINK or DEPOBJ" }
+  !$omp depobj(depobj5) depend(depobj: depobj3)      ! { dg-error "DEPEND clause at .1. of OMP DEPOBJ construct shall not have dependence-type DEPOBJ" }
 end subroutine f1
 
diff --git a/gcc/testsuite/gfortran.dg/gomp/doacross-5.f90 b/gcc/testsuite/gfortran.dg/gomp/doacross-5.f90
new file mode 100644 (file)
index 0000000..3a1679a
--- /dev/null
@@ -0,0 +1,88 @@
+subroutine foo (n)
+  integer i, n
+
+  !$omp do ordered
+  do i = 1, 8, n
+    !$omp ordered doacross(source:)
+    !$omp ordered doacross(sink: i - 2)
+  end do
+end
+
+subroutine bar (n)
+  integer :: i, j, n
+
+  !$omp do collapse(2) ordered(2)
+  do i = 1, 8, n
+    do j = 1, 8, n
+      !$omp ordered doacross(source:omp_cur_iteration)
+      !$omp ordered doacross(sink: i - 2, j + 2)
+    end do
+  end do
+end
+
+subroutine baz ()
+  integer :: i, j
+
+  !$omp do ordered(1)
+  do i = 1, 64
+    !$omp ordered                      ! { dg-error "'ordered' construct without 'doacross' or 'depend' clauses must not have the same binding region as 'ordered' construct with those clauses" }
+    !$omp end ordered
+
+    !$omp ordered doacross(source:)
+
+    !$omp ordered doacross(sink: i - 1)
+  end do
+
+  !$omp do ordered
+  do i = 1, 64
+    !$omp ordered doacross(source: omp_cur_iteration )
+
+    !$omp ordered doacross(sink: i - 1)
+
+    !$omp ordered threads              ! { dg-error "'ordered' construct without 'doacross' or 'depend' clauses must not have the same binding region as 'ordered' construct with those clauses" }
+    !$omp end ordered
+  end do
+  !$omp do ordered(2)
+  do i = 1, 64
+    do j = 1, 64
+       !$omp ordered                   ! { dg-error "'ordered' construct without 'doacross' or 'depend' clauses binds to loop where 'collapse' argument 1 is different from 'ordered' argument 2" }
+       !$omp end ordered
+    end do
+  end do
+  !$omp do ordered(2) collapse(1)
+  do i = 1, 8
+    do j = 1, 8
+      !$omp ordered threads            ! { dg-error "'ordered' construct without 'doacross' or 'depend' clauses binds to loop where 'collapse' argument 1 is different from 'ordered' argument 2" }
+      !$omp end ordered
+    end do
+  end do
+end
+
+subroutine qux ()
+  integer :: i, j
+  j = 0
+  !$omp do ordered linear(j)
+  do i = 1, 64
+    j = j + 1
+    !$omp ordered
+    !$omp end ordered
+  end do
+  !$omp do ordered linear(j)           ! { dg-error "'linear' clause may not be specified together with 'ordered' clause if stand-alone 'ordered' construct is nested in it" }
+  do i = 1, 64
+    j = j + 1
+    !$omp ordered doacross(source:)
+    !$omp ordered doacross(sink:i-1)
+  end do
+  !$omp do ordered(1) linear(j)
+  do i = 1, 64
+    j = j + 1
+    !$omp ordered
+    !$omp end ordered
+  end do
+  !$omp do ordered(1) linear(j)                ! { dg-error "'linear' clause may not be specified together with 'ordered' clause if stand-alone 'ordered' construct is nested in it" }
+  do i = 1, 64
+    j = j + 1
+    !$omp ordered doacross(source:)
+    !$omp ordered doacross(sink:i-1)
+  end do
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/doacross-6.f90 b/gcc/testsuite/gfortran.dg/gomp/doacross-6.f90
new file mode 100644 (file)
index 0000000..a45e1c9
--- /dev/null
@@ -0,0 +1,77 @@
+subroutine foo (n)
+  integer :: i, n
+  !$omp do ordered
+  do i = 1, 8, n
+    !$omp ordered doacross(source)             ! { dg-error "Expected ':'" }
+  end do
+
+  !$omp do ordered
+  do i = 1, 8, n
+    !$omp ordered doacross(source:omp_current_iteration)       ! { dg-error "Expected '\\\)' or 'omp_cur_iteration\\\)'" }
+  end do
+
+  !$omp do ordered
+  do i = 1, 8, n
+    !$omp ordered doacross(source:i - 2)       ! { dg-error "Expected '\\\)' or 'omp_cur_iteration\\\)'" }
+  end do
+
+  !$omp do ordered
+  do i = 1, 8, n
+    !$omp ordered doacross(sink)               ! { dg-error "Expected ':'" }
+  end do
+
+  !$omp do ordered
+  do i = 1, 8, n
+    !$omp ordered doacross(sink:)              ! { dg-error "Syntax error in OpenMP SINK dependence-type list" }
+  end do
+end
+
+subroutine bar (n)
+  implicit none
+  integer i, n
+
+  !$omp do ordered
+  do i = 1, 8, n
+    !$omp ordered doacross(sink:omp_current_iteration - 1)     ! { dg-error "Symbol 'omp_current_iteration' at .1. has no IMPLICIT type" }
+  end do
+
+  !$omp do ordered
+  do i = 1, 8, n
+    !$omp ordered doacross(sink:omp_cur_iteration)     ! { dg-error "omp_cur_iteration at .1. requires '-1' as logical offset" }
+  end do
+end
+
+subroutine baz (n)
+  implicit none
+  integer i, n
+
+  !$omp do ordered
+  do i = 1, 8, n
+    !$omp ordered doacross(sink:omp_cur_iteration + 1) ! { dg-error "omp_cur_iteration at .1. requires '-1' as logical offset" }
+  end do
+end
+
+subroutine qux (n)
+  implicit none
+  integer i, n
+
+  !$omp do ordered
+  do i = 1, 8, n
+    !$omp ordered doacross(sink:omp_cur_iteration - (2 - 1))   ! { dg-error "Syntax error in OpenMP SINK dependence-type list" }
+  end do
+end
+
+subroutine corge (n)
+  implicit none
+  integer i, n
+
+  !$omp do ordered
+  do i = 1, 8, n
+    !$omp ordered doacross(sink:omp_cur_iteration - 1)
+  end do
+
+  !$omp do ordered
+  do i = 1, 8, n
+    !$omp ordered doacross(sink:omp_cur_iteration - 1_8)
+  end do
+end
index 0f2998cf8f1f60dc4a79001743e007dbae54a7b9..3df979e170bb97d4d0208378a4bb5669b8034cb7 100644 (file)
@@ -394,10 +394,11 @@ to address of matching mapped list item per 5.1, Sect. 2.21.7.2 @tab N @tab
 @item Default map-type for @code{map} clause in @code{target enter/exit data}
       @tab Y @tab
 @item New @code{doacross} clause as alias for @code{depend} with
-      @code{source}/@code{sink} modifier @tab N @tab
+      @code{source}/@code{sink} modifier @tab Y @tab
 @item Deprecation of @code{depend} with @code{source}/@code{sink} modifier
       @tab N @tab
-@item @code{omp_cur_iteration} keyword @tab N @tab
+@item @code{omp_cur_iteration} keyword @tab P
+      @tab @code{sink: omp_cur_iteration - 1} unsupported
 @end multitable
 
 @unnumberedsubsec Other new OpenMP 5.2 features
This page took 0.108511 seconds and 5 git commands to generate.