Fortran/openmp: Partial OpenMP 5.2 doacross and omp_cur_iteration support 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 | 38 +++- gcc/fortran/gfortran.h | 13 +- gcc/fortran/openmp.cc | 218 +++++++++++++-------- gcc/fortran/parse.cc | 3 +- gcc/fortran/trans-openmp.cc | 35 ++-- gcc/testsuite/gfortran.dg/gomp/all-memory-1.f90 | 2 +- .../gfortran.dg/gomp/depend-iterator-2.f90 | 2 +- gcc/testsuite/gfortran.dg/gomp/depobj-2.f90 | 6 +- gcc/testsuite/gfortran.dg/gomp/doacross-5.f90 | 88 +++++++++ gcc/testsuite/gfortran.dg/gomp/doacross-6.f90 | 77 ++++++++ libgomp/libgomp.texi | 5 +- 11 files changed, 370 insertions(+), 117 deletions(-) diff --git a/gcc/fortran/dump-parse-tree.cc b/gcc/fortran/dump-parse-tree.cc index 5352008a63d..40c690c9ae8 100644 --- a/gcc/fortran/dump-parse-tree.cc +++ b/gcc/fortran/dump-parse-tree.cc @@ -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) diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 696aadd7db6..4babd77924b 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -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; diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc index 594907714ff..5142fd7c608 100644 --- a/gcc/fortran/openmp.cc +++ b/gcc/fortran/openmp.cc @@ -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 ("% 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 ("% 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 % " + "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: diff --git a/gcc/fortran/parse.cc b/gcc/fortran/parse.cc index 80492c952aa..5b13441912a 100644 --- a/gcc/fortran/parse.cc +++ b/gcc/fortran/parse.cc @@ -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) diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc index 82c1079bc28..1be7d23f86b 100644 --- a/gcc/fortran/trans-openmp.cc +++ b/gcc/fortran/trans-openmp.cc @@ -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; diff --git a/gcc/testsuite/gfortran.dg/gomp/all-memory-1.f90 b/gcc/testsuite/gfortran.dg/gomp/all-memory-1.f90 index f8f34f0c887..51b5633adba 100644 --- a/gcc/testsuite/gfortran.dg/gomp/all-memory-1.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/all-memory-1.f90 @@ -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 diff --git a/gcc/testsuite/gfortran.dg/gomp/depend-iterator-2.f90 b/gcc/testsuite/gfortran.dg/gomp/depend-iterator-2.f90 index 21fc3272974..cadd9a06cfe 100644 --- a/gcc/testsuite/gfortran.dg/gomp/depend-iterator-2.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/depend-iterator-2.f90 @@ -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 diff --git a/gcc/testsuite/gfortran.dg/gomp/depobj-2.f90 b/gcc/testsuite/gfortran.dg/gomp/depobj-2.f90 index cb67c3ce9d1..6e7441d8d00 100644 --- a/gcc/testsuite/gfortran.dg/gomp/depobj-2.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/depobj-2.f90 @@ -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 index 00000000000..3a1679a1eec --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/doacross-5.f90 @@ -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 index 00000000000..a45e1c9386c --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/doacross-6.f90 @@ -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 diff --git a/libgomp/libgomp.texi b/libgomp/libgomp.texi index 0f2998cf8f1..3df979e170b 100644 --- a/libgomp/libgomp.texi +++ b/libgomp/libgomp.texi @@ -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