procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Fortran/openmp: Partial OpenMP 5.2 doacross and omp_cur_iteration support

Browse source 
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.
This commit is contained in:
Tobias Burnus 2022-09-05 18:05:24 +02:00
parent b4d8a56a4c
commit 938cda5360
11 changed files with 370 additions and 117 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

38
gcc/fortran/dump-parse-tree.cc
View 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)

13
gcc/fortran/gfortran.h
View 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;

218
gcc/fortran/openmp.cc
View 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;
}
c->depend_source = true;
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;
}
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:

3
gcc/fortran/parse.cc
View 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)

35
gcc/fortran/trans-openmp.cc
View 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;

2
gcc/testsuite/gfortran.dg/gomp/all-memory-1.f90
View 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

2
gcc/testsuite/gfortran.dg/gomp/depend-iterator-2.f90
View 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

6
gcc/testsuite/gfortran.dg/gomp/depobj-2.f90
View 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

88
gcc/testsuite/gfortran.dg/gomp/doacross-5.f90 Normal file
View file

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

77
gcc/testsuite/gfortran.dg/gomp/doacross-6.f90 Normal file
View file

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

5
libgomp/libgomp.texi
View 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