Hi Jakub
Updated patch attached – addressing your points:
On 28.04.21 15:41, Jakub Jelinek wrote:
On Tue, Apr 27, 2021 at 03:36:38PM +0200, Tobias Burnus wrote:
[...] (a) This patch add the iterator support to the Fortran FE
and adds support for it to the depend clause.
(b) It also adds a conforming stub implementation (parse & ignore in ME)
for 'affinity' (Fortran, C, C++)
(c) Fortran's taskwait did not handle the depend clause, now it does.
[...]
NOTE: The iterator Fortran patch includes one change from the post-OpenMP-5.0
spec:
The '::' after the typespec in order to avoid Fortran free-form source issues
with:
Is the :: optional or required in free-form?
Was discussed but at the end it was agreed to be required; this avoids
fixed/free differences and the other use also has it required.
I believe C evaluates them just once and it would be nice if that could be
the case for Fortran too.
Done now.
locator-list is used for both affinity and depend, so I guess the same.
I think at least for the latter C/C++ arranges that by using the same
iterator tree for the adjacent vars, so that the middle-end knows it can
just evaluate it once and emit one loop instead of one loop for each
variable separately.
Done likewise for Fortran and in the ME implementation for affinity.
For consistency, I think the syntax for other clauses puts space
before ( and before ) too.
Also, s/depend-modifier/aff-modifier/
Done (plus likewise further below.)
I think in this case it should
if (iterators)
pop_scope ();
parens.skip_until_found_close (parser);
before doing return list;
Done.
You could just use omp_clause_code_name[OMP_CLAUSE_CODE (c)] here.
Done.
Again, missing
if (iterators)
poplevel (0, 1, 0);
here.
Done.
Is this change specific to depend/affinity or iterators?
If not, shouldn't it go in separately and with a testcase that shows when it
is needed?
(Was applied separately - and backported to GCC 11)
+ case OMP_CLAUSE_AFFINITY:
+ /* Ignore. */
+ remove = true;
+ break;
I think removing affinity at this point is probably too early.
That will mean we e.g. won't diagnose invalid programs that e.g. use
default(none) on some outer OpenMP construct and then refer to variables
that aren't mentioned in any of the parallel/host teams clauses with such
default(none).
I did implement something - also putting all clauses with the same
iterators into one block.
Thanks for the comments.
Tobias
-----------------
Mentor Graphics (Deutschland) GmbH, Arnulfstrasse 201, 80634 München
Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung, Frank
Thürauf
OpenMP: Add iterator support to Fortran's depend; add affinity clause
gcc/c-family/ChangeLog:
* c-pragma.h (enum pragma_omp_clause): Add PRAGMA_OMP_CLAUSE_AFFINITY.
gcc/c/ChangeLog:
* c-parser.c (c_parser_omp_clause_affinity): New.
(c_parser_omp_clause_name, c_parser_omp_variable_list,
c_parser_omp_all_clauses, OMP_TASK_CLAUSE_MASK): Handle affinity clause.
* c-typeck.c (handle_omp_array_sections_1, handle_omp_array_sections,
c_finish_omp_clauses): Likewise.
gcc/cp/ChangeLog:
* parser.c (cp_parser_omp_clause_affinity): New.
(cp_parser_omp_clause_name, cp_parser_omp_var_list_no_open,
cp_parser_omp_all_clauses, OMP_TASK_CLAUSE_MASK): Handle affinity
clause.
* semantics.c (handle_omp_array_sections_1, handle_omp_array_sections,
finish_omp_clauses): Likewise.
gcc/fortran/ChangeLog:
* dump-parse-tree.c (show_iterator): New.
(show_omp_namelist): Handle iterators.
(show_omp_clauses): Handle affinity.
* gfortran.h (gfc_free_omp_namelist): New union with 'udr' and new 'ns'.
* match.c (gfc_free_omp_namelist): Add are to choose union element.
* openmp.c (gfc_free_omp_clauses, gfc_match_omp_detach): Update
call to gfc_free_omp_namelist.
(gfc_match_omp_variable_list): Likewise; permit preceeding whitespace.
(enum omp_mask1):
(gfc_match_iterator): New.
(gfc_match_omp_clause_reduction):
(gfc_match_omp_clauses):
(gfc_match_omp_flush):
(gfc_match_omp_taskwait): Match depend clause.
(resolve_omp_clauses): Handle affinity; update for udr/union change.
(gfc_resolve_omp_directive): Resolve clauses of taskwait.
* st.c (gfc_free_statement): Update gfc_free_omp_namelist call.
* trans-openmp.c (gfc_trans_omp_array_reduction_or_udr): Likewise
(handle_iterator): New.
(gfc_trans_omp_clauses): Handle iterators for depend/affinity clause.
(gfc_trans_omp_taskwait): Handle depend clause.
(gfc_trans_omp_directive): Update call.
gcc/ChangeLog:
* (gimplify_scan_omp_clauses): Ignore affinity clause.
* tree-core.h (enum omp_clause_code): Add OMP_CLAUSE_AFFINITY.
* tree-pretty-print.c (dump_omp_clause): Handle OMP_CLAUSE_AFFINITY.
* tree.c (omp_clause_num_ops, omp_clause_code_name): Add clause.
(walk_tree_1): Handle OMP_CLAUSE_AFFINITY.
libgomp/ChangeLog:
* testsuite/libgomp.fortran/depend-iterator-2.f90: New test.
gcc/testsuite/ChangeLog:
* c-c++-common/gomp/affinity-1.c: New test.
* c-c++-common/gomp/affinity-2.c: New test.
* c-c++-common/gomp/affinity-3.c: New test.
* c-c++-common/gomp/affinity-4.c: New test.
* c-c++-common/gomp/affinity-5.c: New test.
* c-c++-common/gomp/affinity-6.c: New test.
* gfortran.dg/gomp/affinity-clause-1.f90: New test.
* gfortran.dg/gomp/affinity-clause-2.f90: New test.
* gfortran.dg/gomp/affinity-clause-3.f90: New test.
* gfortran.dg/gomp/affinity-clause-4.f90: New test.
* gfortran.dg/gomp/depend-iterator-1.f90: New test.
* gfortran.dg/gomp/depend-iterator-2.f90: New test.
* gfortran.dg/gomp/depend-iterator-3.f90: New test.
* gfortran.dg/gomp/taskwait.f90: New test.
gcc/c-family/c-pragma.h | 1 +
gcc/c/c-parser.c | 69 ++++-
gcc/c/c-typeck.c | 52 ++--
gcc/cp/parser.c | 78 +++++-
gcc/cp/semantics.c | 53 ++--
gcc/fortran/dump-parse-tree.c | 51 +++-
gcc/fortran/gfortran.h | 9 +-
gcc/fortran/match.c | 18 +-
gcc/fortran/openmp.c | 282 ++++++++++++++++++---
gcc/fortran/st.c | 2 +-
gcc/fortran/trans-openmp.c | 198 ++++++++++++---
gcc/gimplify.c | 129 ++++++++++
gcc/testsuite/c-c++-common/gomp/affinity-1.c | 24 ++
gcc/testsuite/c-c++-common/gomp/affinity-2.c | 232 +++++++++++++++++
gcc/testsuite/c-c++-common/gomp/affinity-3.c | 77 ++++++
gcc/testsuite/c-c++-common/gomp/affinity-4.c | 77 ++++++
gcc/testsuite/c-c++-common/gomp/affinity-5.c | 32 +++
gcc/testsuite/c-c++-common/gomp/affinity-6.c | 36 +++
.../gfortran.dg/gomp/affinity-clause-1.f90 | 33 +++
.../gfortran.dg/gomp/affinity-clause-2.f90 | 27 ++
.../gfortran.dg/gomp/affinity-clause-3.f90 | 14 +
.../gfortran.dg/gomp/affinity-clause-4.f90 | 16 ++
.../gfortran.dg/gomp/depend-iterator-1.f90 | 45 ++++
.../gfortran.dg/gomp/depend-iterator-2.f90 | 44 ++++
.../gfortran.dg/gomp/depend-iterator-3.f90 | 27 ++
gcc/testsuite/gfortran.dg/gomp/taskwait.f90 | 7 +
gcc/tree-core.h | 3 +
gcc/tree-pretty-print.c | 23 +-
gcc/tree.c | 3 +
.../libgomp.fortran/depend-iterator-2.f90 | 89 +++++++
30 files changed, 1608 insertions(+), 143 deletions(-)
diff --git a/gcc/c-family/c-pragma.h b/gcc/c-family/c-pragma.h
index 6c34ffa5be4..e4fd3c9b740 100644
--- a/gcc/c-family/c-pragma.h
+++ b/gcc/c-family/c-pragma.h
@@ -86,6 +86,7 @@ enum pragma_kind {
enum pragma_omp_clause {
PRAGMA_OMP_CLAUSE_NONE = 0,
+ PRAGMA_OMP_CLAUSE_AFFINITY,
PRAGMA_OMP_CLAUSE_ALIGNED,
PRAGMA_OMP_CLAUSE_ALLOCATE,
PRAGMA_OMP_CLAUSE_BIND,
diff --git a/gcc/c/c-parser.c b/gcc/c/c-parser.c
index b9930d487fd..866fcb4dabc 100644
--- a/gcc/c/c-parser.c
+++ b/gcc/c/c-parser.c
@@ -12601,7 +12601,9 @@ c_parser_omp_clause_name (c_parser *parser)
switch (p[0])
{
case 'a':
- if (!strcmp ("aligned", p))
+ if (!strcmp ("affinity", p))
+ result = PRAGMA_OMP_CLAUSE_AFFINITY;
+ else if (!strcmp ("aligned", p))
result = PRAGMA_OMP_CLAUSE_ALIGNED;
else if (!strcmp ("allocate", p))
result = PRAGMA_OMP_CLAUSE_ALLOCATE;
@@ -12900,7 +12902,7 @@ c_parser_omp_variable_list (c_parser *parser,
while (1)
{
bool array_section_p = false;
- if (kind == OMP_CLAUSE_DEPEND)
+ if (kind == OMP_CLAUSE_DEPEND || kind == OMP_CLAUSE_AFFINITY)
{
if (c_parser_next_token_is_not (parser, CPP_NAME)
|| c_parser_peek_token (parser)->id_kind != C_ID_ID)
@@ -13040,6 +13042,7 @@ c_parser_omp_variable_list (c_parser *parser,
t = build_component_ref (op_loc, t, ident, comp_loc);
}
/* FALLTHROUGH */
+ case OMP_CLAUSE_AFFINITY:
case OMP_CLAUSE_DEPEND:
case OMP_CLAUSE_REDUCTION:
case OMP_CLAUSE_IN_REDUCTION:
@@ -13090,7 +13093,7 @@ c_parser_omp_variable_list (c_parser *parser,
t = tree_cons (low_bound, length, t);
}
- if (kind == OMP_CLAUSE_DEPEND
+ if ((kind == OMP_CLAUSE_DEPEND || kind == OMP_CLAUSE_AFFINITY)
&& t != error_mark_node
&& parser->tokens_avail != 2)
{
@@ -13130,7 +13133,7 @@ c_parser_omp_variable_list (c_parser *parser,
else
list = tree_cons (t, NULL_TREE, list);
- if (kind == OMP_CLAUSE_DEPEND)
+ if (kind == OMP_CLAUSE_DEPEND || kind == OMP_CLAUSE_AFFINITY)
{
parser->tokens = &parser->tokens_buf[0];
parser->tokens_avail = tokens_avail;
@@ -15508,6 +15511,57 @@ c_parser_omp_iterators (c_parser *parser)
return ret ? ret : error_mark_node;
}
+/* OpenMP 5.0:
+ affinity ( [aff-modifier :] variable-list )
+ aff-modifier:
+ iterator ( iterators-definition ) */
+
+static tree
+c_parser_omp_clause_affinity (c_parser *parser, tree list)
+{
+ location_t clause_loc = c_parser_peek_token (parser)->location;
+ tree nl, iterators = NULL_TREE;
+
+ matching_parens parens;
+ if (!parens.require_open (parser))
+ return list;
+
+ if (c_parser_next_token_is (parser, CPP_NAME))
+ {
+ const char *p = IDENTIFIER_POINTER (c_parser_peek_token (parser)->value);
+ if (strcmp ("iterator", p) == 0)
+ {
+ iterators = c_parser_omp_iterators (parser);
+ if (!c_parser_require (parser, CPP_COLON, "expected %<:%>"))
+ {
+ if (iterators)
+ pop_scope ();
+ parens.skip_until_found_close (parser);
+ return list;
+ }
+ }
+ }
+ nl = c_parser_omp_variable_list (parser, clause_loc, OMP_CLAUSE_AFFINITY,
+ list);
+ if (iterators)
+ {
+ tree block = pop_scope ();
+ if (iterators == error_mark_node)
+ iterators = NULL_TREE;
+ else
+ {
+ TREE_VEC_ELT (iterators, 5) = block;
+ for (tree c = nl; c != list; c = OMP_CLAUSE_CHAIN (c))
+ OMP_CLAUSE_DECL (c) = build_tree_list (iterators,
+ OMP_CLAUSE_DECL (c));
+ }
+ }
+
+ parens.skip_until_found_close (parser);
+ return nl;
+}
+
+
/* OpenMP 4.0:
depend ( depend-kind: variable-list )
@@ -16474,6 +16528,10 @@ c_parser_omp_all_clauses (c_parser *parser, omp_clause_mask mask,
clauses = c_parser_omp_clause_linear (parser, clauses);
c_name = "linear";
break;
+ case PRAGMA_OMP_CLAUSE_AFFINITY:
+ clauses = c_parser_omp_clause_affinity (parser, clauses);
+ c_name = "affinity";
+ break;
case PRAGMA_OMP_CLAUSE_DEPEND:
clauses = c_parser_omp_clause_depend (parser, clauses);
c_name = "depend";
@@ -19249,7 +19307,8 @@ c_parser_omp_single (location_t loc, c_parser *parser, bool *if_p)
| (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_PRIORITY) \
| (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_ALLOCATE) \
| (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_IN_REDUCTION) \
- | (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_DETACH))
+ | (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_DETACH) \
+ | (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_AFFINITY))
static tree
c_parser_omp_task (location_t loc, c_parser *parser, bool *if_p)
diff --git a/gcc/c/c-typeck.c b/gcc/c/c-typeck.c
index fc64ef96fb8..bee01df1234 100644
--- a/gcc/c/c-typeck.c
+++ b/gcc/c/c-typeck.c
@@ -13064,7 +13064,8 @@ handle_omp_array_sections_1 (tree c, tree t, vec<tree> &types,
if (error_operand_p (t))
return error_mark_node;
ret = t;
- if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_DEPEND
+ if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_AFFINITY
+ && OMP_CLAUSE_CODE (c) != OMP_CLAUSE_DEPEND
&& TYPE_ATOMIC (strip_array_types (TREE_TYPE (t))))
{
error_at (OMP_CLAUSE_LOCATION (c), "%<_Atomic%> %qE in %qs clause",
@@ -13115,14 +13116,16 @@ handle_omp_array_sections_1 (tree c, tree t, vec<tree> &types,
omp_clause_code_name[OMP_CLAUSE_CODE (c)]);
return error_mark_node;
}
- else if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_DEPEND
+ else if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_AFFINITY
+ && OMP_CLAUSE_CODE (c) != OMP_CLAUSE_DEPEND
&& TYPE_ATOMIC (TREE_TYPE (t)))
{
error_at (OMP_CLAUSE_LOCATION (c), "%<_Atomic%> %qD in %qs clause",
t, omp_clause_code_name[OMP_CLAUSE_CODE (c)]);
return error_mark_node;
}
- else if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_DEPEND
+ else if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_AFFINITY
+ && OMP_CLAUSE_CODE (c) != OMP_CLAUSE_DEPEND
&& VAR_P (t)
&& DECL_THREAD_LOCAL_P (t))
{
@@ -13131,7 +13134,8 @@ handle_omp_array_sections_1 (tree c, tree t, vec<tree> &types,
omp_clause_code_name[OMP_CLAUSE_CODE (c)]);
return error_mark_node;
}
- if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND
+ if ((OMP_CLAUSE_CODE (c) == OMP_CLAUSE_AFFINITY
+ || OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND)
&& TYPE_ATOMIC (TREE_TYPE (t))
&& POINTER_TYPE_P (TREE_TYPE (t)))
{
@@ -13202,7 +13206,8 @@ handle_omp_array_sections_1 (tree c, tree t, vec<tree> &types,
{
if (!integer_nonzerop (length))
{
- if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND
+ if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_AFFINITY
+ || OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND
|| OMP_CLAUSE_CODE (c) == OMP_CLAUSE_REDUCTION
|| OMP_CLAUSE_CODE (c) == OMP_CLAUSE_IN_REDUCTION
|| OMP_CLAUSE_CODE (c) == OMP_CLAUSE_TASK_REDUCTION)
@@ -13270,7 +13275,8 @@ handle_omp_array_sections_1 (tree c, tree t, vec<tree> &types,
}
if (tree_int_cst_equal (size, low_bound))
{
- if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND
+ if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_AFFINITY
+ || OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND
|| OMP_CLAUSE_CODE (c) == OMP_CLAUSE_REDUCTION
|| OMP_CLAUSE_CODE (c) == OMP_CLAUSE_IN_REDUCTION
|| OMP_CLAUSE_CODE (c) == OMP_CLAUSE_TASK_REDUCTION)
@@ -13291,7 +13297,8 @@ handle_omp_array_sections_1 (tree c, tree t, vec<tree> &types,
}
else if (length == NULL_TREE)
{
- if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_DEPEND
+ if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_AFFINITY
+ && OMP_CLAUSE_CODE (c) != OMP_CLAUSE_DEPEND
&& OMP_CLAUSE_CODE (c) != OMP_CLAUSE_REDUCTION
&& OMP_CLAUSE_CODE (c) != OMP_CLAUSE_IN_REDUCTION
&& OMP_CLAUSE_CODE (c) != OMP_CLAUSE_TASK_REDUCTION)
@@ -13329,7 +13336,8 @@ handle_omp_array_sections_1 (tree c, tree t, vec<tree> &types,
}
else if (length == NULL_TREE)
{
- if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_DEPEND
+ if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_AFFINITY
+ && OMP_CLAUSE_CODE (c) != OMP_CLAUSE_DEPEND
&& OMP_CLAUSE_CODE (c) != OMP_CLAUSE_REDUCTION
&& OMP_CLAUSE_CODE (c) != OMP_CLAUSE_IN_REDUCTION
&& OMP_CLAUSE_CODE (c) != OMP_CLAUSE_TASK_REDUCTION)
@@ -13374,6 +13382,7 @@ handle_omp_array_sections_1 (tree c, tree t, vec<tree> &types,
/* If there is a pointer type anywhere but in the very first
array-section-subscript, the array section can't be contiguous. */
if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_DEPEND
+ && OMP_CLAUSE_CODE (c) != OMP_CLAUSE_AFFINITY
&& TREE_CODE (TREE_CHAIN (t)) == TREE_LIST)
{
error_at (OMP_CLAUSE_LOCATION (c),
@@ -13410,7 +13419,8 @@ handle_omp_array_sections (tree c, enum c_omp_region_type ort)
unsigned int first_non_one = 0;
auto_vec<tree, 10> types;
tree *tp = &OMP_CLAUSE_DECL (c);
- if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND
+ if ((OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND
+ || OMP_CLAUSE_CODE (c) == OMP_CLAUSE_AFFINITY)
&& TREE_CODE (*tp) == TREE_LIST
&& TREE_PURPOSE (*tp)
&& TREE_CODE (TREE_PURPOSE (*tp)) == TREE_VEC)
@@ -13422,7 +13432,8 @@ handle_omp_array_sections (tree c, enum c_omp_region_type ort)
return true;
if (first == NULL_TREE)
return false;
- if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND)
+ if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND
+ || OMP_CLAUSE_CODE (c) == OMP_CLAUSE_AFFINITY)
{
tree t = *tp;
tree tem = NULL_TREE;
@@ -14531,6 +14542,7 @@ c_finish_omp_clauses (tree clauses, enum c_omp_region_type ort)
}
break;
+ case OMP_CLAUSE_AFFINITY:
case OMP_CLAUSE_DEPEND:
t = OMP_CLAUSE_DECL (c);
if (t == NULL_TREE)
@@ -14539,7 +14551,8 @@ c_finish_omp_clauses (tree clauses, enum c_omp_region_type ort)
== OMP_CLAUSE_DEPEND_SOURCE);
break;
}
- if (OMP_CLAUSE_DEPEND_KIND (c) == OMP_CLAUSE_DEPEND_SINK)
+ if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND
+ && OMP_CLAUSE_DEPEND_KIND (c) == OMP_CLAUSE_DEPEND_SINK)
{
gcc_assert (TREE_CODE (t) == TREE_LIST);
for (; t; t = TREE_CHAIN (t))
@@ -14585,7 +14598,8 @@ c_finish_omp_clauses (tree clauses, enum c_omp_region_type ort)
{
if (handle_omp_array_sections (c, ort))
remove = true;
- else if (OMP_CLAUSE_DEPEND_KIND (c) == OMP_CLAUSE_DEPEND_DEPOBJ)
+ else if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND
+ && OMP_CLAUSE_DEPEND_KIND (c) == OMP_CLAUSE_DEPEND_DEPOBJ)
{
error_at (OMP_CLAUSE_LOCATION (c),
"%<depend%> clause with %<depobj%> dependence "
@@ -14600,17 +14614,22 @@ c_finish_omp_clauses (tree clauses, enum c_omp_region_type ort)
{
error_at (OMP_CLAUSE_LOCATION (c),
"%qE is not lvalue expression nor array section in "
- "%<depend%> clause", t);
+ "%qs clause", t,
+ omp_clause_code_name[OMP_CLAUSE_CODE (c)]);
remove = true;
}
else if (TREE_CODE (t) == COMPONENT_REF
&& DECL_C_BIT_FIELD (TREE_OPERAND (t, 1)))
{
+ gcc_assert (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND
+ || OMP_CLAUSE_CODE (c) == OMP_CLAUSE_AFFINITY);
error_at (OMP_CLAUSE_LOCATION (c),
- "bit-field %qE in %qs clause", t, "depend");
+ "bit-field %qE in %qs clause", t,
+ omp_clause_code_name[OMP_CLAUSE_CODE (c)]);
remove = true;
}
- else if (OMP_CLAUSE_DEPEND_KIND (c) == OMP_CLAUSE_DEPEND_DEPOBJ)
+ else if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND
+ && OMP_CLAUSE_DEPEND_KIND (c) == OMP_CLAUSE_DEPEND_DEPOBJ)
{
if (!c_omp_depend_t_p (TREE_TYPE (t)))
{
@@ -14621,7 +14640,8 @@ c_finish_omp_clauses (tree clauses, enum c_omp_region_type ort)
remove = true;
}
}
- else if (c_omp_depend_t_p (TREE_TYPE (t)))
+ else if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND
+ && c_omp_depend_t_p (TREE_TYPE (t)))
{
error_at (OMP_CLAUSE_LOCATION (c),
"%qE should not have %<omp_depend_t%> type in "
diff --git a/gcc/cp/parser.c b/gcc/cp/parser.c
index 48b83d67b34..f4ca9d2dfba 100644
--- a/gcc/cp/parser.c
+++ b/gcc/cp/parser.c
@@ -35117,7 +35117,9 @@ cp_parser_omp_clause_name (cp_parser *parser)
switch (p[0])
{
case 'a':
- if (!strcmp ("aligned", p))
+ if (!strcmp ("affinity", p))
+ result = PRAGMA_OMP_CLAUSE_AFFINITY;
+ else if (!strcmp ("aligned", p))
result = PRAGMA_OMP_CLAUSE_ALIGNED;
else if (!strcmp ("allocate", p))
result = PRAGMA_OMP_CLAUSE_ALLOCATE;
@@ -35376,7 +35378,7 @@ cp_parser_omp_var_list_no_open (cp_parser *parser, enum omp_clause_code kind,
{
tree name, decl;
- if (kind == OMP_CLAUSE_DEPEND)
+ if (kind == OMP_CLAUSE_DEPEND || kind == OMP_CLAUSE_AFFINITY)
cp_parser_parse_tentatively (parser);
token = cp_lexer_peek_token (parser->lexer);
if (kind != 0
@@ -35405,7 +35407,7 @@ cp_parser_omp_var_list_no_open (cp_parser *parser, enum omp_clause_code kind,
/*optional_p=*/false);
if (name == error_mark_node)
{
- if (kind == OMP_CLAUSE_DEPEND
+ if ((kind == OMP_CLAUSE_DEPEND || kind == OMP_CLAUSE_AFFINITY)
&& cp_parser_simulate_error (parser))
goto depend_lvalue;
goto skip_comma;
@@ -35417,7 +35419,7 @@ cp_parser_omp_var_list_no_open (cp_parser *parser, enum omp_clause_code kind,
decl = name;
if (decl == error_mark_node)
{
- if (kind == OMP_CLAUSE_DEPEND
+ if ((kind == OMP_CLAUSE_DEPEND || kind == OMP_CLAUSE_AFFINITY)
&& cp_parser_simulate_error (parser))
goto depend_lvalue;
cp_parser_name_lookup_error (parser, name, decl, NLE_NULL,
@@ -35463,6 +35465,7 @@ cp_parser_omp_var_list_no_open (cp_parser *parser, enum omp_clause_code kind,
&idk, loc);
}
/* FALLTHROUGH. */
+ case OMP_CLAUSE_AFFINITY:
case OMP_CLAUSE_DEPEND:
case OMP_CLAUSE_REDUCTION:
case OMP_CLAUSE_IN_REDUCTION:
@@ -35489,12 +35492,12 @@ cp_parser_omp_var_list_no_open (cp_parser *parser, enum omp_clause_code kind,
/* Look for `:'. */
if (!cp_parser_require (parser, CPP_COLON, RT_COLON))
{
- if (kind == OMP_CLAUSE_DEPEND
+ if ((kind == OMP_CLAUSE_DEPEND || kind == OMP_CLAUSE_AFFINITY)
&& cp_parser_simulate_error (parser))
goto depend_lvalue;
goto skip_comma;
}
- if (kind == OMP_CLAUSE_DEPEND)
+ if (kind == OMP_CLAUSE_DEPEND || kind == OMP_CLAUSE_AFFINITY)
cp_parser_commit_to_tentative_parse (parser);
if (!cp_lexer_next_token_is (parser->lexer,
CPP_CLOSE_SQUARE))
@@ -35508,7 +35511,7 @@ cp_parser_omp_var_list_no_open (cp_parser *parser, enum omp_clause_code kind,
if (!cp_parser_require (parser, CPP_CLOSE_SQUARE,
RT_CLOSE_SQUARE))
{
- if (kind == OMP_CLAUSE_DEPEND
+ if ((kind == OMP_CLAUSE_DEPEND || kind == OMP_CLAUSE_AFFINITY)
&& cp_parser_simulate_error (parser))
goto depend_lvalue;
goto skip_comma;
@@ -35521,7 +35524,7 @@ cp_parser_omp_var_list_no_open (cp_parser *parser, enum omp_clause_code kind,
break;
}
- if (kind == OMP_CLAUSE_DEPEND)
+ if (kind == OMP_CLAUSE_DEPEND || kind == OMP_CLAUSE_AFFINITY)
{
if (cp_lexer_next_token_is_not (parser->lexer, CPP_COMMA)
&& cp_lexer_next_token_is_not (parser->lexer, CPP_CLOSE_PAREN)
@@ -37761,6 +37764,58 @@ cp_parser_omp_iterators (cp_parser *parser)
return ret ? ret : error_mark_node;
}
+/* OpenMP 5.0:
+ affinity ( [aff-modifier :] variable-list )
+ aff-modifier:
+ iterator ( iterators-definition ) */
+
+static tree
+cp_parser_omp_clause_affinity (cp_parser *parser, tree list)
+{
+ tree nlist, c, iterators = NULL_TREE;
+
+ matching_parens parens;
+ if (!parens.require_open (parser))
+ return list;
+
+ if (cp_lexer_next_token_is (parser->lexer, CPP_NAME))
+ {
+ tree id = cp_lexer_peek_token (parser->lexer)->u.value;
+ const char *p = IDENTIFIER_POINTER (id);
+ if (strcmp ("iterator", p) == 0)
+ {
+ begin_scope (sk_omp, NULL);
+ iterators = cp_parser_omp_iterators (parser);
+ if (!cp_parser_require (parser, CPP_COLON, RT_COLON))
+ {
+ if (iterators)
+ poplevel (0, 1, 0);
+ cp_parser_skip_to_closing_parenthesis (parser,
+ /*recovering=*/true,
+ /*or_comma=*/false,
+ /*consume_paren=*/true);
+ return list;
+ }
+ }
+ }
+ nlist = cp_parser_omp_var_list_no_open (parser, OMP_CLAUSE_AFFINITY,
+ list, NULL);
+ if (iterators)
+ {
+ tree block = poplevel (1, 1, 0);
+ if (iterators == error_mark_node)
+ iterators = NULL_TREE;
+ else
+ {
+ TREE_VEC_ELT (iterators, 5) = block;
+ for (c = nlist; c != list; c = OMP_CLAUSE_CHAIN (c))
+ OMP_CLAUSE_DECL (c) = build_tree_list (iterators,
+ OMP_CLAUSE_DECL (c));
+ }
+ }
+ return nlist;
+}
+
/* OpenMP 4.0:
depend ( depend-kind : variable-list )
@@ -38753,6 +38808,10 @@ cp_parser_omp_all_clauses (cp_parser *parser, omp_clause_mask mask,
}
c_name = "linear";
break;
+ case PRAGMA_OMP_CLAUSE_AFFINITY:
+ clauses = cp_parser_omp_clause_affinity (parser, clauses);
+ c_name = "affinity";
+ break;
case PRAGMA_OMP_CLAUSE_DEPEND:
clauses = cp_parser_omp_clause_depend (parser, clauses,
token->location);
@@ -41349,7 +41408,8 @@ cp_parser_omp_single (cp_parser *parser, cp_token *pragma_tok, bool *if_p)
| (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_PRIORITY) \
| (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_ALLOCATE) \
| (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_IN_REDUCTION) \
- | (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_DETACH))
+ | (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_DETACH) \
+ | (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_AFFINITY))
static tree
cp_parser_omp_task (cp_parser *parser, cp_token *pragma_tok, bool *if_p)
diff --git a/gcc/cp/semantics.c b/gcc/cp/semantics.c
index fffbe40613e..6fafd0648e0 100644
--- a/gcc/cp/semantics.c
+++ b/gcc/cp/semantics.c
@@ -4993,7 +4993,8 @@ handle_omp_array_sections_1 (tree c, tree t, vec<tree> &types,
" clauses");
return error_mark_node;
}
- else if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_DEPEND
+ else if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_AFFINITY
+ && OMP_CLAUSE_CODE (c) != OMP_CLAUSE_DEPEND
&& VAR_P (t) && CP_DECL_THREAD_LOCAL_P (t))
{
error_at (OMP_CLAUSE_LOCATION (c),
@@ -5080,7 +5081,8 @@ handle_omp_array_sections_1 (tree c, tree t, vec<tree> &types,
{
if (!integer_nonzerop (length))
{
- if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND
+ if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_AFFINITY
+ || OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND
|| OMP_CLAUSE_CODE (c) == OMP_CLAUSE_REDUCTION
|| OMP_CLAUSE_CODE (c) == OMP_CLAUSE_IN_REDUCTION
|| OMP_CLAUSE_CODE (c) == OMP_CLAUSE_TASK_REDUCTION)
@@ -5148,7 +5150,8 @@ handle_omp_array_sections_1 (tree c, tree t, vec<tree> &types,
}
if (tree_int_cst_equal (size, low_bound))
{
- if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND
+ if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_AFFINITY
+ || OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND
|| OMP_CLAUSE_CODE (c) == OMP_CLAUSE_REDUCTION
|| OMP_CLAUSE_CODE (c) == OMP_CLAUSE_IN_REDUCTION
|| OMP_CLAUSE_CODE (c) == OMP_CLAUSE_TASK_REDUCTION)
@@ -5169,7 +5172,8 @@ handle_omp_array_sections_1 (tree c, tree t, vec<tree> &types,
}
else if (length == NULL_TREE)
{
- if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_DEPEND
+ if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_AFFINITY
+ && OMP_CLAUSE_CODE (c) != OMP_CLAUSE_DEPEND
&& OMP_CLAUSE_CODE (c) != OMP_CLAUSE_REDUCTION
&& OMP_CLAUSE_CODE (c) != OMP_CLAUSE_IN_REDUCTION
&& OMP_CLAUSE_CODE (c) != OMP_CLAUSE_TASK_REDUCTION)
@@ -5207,7 +5211,8 @@ handle_omp_array_sections_1 (tree c, tree t, vec<tree> &types,
}
else if (length == NULL_TREE)
{
- if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_DEPEND
+ if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_AFFINITY
+ && OMP_CLAUSE_CODE (c) != OMP_CLAUSE_DEPEND
&& OMP_CLAUSE_CODE (c) != OMP_CLAUSE_REDUCTION
&& OMP_CLAUSE_CODE (c) != OMP_CLAUSE_IN_REDUCTION
&& OMP_CLAUSE_CODE (c) != OMP_CLAUSE_TASK_REDUCTION)
@@ -5251,7 +5256,8 @@ handle_omp_array_sections_1 (tree c, tree t, vec<tree> &types,
}
/* If there is a pointer type anywhere but in the very first
array-section-subscript, the array section can't be contiguous. */
- if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_DEPEND
+ if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_AFFINITY
+ && OMP_CLAUSE_CODE (c) != OMP_CLAUSE_DEPEND
&& TREE_CODE (TREE_CHAIN (t)) == TREE_LIST)
{
error_at (OMP_CLAUSE_LOCATION (c),
@@ -5299,7 +5305,8 @@ handle_omp_array_sections (tree c, enum c_omp_region_type ort)
unsigned int first_non_one = 0;
auto_vec<tree, 10> types;
tree *tp = &OMP_CLAUSE_DECL (c);
- if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND
+ if ((OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND
+ || OMP_CLAUSE_CODE (c) == OMP_CLAUSE_AFFINITY)
&& TREE_CODE (*tp) == TREE_LIST
&& TREE_PURPOSE (*tp)
&& TREE_CODE (TREE_PURPOSE (*tp)) == TREE_VEC)
@@ -5311,7 +5318,8 @@ handle_omp_array_sections (tree c, enum c_omp_region_type ort)
return true;
if (first == NULL_TREE)
return false;
- if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND)
+ if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND
+ || OMP_CLAUSE_CODE (c) == OMP_CLAUSE_AFFINITY)
{
tree t = *tp;
tree tem = NULL_TREE;
@@ -7445,6 +7453,7 @@ finish_omp_clauses (tree clauses, enum c_omp_region_type ort)
}
goto handle_field_decl;
+ case OMP_CLAUSE_AFFINITY:
case OMP_CLAUSE_DEPEND:
t = OMP_CLAUSE_DECL (c);
if (t == NULL_TREE)
@@ -7453,7 +7462,8 @@ finish_omp_clauses (tree clauses, enum c_omp_region_type ort)
== OMP_CLAUSE_DEPEND_SOURCE);
break;
}
- if (OMP_CLAUSE_DEPEND_KIND (c) == OMP_CLAUSE_DEPEND_SINK)
+ if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND
+ && OMP_CLAUSE_DEPEND_KIND (c) == OMP_CLAUSE_DEPEND_SINK)
{
if (cp_finish_omp_clause_depend_sink (c))
remove = true;
@@ -7478,7 +7488,9 @@ finish_omp_clauses (tree clauses, enum c_omp_region_type ort)
{
if (handle_omp_array_sections (c, ort))
remove = true;
- else if (OMP_CLAUSE_DEPEND_KIND (c) == OMP_CLAUSE_DEPEND_DEPOBJ)
+ else if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND
+ && (OMP_CLAUSE_DEPEND_KIND (c)
+ == OMP_CLAUSE_DEPEND_DEPOBJ))
{
error_at (OMP_CLAUSE_LOCATION (c),
"%<depend%> clause with %<depobj%> dependence "
@@ -7503,22 +7515,28 @@ finish_omp_clauses (tree clauses, enum c_omp_region_type ort)
if (DECL_P (t))
error_at (OMP_CLAUSE_LOCATION (c),
"%qD is not lvalue expression nor array section "
- "in %<depend%> clause", t);
+ "in %qs clause", t,
+ omp_clause_code_name[OMP_CLAUSE_CODE (c)]);
else
error_at (OMP_CLAUSE_LOCATION (c),
"%qE is not lvalue expression nor array section "
- "in %<depend%> clause", t);
+ "in %qs clause", t,
+ omp_clause_code_name[OMP_CLAUSE_CODE (c)]);
remove = true;
}
else if (TREE_CODE (t) == COMPONENT_REF
&& TREE_CODE (TREE_OPERAND (t, 1)) == FIELD_DECL
&& DECL_BIT_FIELD (TREE_OPERAND (t, 1)))
{
+ gcc_assert (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND
+ || OMP_CLAUSE_CODE (c) == OMP_CLAUSE_AFFINITY);
error_at (OMP_CLAUSE_LOCATION (c),
- "bit-field %qE in %qs clause", t, "depend");
+ "bit-field %qE in %qs clause", t,
+ omp_clause_code_name[OMP_CLAUSE_CODE (c)]);
remove = true;
}
- else if (OMP_CLAUSE_DEPEND_KIND (c) == OMP_CLAUSE_DEPEND_DEPOBJ)
+ else if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND
+ && OMP_CLAUSE_DEPEND_KIND (c) == OMP_CLAUSE_DEPEND_DEPOBJ)
{
if (!c_omp_depend_t_p (TYPE_REF_P (TREE_TYPE (t))
? TREE_TYPE (TREE_TYPE (t))
@@ -7531,9 +7549,10 @@ finish_omp_clauses (tree clauses, enum c_omp_region_type ort)
remove = true;
}
}
- else if (c_omp_depend_t_p (TYPE_REF_P (TREE_TYPE (t))
- ? TREE_TYPE (TREE_TYPE (t))
- : TREE_TYPE (t)))
+ else if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND
+ && c_omp_depend_t_p (TYPE_REF_P (TREE_TYPE (t))
+ ? TREE_TYPE (TREE_TYPE (t))
+ : TREE_TYPE (t)))
{
error_at (OMP_CLAUSE_LOCATION (c),
"%qE should not have %<omp_depend_t%> type in "
diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
index 874e6d4a837..93ff572cbd2 100644
--- a/gcc/fortran/dump-parse-tree.c
+++ b/gcc/fortran/dump-parse-tree.c
@@ -1297,11 +1297,56 @@ show_code (int level, gfc_code *c)
show_code_node (level, c);
}
+static void
+show_iterator (gfc_namespace *ns)
+{
+ for (gfc_symbol *sym = ns->proc_name; sym; sym = sym->tlink)
+ {
+ gfc_constructor *c;
+ if (sym != ns->proc_name)
+ fputc (',', dumpfile);
+ fputs (sym->name, dumpfile);
+ fputc ('=', dumpfile);
+ c = gfc_constructor_first (sym->value->value.constructor);
+ show_expr (c->expr);
+ fputc (':', dumpfile);
+ c = gfc_constructor_next (c);
+ show_expr (c->expr);
+ c = gfc_constructor_next (c);
+ if (c)
+ {
+ fputc (':', dumpfile);
+ show_expr (c->expr);
+ }
+ }
+}
+
static void
show_omp_namelist (int list_type, gfc_omp_namelist *n)
{
+ gfc_namespace *ns_iter = NULL, *ns_curr = gfc_current_ns;
+ gfc_omp_namelist *n2 = n;
for (; n; n = n->next)
{
+ gfc_current_ns = ns_curr;
+ if (list_type == OMP_LIST_AFFINITY || list_type == OMP_LIST_DEPEND)
+ {
+ gfc_current_ns = n->u2.ns ? n->u2.ns : ns_curr;
+ if (n->u2.ns != ns_iter)
+ {
+ if (n != n2)
+ fputs (list_type == OMP_LIST_AFFINITY
+ ? ") AFFINITY(" : ") DEPEND(", dumpfile);
+ if (n->u2.ns)
+ {
+ fputs ("ITERATOR(", dumpfile);
+ show_iterator (n->u2.ns);
+ fputc (')', dumpfile);
+ fputc (list_type == OMP_LIST_AFFINITY ? ':' : ',', dumpfile);
+ }
+ }
+ ns_iter = n->u2.ns;
+ }
if (list_type == OMP_LIST_REDUCTION)
switch (n->u.reduction_op)
{
@@ -1321,8 +1366,8 @@ show_omp_namelist (int list_type, gfc_omp_namelist *n)
case OMP_REDUCTION_IOR: fputs ("ior:", dumpfile); break;
case OMP_REDUCTION_IEOR: fputs ("ieor:", dumpfile); break;
case OMP_REDUCTION_USER:
- if (n->udr)
- fprintf (dumpfile, "%s:", n->udr->udr->name);
+ if (n->u2.udr)
+ fprintf (dumpfile, "%s:", n->u2.udr->udr->name);
break;
default: break;
}
@@ -1387,6 +1432,7 @@ show_omp_namelist (int list_type, gfc_omp_namelist *n)
if (n->next)
fputc (',', dumpfile);
}
+ gfc_current_ns = ns_curr;
}
@@ -1610,6 +1656,7 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses)
case OMP_LIST_SHARED: type = "SHARED"; break;
case OMP_LIST_COPYIN: type = "COPYIN"; break;
case OMP_LIST_UNIFORM: type = "UNIFORM"; break;
+ 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;
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index bab785bceb7..55fba04642a 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1257,7 +1257,11 @@ typedef struct gfc_omp_namelist
struct gfc_common_head *common;
bool lastprivate_conditional;
} u;
- struct gfc_omp_namelist_udr *udr;
+ union
+ {
+ struct gfc_omp_namelist_udr *udr;
+ gfc_namespace *ns;
+ } u2;
struct gfc_omp_namelist *next;
locus where;
}
@@ -1275,6 +1279,7 @@ enum
OMP_LIST_SHARED,
OMP_LIST_COPYIN,
OMP_LIST_UNIFORM,
+ OMP_LIST_AFFINITY,
OMP_LIST_ALIGNED,
OMP_LIST_LINEAR,
OMP_LIST_DEPEND,
@@ -3321,7 +3326,7 @@ void gfc_free_iterator (gfc_iterator *, int);
void gfc_free_forall_iterator (gfc_forall_iterator *);
void gfc_free_alloc_list (gfc_alloc *);
void gfc_free_namelist (gfc_namelist *);
-void gfc_free_omp_namelist (gfc_omp_namelist *);
+void gfc_free_omp_namelist (gfc_omp_namelist *, bool);
void gfc_free_equiv (gfc_equiv *);
void gfc_free_equiv_until (gfc_equiv *, gfc_equiv *);
void gfc_free_data (gfc_data *);
diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index 393755e4d93..29462013038 100644
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -5470,20 +5470,22 @@ gfc_free_namelist (gfc_namelist *name)
/* Free an OpenMP namelist structure. */
void
-gfc_free_omp_namelist (gfc_omp_namelist *name)
+gfc_free_omp_namelist (gfc_omp_namelist *name, bool free_ns)
{
gfc_omp_namelist *n;
for (; name; name = n)
{
gfc_free_expr (name->expr);
- if (name->udr)
- {
- if (name->udr->combiner)
- gfc_free_statement (name->udr->combiner);
- if (name->udr->initializer)
- gfc_free_statement (name->udr->initializer);
- free (name->udr);
+ if (free_ns)
+ gfc_free_namespace (name->u2.ns);
+ else if (name->u2.udr)
+ {
+ if (name->u2.udr->combiner)
+ gfc_free_statement (name->u2.udr->combiner);
+ if (name->u2.udr->initializer)
+ gfc_free_statement (name->u2.udr->initializer);
+ free (name->u2.udr);
}
n = name->next;
free (name);
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index cf4d7baafff..ac482fd43c6 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -25,6 +25,7 @@ along with GCC; see the file COPYING3. If not see
#include "arith.h"
#include "match.h"
#include "parse.h"
+#include "constructor.h"
#include "diagnostic.h"
#include "gomp-constants.h"
@@ -103,7 +104,8 @@ gfc_free_omp_clauses (gfc_omp_clauses *c)
gfc_free_expr (c->num_workers_expr);
gfc_free_expr (c->vector_length_expr);
for (i = 0; i < OMP_LIST_NUM; i++)
- gfc_free_omp_namelist (c->lists[i]);
+ gfc_free_omp_namelist (c->lists[i],
+ i == OMP_LIST_AFFINITY || i == OMP_LIST_DEPEND);
gfc_free_expr_list (c->wait_list);
gfc_free_expr_list (c->tile_list);
free (CONST_CAST (char *, c->critical_name));
@@ -355,7 +357,7 @@ syntax:
gfc_error ("Syntax error in OpenMP variable list at %C");
cleanup:
- gfc_free_omp_namelist (head);
+ gfc_free_omp_namelist (head, false);
gfc_current_locus = old_loc;
return MATCH_ERROR;
}
@@ -445,7 +447,7 @@ syntax:
gfc_error ("Syntax error in OpenMP variable list at %C");
cleanup:
- gfc_free_omp_namelist (head);
+ gfc_free_omp_namelist (head, false);
gfc_current_locus = old_loc;
return MATCH_ERROR;
}
@@ -552,7 +554,7 @@ syntax:
gfc_error ("Syntax error in OpenMP DEPEND SINK list at %C");
cleanup:
- gfc_free_omp_namelist (head);
+ gfc_free_omp_namelist (head, false);
gfc_current_locus = old_loc;
return MATCH_ERROR;
}
@@ -843,6 +845,7 @@ enum omp_mask1
OMP_CLAUSE_CAPTURE, /* OpenMP 5.0. */
OMP_CLAUSE_MEMORDER, /* OpenMP 5.0. */
OMP_CLAUSE_DETACH, /* OpenMP 5.0. */
+ OMP_CLAUSE_AFFINITY, /* OpenMP 5.0. */
OMP_CLAUSE_NOWAIT,
/* This must come last. */
OMP_MASK1_LAST
@@ -996,6 +999,107 @@ gfc_match_omp_map_clause (gfc_omp_namelist **list, gfc_omp_map_op map_op,
return false;
}
+static match
+gfc_match_iterator (gfc_namespace **ns)
+{
+ if (gfc_match ("iterator ( ") != MATCH_YES)
+ return MATCH_NO;
+
+ gfc_typespec ts;
+ gfc_symbol *last = NULL;
+ gfc_expr *begin, *end, *step;
+ *ns = gfc_build_block_ns (gfc_current_ns);
+ char name[GFC_MAX_SYMBOL_LEN + 1];
+ while (true)
+ {
+ locus old_loc = gfc_current_locus;
+ if (gfc_match_type_spec (&ts) == MATCH_YES
+ && gfc_match (" :: ") == MATCH_YES)
+ {
+ if (ts.type != BT_INTEGER)
+ {
+ gfc_error ("Expected INTEGER type at %L", &old_loc);
+ return MATCH_ERROR;
+ }
+ }
+ else
+ {
+ ts.type = BT_INTEGER;
+ ts.kind = gfc_default_integer_kind;
+ gfc_current_locus = old_loc;
+ }
+ old_loc = gfc_current_locus;
+ if (gfc_match_name (name) != MATCH_YES)
+ {
+ gfc_error ("Expected identifier at %C");
+ return MATCH_ERROR;
+ }
+ if (gfc_find_symtree ((*ns)->sym_root, name))
+ {
+ gfc_error ("Same identifier %qs specified again at %C", name);
+ return MATCH_ERROR;
+ }
+
+ gfc_symbol *sym = gfc_new_symbol (name, *ns);
+ if (last)
+ last->tlink = sym;
+ else
+ (*ns)->proc_name = sym;
+ last = sym;
+ sym->declared_at = old_loc;
+ sym->ts = ts;
+ sym->attr.flavor = FL_VARIABLE;
+ sym->attr.artificial = 1;
+ sym->attr.referenced = 1;
+ sym->refs++;
+ gfc_symtree *st = gfc_new_symtree (&(*ns)->sym_root, name);
+ st->n.sym = sym;
+
+ old_loc = gfc_current_locus;
+ if (gfc_match (" = ") != MATCH_YES)
+ return MATCH_ERROR;
+ begin = end = step = NULL;
+ if (gfc_match ("%e : ", &begin) != MATCH_YES
+ || gfc_match ("%e ", &end) != MATCH_YES)
+ {
+ gfc_error ("Expected range-specification at %C");
+ gfc_free_expr (begin);
+ gfc_free_expr (end);
+ return MATCH_ERROR;
+ }
+ if (':' == gfc_peek_ascii_char ())
+ {
+ step = gfc_get_expr ();
+ if (gfc_match (": %e ", &step) != MATCH_YES)
+ {
+ gfc_free_expr (begin);
+ gfc_free_expr (end);
+ gfc_free_expr (step);
+ return MATCH_ERROR;
+ }
+ }
+
+ gfc_expr *e = gfc_get_expr ();
+ e->where = old_loc;
+ e->expr_type = EXPR_ARRAY;
+ e->ts = ts;
+ e->rank = 1;
+ e->shape = gfc_get_shape (1);
+ mpz_init_set_ui (e->shape[0], step ? 3 : 2);
+ gfc_constructor_append_expr (&e->value.constructor, begin, &begin->where);
+ gfc_constructor_append_expr (&e->value.constructor, end, &end->where);
+ if (step)
+ gfc_constructor_append_expr (&e->value.constructor, step, &step->where);
+ sym->value = e;
+
+ if (gfc_match (") ") == MATCH_YES)
+ break;
+ if (gfc_match (", ") != MATCH_YES)
+ return MATCH_ERROR;
+ }
+ return MATCH_YES;
+}
+
/* reduction ( reduction-modifier, reduction-operator : variable-list )
in_reduction ( reduction-operator : variable-list )
task_reduction ( reduction-operator : variable-list ) */
@@ -1138,7 +1242,7 @@ gfc_match_omp_clause_reduction (char pc, gfc_omp_clauses *c, bool openacc,
*head = NULL;
gfc_error_now ("!$OMP DECLARE REDUCTION %s not found at %L",
buffer, &old_loc);
- gfc_free_omp_namelist (n);
+ gfc_free_omp_namelist (n, false);
}
else
for (n = *head; n; n = n->next)
@@ -1146,8 +1250,8 @@ gfc_match_omp_clause_reduction (char pc, gfc_omp_clauses *c, bool openacc,
n->u.reduction_op = rop;
if (udr)
{
- n->udr = gfc_get_omp_namelist_udr ();
- n->udr->udr = udr;
+ n->u2.udr = gfc_get_omp_namelist_udr ();
+ n->u2.udr->udr = udr;
}
}
return MATCH_YES;
@@ -1202,7 +1306,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
if (end_colon && gfc_match (" %e )", &alignment) != MATCH_YES)
{
- gfc_free_omp_namelist (*head);
+ gfc_free_omp_namelist (*head, false);
gfc_current_locus = old_loc;
*head = NULL;
break;
@@ -1230,6 +1334,36 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
needs_space = true;
continue;
}
+ if ((mask & OMP_CLAUSE_AFFINITY)
+ && gfc_match ("affinity ( ") == MATCH_YES)
+ {
+ gfc_namespace *ns_iter = NULL, *ns_curr = gfc_current_ns;
+ match m = gfc_match_iterator (&ns_iter);
+ if (m == MATCH_ERROR)
+ break;
+ if (m == MATCH_YES && gfc_match (" : ") != MATCH_YES)
+ {
+ gfc_error ("Expected %<:%> at %C");
+ break;
+ }
+ if (ns_iter)
+ gfc_current_ns = ns_iter;
+ head = NULL;
+ m = gfc_match_omp_variable_list ("", &c->lists[OMP_LIST_AFFINITY],
+ false, NULL, &head, true);
+ gfc_current_ns = ns_curr;
+ if (m == MATCH_ERROR)
+ break;
+ if (ns_iter)
+ {
+ for (gfc_omp_namelist *n = *head; n; n = n->next)
+ {
+ n->u2.ns = ns_iter;
+ ns_iter->refs++;
+ }
+ }
+ continue;
+ }
if ((mask & OMP_CLAUSE_ASYNC)
&& !c->async
&& gfc_match ("async") == MATCH_YES)
@@ -1374,6 +1508,12 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
if ((mask & OMP_CLAUSE_DEPEND)
&& gfc_match ("depend ( ") == MATCH_YES)
{
+ gfc_namespace *ns_iter = NULL, *ns_curr = gfc_current_ns;
+ match m_it = gfc_match_iterator (&ns_iter);
+ if (m_it == MATCH_ERROR)
+ break;
+ if (m_it == MATCH_YES && gfc_match (" , ") != MATCH_YES)
+ break;
match m = MATCH_YES;
gfc_omp_depend_op depend_op = OMP_DEPEND_OUT;
if (gfc_match ("inout") == MATCH_YES)
@@ -1389,11 +1529,24 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
else if (!c->depend_source
&& 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;
+ }
c->depend_source = true;
continue;
}
else if (gfc_match ("sink : ") == MATCH_YES)
{
+ if (m_it == MATCH_YES)
+ {
+ gfc_error ("ITERATOR may not be combined with SINK "
+ "at %C");
+ break;
+ }
if (gfc_match_omp_depend_sink (&c->lists[OMP_LIST_DEPEND])
== MATCH_YES)
continue;
@@ -1402,19 +1555,26 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
else
m = MATCH_NO;
head = NULL;
- if (m == MATCH_YES
- && gfc_match_omp_variable_list (" : ",
- &c->lists[OMP_LIST_DEPEND],
- false, NULL, &head,
- true) == MATCH_YES)
+ if (ns_iter)
+ gfc_current_ns = ns_iter;
+ if (m == MATCH_YES)
+ m = gfc_match_omp_variable_list (" : ",
+ &c->lists[OMP_LIST_DEPEND],
+ false, NULL, &head, true);
+ gfc_current_ns = ns_curr;
+ if (m == MATCH_YES)
{
gfc_omp_namelist *n;
for (n = *head; n; n = n->next)
- n->u.depend_op = depend_op;
+ {
+ n->u.depend_op = depend_op;
+ n->u2.ns = ns_iter;
+ if (ns_iter)
+ ns_iter->refs++;
+ }
continue;
}
- else
- gfc_current_locus = old_loc;
+ break;
}
if ((mask & OMP_CLAUSE_DETACH)
&& !openacc
@@ -1666,7 +1826,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
end_colon = true;
else if (gfc_match (" )") != MATCH_YES)
{
- gfc_free_omp_namelist (*head);
+ gfc_free_omp_namelist (*head, false);
gfc_current_locus = old_loc;
*head = NULL;
break;
@@ -1674,7 +1834,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
}
if (end_colon && gfc_match (" %e )", &step) != MATCH_YES)
{
- gfc_free_omp_namelist (*head);
+ gfc_free_omp_namelist (*head, false);
gfc_current_locus = old_loc;
*head = NULL;
break;
@@ -2844,7 +3004,7 @@ cleanup:
| OMP_CLAUSE_SHARED | OMP_CLAUSE_IF | OMP_CLAUSE_DEFAULT \
| OMP_CLAUSE_UNTIED | OMP_CLAUSE_FINAL | OMP_CLAUSE_MERGEABLE \
| OMP_CLAUSE_DEPEND | OMP_CLAUSE_PRIORITY | OMP_CLAUSE_IN_REDUCTION \
- | OMP_CLAUSE_DETACH)
+ | OMP_CLAUSE_DETACH | OMP_CLAUSE_AFFINITY)
#define OMP_TASKLOOP_CLAUSES \
(omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE \
| OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_SHARED | OMP_CLAUSE_IF \
@@ -3097,14 +3257,14 @@ gfc_match_omp_flush (void)
{
gfc_error ("List specified together with memory order clause in FLUSH "
"directive at %C");
- gfc_free_omp_namelist (list);
+ gfc_free_omp_namelist (list, false);
gfc_free_omp_clauses (c);
return MATCH_ERROR;
}
if (gfc_match_omp_eos () != MATCH_YES)
{
gfc_error ("Unexpected junk after $OMP FLUSH statement at %C");
- gfc_free_omp_namelist (list);
+ gfc_free_omp_namelist (list, false);
gfc_free_omp_clauses (c);
return MATCH_ERROR;
}
@@ -4252,14 +4412,13 @@ gfc_match_omp_taskloop_simd (void)
match
gfc_match_omp_taskwait (void)
{
- if (gfc_match_omp_eos () != MATCH_YES)
+ if (gfc_match_omp_eos () == MATCH_YES)
{
- gfc_error ("Unexpected junk after TASKWAIT clause at %C");
- return MATCH_ERROR;
+ new_st.op = EXEC_OMP_TASKWAIT;
+ new_st.ext.omp_clauses = NULL;
+ return MATCH_YES;
}
- new_st.op = EXEC_OMP_TASKWAIT;
- new_st.ext.omp_clauses = NULL;
- return MATCH_YES;
+ return match_omp (EXEC_OMP_TASKWAIT, omp_mask (OMP_CLAUSE_DEPEND));
}
@@ -4825,7 +4984,7 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
gfc_omp_linear_op linear_op = OMP_LINEAR_DEFAULT;
static const char *clause_names[]
= { "PRIVATE", "FIRSTPRIVATE", "LASTPRIVATE", "COPYPRIVATE", "SHARED",
- "COPYIN", "UNIFORM", "ALIGNED", "LINEAR", "DEPEND", "MAP",
+ "COPYIN", "UNIFORM", "AFFINITY", "ALIGNED", "LINEAR", "DEPEND", "MAP",
"TO", "FROM", "INCLUSIVE", "EXCLUSIVE",
"REDUCTION", "REDUCTION" /*inscan*/, "REDUCTION" /*task*/,
"IN_REDUCTION", "TASK_REDUCTION",
@@ -5273,6 +5432,7 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
}
}
break;
+ case OMP_LIST_AFFINITY:
case OMP_LIST_DEPEND:
case OMP_LIST_MAP:
case OMP_LIST_TO:
@@ -5280,6 +5440,40 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
case OMP_LIST_CACHE:
for (; n != NULL; n = n->next)
{
+ if ((list == OMP_LIST_DEPEND || list == OMP_LIST_AFFINITY)
+ && n->u2.ns && !n->u2.ns->resolved)
+ {
+ n->u2.ns->resolved = 1;
+ for (gfc_symbol *sym = n->u2.ns->proc_name; sym;
+ sym = sym->tlink)
+ {
+ gfc_constructor *c;
+ c = gfc_constructor_first (sym->value->value.constructor);
+ if (!gfc_resolve_expr (c->expr)
+ || c->expr->ts.type != BT_INTEGER
+ || c->expr->rank != 0)
+ gfc_error ("Scalar integer expression for range begin"
+ " expected at %L", &c->expr->where);
+ c = gfc_constructor_next (c);
+ if (!gfc_resolve_expr (c->expr)
+ || c->expr->ts.type != BT_INTEGER
+ || c->expr->rank != 0)
+ gfc_error ("Scalar integer expression for range end "
+ "expected at %L", &c->expr->where);
+ c = gfc_constructor_next (c);
+ if (c && (!gfc_resolve_expr (c->expr)
+ || c->expr->ts.type != BT_INTEGER
+ || c->expr->rank != 0))
+ gfc_error ("Scalar integer expression for range step "
+ "expected at %L", &c->expr->where);
+ else if (c
+ && c->expr->expr_type == EXPR_CONSTANT
+ && mpz_cmp_si (c->expr->value.integer, 0) == 0)
+ gfc_error ("Nonzero range step expected at %L",
+ &c->expr->where);
+ }
+ }
+
if (list == OMP_LIST_DEPEND)
{
if (n->u.depend_op == OMP_DEPEND_SINK_FIRST
@@ -5421,7 +5615,8 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
n->sym->name, name, &n->where);
break;
}
- else if (list == OMP_LIST_DEPEND
+ else if ((list == OMP_LIST_DEPEND
+ || list == OMP_LIST_AFFINITY)
&& ar->start[i]
&& ar->start[i]->expr_type == EXPR_CONSTANT
&& ar->end[i]
@@ -5429,9 +5624,11 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
&& mpz_cmp (ar->start[i]->value.integer,
ar->end[i]->value.integer) > 0)
{
- gfc_error ("%qs in DEPEND clause at %L is a "
+ gfc_error ("%qs in %s clause at %L is a "
"zero size array section",
- n->sym->name, &n->where);
+ n->sym->name,
+ list == OMP_LIST_DEPEND
+ ? "DEPEND" : "AFFINITY", &n->where);
break;
}
}
@@ -5675,23 +5872,23 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
break;
}
if (!bad)
- n->udr = NULL;
+ n->u2.udr = NULL;
else
{
const char *udr_name = NULL;
- if (n->udr)
+ if (n->u2.udr)
{
- udr_name = n->udr->udr->name;
- n->udr->udr
+ udr_name = n->u2.udr->udr->name;
+ n->u2.udr->udr
= gfc_find_omp_udr (NULL, udr_name,
&n->sym->ts);
- if (n->udr->udr == NULL)
+ if (n->u2.udr->udr == NULL)
{
- free (n->udr);
- n->udr = NULL;
+ free (n->u2.udr);
+ n->u2.udr = NULL;
}
}
- if (n->udr == NULL)
+ if (n->u2.udr == NULL)
{
if (udr_name == NULL)
switch (n->u.reduction_op)
@@ -5730,14 +5927,14 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
}
else
{
- gfc_omp_udr *udr = n->udr->udr;
+ gfc_omp_udr *udr = n->u2.udr->udr;
n->u.reduction_op = OMP_REDUCTION_USER;
- n->udr->combiner
+ n->u2.udr->combiner
= resolve_omp_udr_clause (n, udr->combiner_ns,
udr->omp_out,
udr->omp_in);
if (udr->initializer_ns)
- n->udr->initializer
+ n->u2.udr->initializer
= resolve_omp_udr_clause (n,
udr->initializer_ns,
udr->omp_priv,
@@ -7369,6 +7566,7 @@ gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns)
case EXEC_OMP_TARGET_PARALLEL:
case EXEC_OMP_TARGET_TEAMS:
case EXEC_OMP_TASK:
+ case EXEC_OMP_TASKWAIT:
case EXEC_OMP_TEAMS:
case EXEC_OMP_WORKSHARE:
case EXEC_OMP_DEPOBJ:
diff --git a/gcc/fortran/st.c b/gcc/fortran/st.c
index 02a81dadb2a..7d0e2c14731 100644
--- a/gcc/fortran/st.c
+++ b/gcc/fortran/st.c
@@ -268,7 +268,7 @@ gfc_free_statement (gfc_code *p)
break;
case EXEC_OMP_FLUSH:
- gfc_free_omp_namelist (p->ext.omp_namelist);
+ gfc_free_omp_namelist (p->ext.omp_namelist, false);
break;
case EXEC_OMP_BARRIER:
diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index 44542d9ab1a..7ea7aa37efd 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -35,6 +35,7 @@ along with GCC; see the file COPYING3. If not see
#include "trans-array.h"
#include "trans-const.h"
#include "arith.h"
+#include "constructor.h"
#include "gomp-constants.h"
#include "omp-general.h"
#include "omp-low.h"
@@ -1910,7 +1911,7 @@ gfc_trans_omp_array_reduction_or_udr (tree c, gfc_omp_namelist *n, locus where)
locus old_loc = gfc_current_locus;
const char *iname;
bool t;
- gfc_omp_udr *udr = n->udr ? n->udr->udr : NULL;
+ gfc_omp_udr *udr = n->u2.udr ? n->u2.udr->udr : NULL;
decl = OMP_CLAUSE_DECL (c);
gfc_current_locus = where;
@@ -2029,9 +2030,9 @@ gfc_trans_omp_array_reduction_or_udr (tree c, gfc_omp_namelist *n, locus where)
t = gfc_resolve_expr (e2);
gcc_assert (t);
}
- else if (n->udr->initializer->op == EXEC_ASSIGN)
+ else if (n->u2.udr->initializer->op == EXEC_ASSIGN)
{
- e2 = gfc_copy_expr (n->udr->initializer->expr2);
+ e2 = gfc_copy_expr (n->u2.udr->initializer->expr2);
t = gfc_resolve_expr (e2);
gcc_assert (t);
}
@@ -2040,7 +2041,7 @@ gfc_trans_omp_array_reduction_or_udr (tree c, gfc_omp_namelist *n, locus where)
struct omp_udr_find_orig_data cd;
cd.omp_udr = udr;
cd.omp_orig_seen = false;
- gfc_code_walker (&n->udr->initializer,
+ gfc_code_walker (&n->u2.udr->initializer,
gfc_dummy_code_callback, omp_udr_find_orig, &cd);
if (cd.omp_orig_seen)
OMP_CLAUSE_REDUCTION_OMP_ORIG_REF (c) = 1;
@@ -2090,11 +2091,11 @@ gfc_trans_omp_array_reduction_or_udr (tree c, gfc_omp_namelist *n, locus where)
iname = "ieor";
break;
case ERROR_MARK:
- if (n->udr->combiner->op == EXEC_ASSIGN)
+ if (n->u2.udr->combiner->op == EXEC_ASSIGN)
{
gfc_free_expr (e3);
- e3 = gfc_copy_expr (n->udr->combiner->expr1);
- e4 = gfc_copy_expr (n->udr->combiner->expr2);
+ e3 = gfc_copy_expr (n->u2.udr->combiner->expr1);
+ e4 = gfc_copy_expr (n->u2.udr->combiner->expr2);
t = gfc_resolve_expr (e3);
gcc_assert (t);
t = gfc_resolve_expr (e4);
@@ -2144,7 +2145,7 @@ gfc_trans_omp_array_reduction_or_udr (tree c, gfc_omp_namelist *n, locus where)
if (e2)
stmt = gfc_trans_assignment (e1, e2, false, false);
else
- stmt = gfc_trans_call (n->udr->initializer, false,
+ stmt = gfc_trans_call (n->u2.udr->initializer, false,
NULL_TREE, NULL_TREE, false);
if (TREE_CODE (stmt) != BIND_EXPR)
stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
@@ -2157,7 +2158,7 @@ gfc_trans_omp_array_reduction_or_udr (tree c, gfc_omp_namelist *n, locus where)
if (e4)
stmt = gfc_trans_assignment (e3, e4, false, true);
else
- stmt = gfc_trans_call (n->udr->combiner, false,
+ stmt = gfc_trans_call (n->u2.udr->combiner, false,
NULL_TREE, NULL_TREE, false);
if (TREE_CODE (stmt) != BIND_EXPR)
stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
@@ -2432,14 +2433,77 @@ gfc_trans_omp_array_section (stmtblock_t *block, gfc_omp_namelist *n,
ptr, ptr2);
}
+static tree
+handle_iterator (gfc_namespace *ns, stmtblock_t *iter_block, tree block)
+{
+ tree list = NULL_TREE;
+ for (gfc_symbol *sym = ns->proc_name; sym; sym = sym->tlink)
+ {
+ gfc_constructor *c;
+ gfc_se se;
+
+ tree last = make_tree_vec (6);
+ tree iter_var = gfc_get_symbol_decl (sym);
+ tree type = TREE_TYPE (iter_var);
+ TREE_VEC_ELT (last, 0) = iter_var;
+ DECL_CHAIN (iter_var) = BLOCK_VARS (block);
+ BLOCK_VARS (block) = iter_var;
+
+ /* begin */
+ c = gfc_constructor_first (sym->value->value.constructor);
+ gfc_init_se (&se, NULL);
+ gfc_conv_expr (&se, c->expr);
+ gfc_add_block_to_block (iter_block, &se.pre);
+ gfc_add_block_to_block (iter_block, &se.post);
+ TREE_VEC_ELT (last, 1) = fold_convert (type,
+ gfc_evaluate_now (se.expr,
+ iter_block));
+ /* end */
+ c = gfc_constructor_next (c);
+ gfc_init_se (&se, NULL);
+ gfc_conv_expr (&se, c->expr);
+ gfc_add_block_to_block (iter_block, &se.pre);
+ gfc_add_block_to_block (iter_block, &se.post);
+ TREE_VEC_ELT (last, 2) = fold_convert (type,
+ gfc_evaluate_now (se.expr,
+ iter_block));
+ /* step */
+ c = gfc_constructor_next (c);
+ tree step;
+ if (c)
+ {
+ gfc_init_se (&se, NULL);
+ gfc_conv_expr (&se, c->expr);
+ gfc_add_block_to_block (iter_block, &se.pre);
+ gfc_add_block_to_block (iter_block, &se.post);
+ gfc_conv_expr (&se, c->expr);
+ step = fold_convert (type,
+ gfc_evaluate_now (se.expr,
+ iter_block));
+ }
+ else
+ step = build_int_cst (type, 1);
+ TREE_VEC_ELT (last, 3) = step;
+ /* orig_step */
+ TREE_VEC_ELT (last, 4) = save_expr (step);
+ TREE_CHAIN (last) = list;
+ list = last;
+ }
+ return list;
+}
+
static tree
gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
locus where, bool declare_simd = false,
bool openacc = false)
{
- tree omp_clauses = NULL_TREE, chunk_size, c;
+ tree omp_clauses = NULL_TREE, prev_clauses, chunk_size, c;
+ tree iterator = NULL_TREE;
+ tree tree_block = NULL_TREE;
+ stmtblock_t iter_block;
int list, ifc;
enum omp_clause_code clause_code;
+ gfc_omp_namelist *prev = NULL;
gfc_se se;
if (clauses == NULL)
@@ -2642,10 +2706,38 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
}
}
break;
+ case OMP_LIST_AFFINITY:
case OMP_LIST_DEPEND:
+ iterator = NULL_TREE;
+ prev = NULL;
+ prev_clauses = omp_clauses;
for (; n != NULL; n = n->next)
{
- if (n->u.depend_op == OMP_DEPEND_SINK_FIRST)
+ if (iterator && prev->u2.ns != n->u2.ns)
+ {
+ BLOCK_SUBBLOCKS (tree_block) = gfc_finish_block (&iter_block);
+ TREE_VEC_ELT (iterator, 5) = tree_block;
+ for (tree c = omp_clauses; c != prev_clauses;
+ c = OMP_CLAUSE_CHAIN (c))
+ OMP_CLAUSE_DECL (c) = build_tree_list (iterator,
+ OMP_CLAUSE_DECL (c));
+ prev_clauses = omp_clauses;
+ iterator = NULL_TREE;
+ }
+ if (n->u2.ns && (!prev || prev->u2.ns != n->u2.ns))
+ {
+ gfc_init_block (&iter_block);
+ tree_block = make_node (BLOCK);
+ TREE_USED (tree_block) = 1;
+ BLOCK_VARS (tree_block) = NULL_TREE;
+ iterator = handle_iterator (n->u2.ns, block,
+ tree_block);
+ }
+ if (!iterator)
+ gfc_init_block (&iter_block);
+ prev = n;
+ if (list == OMP_LIST_DEPEND
+ && n->u.depend_op == OMP_DEPEND_SINK_FIRST)
{
tree vec = NULL_TREE;
unsigned int i;
@@ -2699,7 +2791,10 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
if (!n->sym->attr.referenced)
continue;
- tree node = build_omp_clause (input_location, OMP_CLAUSE_DEPEND);
+ tree node = build_omp_clause (input_location,
+ list == OMP_LIST_DEPEND
+ ? OMP_CLAUSE_DEPEND
+ : OMP_CLAUSE_AFFINITY);
if (n->expr == NULL || n->expr->ref->u.ar.type == AR_FULL)
{
tree decl = gfc_trans_omp_variable (n->sym, false);
@@ -2733,35 +2828,47 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
gfc_conv_expr_descriptor (&se, n->expr);
ptr = gfc_conv_array_data (se.expr);
}
- gfc_add_block_to_block (block, &se.pre);
- gfc_add_block_to_block (block, &se.post);
+ gfc_add_block_to_block (&iter_block, &se.pre);
+ gfc_add_block_to_block (&iter_block, &se.post);
ptr = fold_convert (build_pointer_type (char_type_node),
ptr);
OMP_CLAUSE_DECL (node) = build_fold_indirect_ref (ptr);
}
- switch (n->u.depend_op)
- {
- case OMP_DEPEND_IN:
- OMP_CLAUSE_DEPEND_KIND (node) = OMP_CLAUSE_DEPEND_IN;
- break;
- case OMP_DEPEND_OUT:
- OMP_CLAUSE_DEPEND_KIND (node) = OMP_CLAUSE_DEPEND_OUT;
- break;
- case OMP_DEPEND_INOUT:
- OMP_CLAUSE_DEPEND_KIND (node) = OMP_CLAUSE_DEPEND_INOUT;
- break;
- case OMP_DEPEND_MUTEXINOUTSET:
- OMP_CLAUSE_DEPEND_KIND (node)
- = OMP_CLAUSE_DEPEND_MUTEXINOUTSET;
- break;
- case OMP_DEPEND_DEPOBJ:
- OMP_CLAUSE_DEPEND_KIND (node) = OMP_CLAUSE_DEPEND_DEPOBJ;
- break;
- default:
- gcc_unreachable ();
- }
+ if (list == OMP_LIST_DEPEND)
+ switch (n->u.depend_op)
+ {
+ case OMP_DEPEND_IN:
+ OMP_CLAUSE_DEPEND_KIND (node) = OMP_CLAUSE_DEPEND_IN;
+ break;
+ case OMP_DEPEND_OUT:
+ OMP_CLAUSE_DEPEND_KIND (node) = OMP_CLAUSE_DEPEND_OUT;
+ break;
+ case OMP_DEPEND_INOUT:
+ OMP_CLAUSE_DEPEND_KIND (node) = OMP_CLAUSE_DEPEND_INOUT;
+ break;
+ case OMP_DEPEND_MUTEXINOUTSET:
+ OMP_CLAUSE_DEPEND_KIND (node)
+ = OMP_CLAUSE_DEPEND_MUTEXINOUTSET;
+ break;
+ case OMP_DEPEND_DEPOBJ:
+ OMP_CLAUSE_DEPEND_KIND (node) = OMP_CLAUSE_DEPEND_DEPOBJ;
+ break;
+ default:
+ gcc_unreachable ();
+ }
+ if (!iterator)
+ gfc_add_block_to_block (block, &iter_block);
omp_clauses = gfc_trans_add_clause (node, omp_clauses);
}
+ if (iterator)
+ {
+ BLOCK_SUBBLOCKS (tree_block) = gfc_finish_block (&iter_block);
+ TREE_VEC_ELT (iterator, 5) = tree_block;
+ for (tree c = omp_clauses; c != prev_clauses;
+ c = OMP_CLAUSE_CHAIN (c))
+ OMP_CLAUSE_DECL (c) = build_tree_list (iterator,
+ OMP_CLAUSE_DECL (c));
+ }
break;
case OMP_LIST_MAP:
for (; n != NULL; n = n->next)
@@ -5857,10 +5964,23 @@ gfc_trans_omp_taskgroup (gfc_code *code)
}
static tree
-gfc_trans_omp_taskwait (void)
+gfc_trans_omp_taskwait (gfc_code *code)
{
- tree decl = builtin_decl_explicit (BUILT_IN_GOMP_TASKWAIT);
- return build_call_expr_loc (input_location, decl, 0);
+ if (!code->ext.omp_clauses)
+ {
+ tree decl = builtin_decl_explicit (BUILT_IN_GOMP_TASKWAIT);
+ return build_call_expr_loc (input_location, decl, 0);
+ }
+ stmtblock_t block;
+ gfc_start_block (&block);
+ tree stmt = make_node (OMP_TASK);
+ TREE_TYPE (stmt) = void_type_node;
+ OMP_TASK_BODY (stmt) = NULL_TREE;
+ OMP_TASK_CLAUSES (stmt) = gfc_trans_omp_clauses (&block,
+ code->ext.omp_clauses,
+ code->loc);
+ gfc_add_expr_to_block (&block, stmt);
+ return gfc_finish_block (&block);
}
static tree
@@ -6492,7 +6612,7 @@ gfc_trans_omp_directive (gfc_code *code)
case EXEC_OMP_TASKLOOP_SIMD:
return gfc_trans_omp_taskloop (code);
case EXEC_OMP_TASKWAIT:
- return gfc_trans_omp_taskwait ();
+ return gfc_trans_omp_taskwait (code);
case EXEC_OMP_TASKYIELD:
return gfc_trans_omp_taskyield ();
case EXEC_OMP_TEAMS:
diff --git a/gcc/gimplify.c b/gcc/gimplify.c
index 54bf59ab9d0..d60fc95db01 100644
--- a/gcc/gimplify.c
+++ b/gcc/gimplify.c
@@ -7841,6 +7841,131 @@ find_decl_expr (tree *tp, int *walk_subtrees, void *data)
return NULL_TREE;
}
+
+/* Gimplify the affinity clause but effectively ignore it.
+ Generate:
+ var = begin;
+ if ((step > 1) ? var <= end : var > end)
+ locatator_var_expr; */
+
+static void
+gimplify_omp_affinity (tree *list_p, gimple_seq *pre_p)
+{
+ tree last_iter = NULL_TREE;
+ tree last_bind = NULL_TREE;
+ tree label = NULL_TREE;
+ tree *last_body = NULL;
+ for (tree c = *list_p; c; c = OMP_CLAUSE_CHAIN (c))
+ if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_AFFINITY)
+ {
+ tree t = OMP_CLAUSE_DECL (c);
+ if (TREE_CODE (t) == TREE_LIST
+ && TREE_PURPOSE (t)
+ && TREE_CODE (TREE_PURPOSE (t)) == TREE_VEC)
+ {
+ if (TREE_VALUE (t) == null_pointer_node)
+ continue;
+ if (TREE_PURPOSE (t) != last_iter)
+ {
+ if (last_bind)
+ {
+ append_to_statement_list (label, last_body);
+ gimplify_and_add (last_bind, pre_p);
+ last_bind = NULL_TREE;
+ }
+ for (tree it = TREE_PURPOSE (t); it; it = TREE_CHAIN (it))
+ {
+ if (gimplify_expr (&TREE_VEC_ELT (it, 1), pre_p, NULL,
+ is_gimple_val, fb_rvalue) == GS_ERROR
+ || gimplify_expr (&TREE_VEC_ELT (it, 2), pre_p, NULL,
+ is_gimple_val, fb_rvalue) == GS_ERROR
+ || gimplify_expr (&TREE_VEC_ELT (it, 3), pre_p, NULL,
+ is_gimple_val, fb_rvalue) == GS_ERROR
+ || (gimplify_expr (&TREE_VEC_ELT (it, 4), pre_p, NULL,
+ is_gimple_val, fb_rvalue)
+ == GS_ERROR))
+ return;
+ }
+ last_iter = TREE_PURPOSE (t);
+ tree block = TREE_VEC_ELT (TREE_PURPOSE (t), 5);
+ last_bind = build3 (BIND_EXPR, void_type_node, BLOCK_VARS (block),
+ NULL, block);
+ last_body = &BIND_EXPR_BODY (last_bind);
+ tree cond = NULL_TREE;
+ location_t loc = OMP_CLAUSE_LOCATION (c);
+ for (tree it = TREE_PURPOSE (t); it; it = TREE_CHAIN (it))
+ {
+ tree var = TREE_VEC_ELT (it, 0);
+ tree begin = TREE_VEC_ELT (it, 1);
+ tree end = TREE_VEC_ELT (it, 2);
+ tree step = TREE_VEC_ELT (it, 3);
+ loc = DECL_SOURCE_LOCATION (var);
+ tree tem = build2_loc (loc, MODIFY_EXPR, void_type_node,
+ var, begin);
+ append_to_statement_list_force (tem, last_body);
+
+ tree cond1 = fold_build2_loc (loc, GT_EXPR, boolean_type_node,
+ step, build_zero_cst (TREE_TYPE (step)));
+ tree cond2 = fold_build2_loc (loc, LE_EXPR, boolean_type_node,
+ var, end);
+ tree cond3 = fold_build2_loc (loc, GT_EXPR, boolean_type_node,
+ var, end);
+ cond1 = fold_build3_loc (loc, COND_EXPR, boolean_type_node,
+ cond1, cond2, cond3);
+ if (cond)
+ cond = fold_build2_loc (loc, TRUTH_AND_EXPR,
+ boolean_type_node, cond, cond1);
+ else
+ cond = cond1;
+ }
+ tree cont_label = create_artificial_label (loc);
+ label = build1 (LABEL_EXPR, void_type_node, cont_label);
+ tree tem = fold_build3_loc (loc, COND_EXPR, void_type_node, cond,
+ void_node,
+ build_and_jump (&cont_label));
+ append_to_statement_list_force (tem, last_body);
+ }
+ if (TREE_CODE (TREE_VALUE (t)) == COMPOUND_EXPR)
+ {
+ append_to_statement_list (TREE_OPERAND (TREE_VALUE (t), 0),
+ last_body);
+ TREE_VALUE (t) = TREE_OPERAND (TREE_VALUE (t), 1);
+ }
+ if (error_operand_p (TREE_VALUE (t)))
+ return;
+ append_to_statement_list_force (TREE_VALUE (t), last_body);
+ TREE_VALUE (t) = null_pointer_node;
+ }
+ else
+ {
+ if (last_bind)
+ {
+ append_to_statement_list (label, last_body);
+ gimplify_and_add (last_bind, pre_p);
+ last_bind = NULL_TREE;
+ }
+ if (TREE_CODE (OMP_CLAUSE_DECL (c)) == COMPOUND_EXPR)
+ {
+ gimplify_expr (&TREE_OPERAND (OMP_CLAUSE_DECL (c), 0), pre_p,
+ NULL, is_gimple_val, fb_rvalue);
+ OMP_CLAUSE_DECL (c) = TREE_OPERAND (OMP_CLAUSE_DECL (c), 1);
+ }
+ if (error_operand_p (OMP_CLAUSE_DECL (c)))
+ return;
+ if (gimplify_expr (&OMP_CLAUSE_DECL (c), pre_p, NULL,
+ is_gimple_val, fb_rvalue) == GS_ERROR)
+ return;
+ gimplify_and_add (OMP_CLAUSE_DECL (c), pre_p);
+ }
+ }
+ if (last_bind)
+ {
+ append_to_statement_list (label, last_body);
+ gimplify_and_add (last_bind, pre_p);
+ }
+ return;
+}
+
/* If *LIST_P contains any OpenMP depend clauses with iterators,
lower all the depend clauses by populating corresponding depend
array. Returns 0 if there are no such depend clauses, or
@@ -9527,6 +9652,10 @@ gimplify_scan_omp_clauses (tree *list_p, gimple_seq *pre_p,
goto do_add;
+ case OMP_CLAUSE_AFFINITY:
+ gimplify_omp_affinity (list_p, pre_p);
+ remove = true;
+ break;
case OMP_CLAUSE_DEPEND:
if (OMP_CLAUSE_DEPEND_KIND (c) == OMP_CLAUSE_DEPEND_SINK)
{
diff --git a/gcc/testsuite/c-c++-common/gomp/affinity-1.c b/gcc/testsuite/c-c++-common/gomp/affinity-1.c
new file mode 100644
index 00000000000..4af52f4e944
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/affinity-1.c
@@ -0,0 +1,24 @@
+void
+foo(int x)
+{
+ int a = 1;
+ int b[5] = {1, 0, 1, 1, 0};
+ int cc = 7;
+ int d[5][5] = {{1, 2, 3, 4, 5}, {6, 7, 8, 9, 10}, {1, 2, 3, 4, 5},
+ {6, 7, 8, 9, 10}, {-1, -2, -3, -4,-5}};
+#pragma omp taskgroup
+ {
+ #pragma omp task affinity(a)
+ ;
+ #pragma omp task affinity(iterator(i=(int)__builtin_cos(1.0+a):5, jj =2:5:2) : b[i], d[i][jj])
+ ;
+ #pragma omp task affinity(iterator(i=(int)__builtin_cos(1.0+a):5) : b[i], d[i][i])
+ ;
+ #pragma omp task affinity (iterator(i=1:5): a)
+ ;
+ #pragma omp task affinity (iterator(i=1:5): a) affinity(iterator(i=1:5) : x)
+ ;
+ #pragma omp task affinity (iterator(unsigned long j=1:5, k=7:4:-1) : b[j+k],a) affinity (cc)
+ ;
+ }
+}
diff --git a/gcc/testsuite/c-c++-common/gomp/affinity-2.c b/gcc/testsuite/c-c++-common/gomp/affinity-2.c
new file mode 100644
index 00000000000..7f3029605be
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/affinity-2.c
@@ -0,0 +1,232 @@
+/* { dg-do compile } */
+/* { dg-options "-fopenmp" } */
+
+extern int a[][10], a2[][10];
+int b[10], c[10][2], d[10], e[10], f[10];
+int b2[10], c2[10][2], d2[10], e2[10], f2[10];
+int k[10], l[10], m[10], n[10], o;
+int *p;
+void bar (void);
+int t[10];
+#pragma omp threadprivate (t)
+
+void
+foo (int g[3][10], int h[4][8], int i[2][10], int j[][9],
+ int g2[3][10], int h2[4][8], int i2[2][10], int j2[][9])
+{
+ #pragma omp task affinity( bar[2:5]) /* { dg-error "is not a variable" } */
+ ;
+ #pragma omp task affinity( t[2:5])
+ ;
+ #pragma omp task affinity( k[0.5:]) /* { dg-error "low bound \[^\n\r]* of array section does not have integral type" } */
+ ;
+ #pragma omp task affinity( l[:7.5f]) /* { dg-error "length \[^\n\r]* of array section does not have integral type" } */
+ ;
+ #pragma omp task affinity( m[p:]) /* { dg-error "low bound \[^\n\r]* of array section does not have integral type" } */
+ ;
+ #pragma omp task affinity( n[:p]) /* { dg-error "length \[^\n\r]* of array section does not have integral type" } */
+ ;
+ #pragma omp task affinity( o[2:5]) /* { dg-error "does not have pointer or array type" } */
+ ;
+ #pragma omp task affinity( a[:][2:4]) /* { dg-error "array type length expression must be specified" } */
+ ;
+ #pragma omp task affinity( b[-1:]) /* { dg-error "negative low bound in array section" } */
+ ;
+ #pragma omp task affinity( c[:-3][1:1]) /* { dg-error "negative length in array section" } */
+ ;
+ #pragma omp task affinity( d[11:]) /* { dg-error "low bound \[^\n\r]* above array section size" } */
+ ;
+ #pragma omp task affinity( e[:11]) /* { dg-error "length \[^\n\r]* above array section size" } */
+ ;
+ #pragma omp task affinity( f[1:10]) /* { dg-error "high bound \[^\n\r]* above array section size" } */
+ ;
+ #pragma omp task affinity( g[:][2:4]) /* { dg-error "for array function parameter length expression must be specified" } */
+ ;
+ #pragma omp task affinity( h[2:2][-1:]) /* { dg-error "negative low bound in array section" } */
+ ;
+ #pragma omp task affinity( h[:1][:-3]) /* { dg-error "negative length in array section" } */
+ ;
+ #pragma omp task affinity( i[:1][11:]) /* { dg-error "low bound \[^\n\r]* above array section size" } */
+ ;
+ #pragma omp task affinity( j[3:4][:10]) /* { dg-error "length \[^\n\r]* above array section size" } */
+ ;
+ #pragma omp task affinity( j[30:10][5:5]) /* { dg-error "high bound \[^\n\r]* above array section size" } */
+ ;
+ #pragma omp task affinity( a2[:3][2:4])
+ ;
+ #pragma omp task affinity( b2[0:])
+ ;
+ #pragma omp task affinity( c2[:3][1:1])
+ ;
+ #pragma omp task affinity( d2[9:])
+ ;
+ #pragma omp task affinity( e2[:10])
+ ;
+ #pragma omp task affinity( f2[1:9])
+ ;
+ #pragma omp task affinity( g2[:2][2:4])
+ ;
+ #pragma omp task affinity( h2[2:2][0:])
+ ;
+ #pragma omp task affinity( h2[:1][:3])
+ ;
+ #pragma omp task affinity( i2[:1][9:])
+ ;
+ #pragma omp task affinity( j2[3:4][:9])
+ ;
+ #pragma omp task affinity( j2[30:10][5:4])
+ ;
+}
+
+void bar2 (int a[10][10][10]);
+
+void
+foo2 (int a[10][10][10], int **b)
+{
+ int c[10][10][10];
+ #pragma omp task affinity( a[2:4][3:][:7], b[1:7][2:8])
+ bar2 (a);
+ int i = 1, j = 3, k = 2, l = 6;
+ #pragma omp task affinity( a[++i:++j][++k:][:++l])
+ bar2 (a);
+ #pragma omp task affinity( a[7:2][:][:], c[5:2][:][:])
+ {
+ bar2 (c);
+ bar2 (a);
+ }
+}
+
+void
+foo3 (int a[10][10][10], int **b, int x)
+{
+ int c[10][10][10];
+ #pragma omp task affinity( a[2:4][3:0][:7]) /* { dg-error "zero length array section" } */
+ bar2 (a);
+ #pragma omp task affinity( b[:7][0:0][:0]) /* { dg-error "zero length array section" } */
+ bar2 (a);
+ #pragma omp task affinity( c[:][:][10:]) /* { dg-error "zero length array section" } */
+ bar2 (c);
+ #pragma omp task affinity( a[2:4][3:0][:x]) /* { dg-error "zero length array section" } */
+ bar2 (a);
+ #pragma omp task affinity( b[:x][0:0][:0]) /* { dg-error "zero length array section" } */
+ bar2 (a);
+ #pragma omp task affinity( c[:][x-2:x][10:]) /* { dg-error "zero length array section" } */
+ bar2 (c);
+}
+
+void
+foo4 (int *p, int (*q)[10], int r[10], int s[10][10])
+{
+ int a[10], b[10][10];
+ #pragma omp task affinity ( p[-1:2])
+ ;
+ #pragma omp task affinity ( q[-1:2][2:4])
+ ;
+ #pragma omp task affinity ( q[-1:2][-2:4]) /* { dg-error "negative low bound in array section in" } */
+ ;
+ #pragma omp task affinity ( r[-1:2])
+ ;
+ #pragma omp task affinity ( s[-1:2][2:4])
+ ;
+ #pragma omp task affinity ( s[-1:2][-2:4]) /* { dg-error "negative low bound in array section in" } */
+ ;
+ #pragma omp task affinity ( a[-1:2]) /* { dg-error "negative low bound in array section in" } */
+ ;
+ #pragma omp task affinity ( b[-1:2][2:4]) /* { dg-error "negative low bound in array section in" } */
+ ;
+ #pragma omp task affinity ( b[1:2][-2:4]) /* { dg-error "negative low bound in array section in" } */
+ ;
+ #pragma omp task affinity ( p[2:-3]) /* { dg-error "negative length in array section in" } */
+ ;
+ #pragma omp task affinity ( q[2:-3][:]) /* { dg-error "negative length in array section in" } */
+ ;
+ #pragma omp task affinity ( q[2:3][0:-1]) /* { dg-error "negative length in array section in" } */
+ ;
+ #pragma omp task affinity ( r[2:-5]) /* { dg-error "negative length in array section in" } */
+ ;
+ #pragma omp task affinity ( s[2:-5][:]) /* { dg-error "negative length in array section in" } */
+ ;
+ #pragma omp task affinity ( s[2:5][0:-4]) /* { dg-error "negative length in array section in" } */
+ ;
+ #pragma omp task affinity ( a[2:-5]) /* { dg-error "negative length in array section in" } */
+ ;
+ #pragma omp task affinity ( b[2:-5][0:10]) /* { dg-error "negative length in array section in" } */
+ ;
+ #pragma omp task affinity ( b[2:5][0:-4]) /* { dg-error "negative length in array section in" } */
+ ;
+}
+
+struct T { int c[3]; };
+struct S { int a; struct T *b; struct T g; };
+struct S sd[10];
+struct S *se[10];
+struct S *sf;
+struct S sh;
+struct U { int a : 5; };
+struct U si;
+
+
+void
+foo5 (void)
+{
+ #pragma omp task affinity( sd)
+ ;
+ #pragma omp task affinity( sd[2])
+ ;
+ #pragma omp task affinity( sd[:])
+ ;
+ #pragma omp task affinity( sd[2:2])
+ ;
+ #pragma omp task affinity( sd[:2])
+ ;
+ #pragma omp task affinity( sd[1].b->c[2])
+ ;
+ #pragma omp task affinity( sd[0].a)
+ ;
+ #pragma omp task affinity( se[3]->a)
+ ;
+ #pragma omp task affinity( se[2]->b->c)
+ ;
+ #pragma omp task affinity( se[1]->b->c[2])
+ ;
+ #pragma omp task affinity( (*sf).a)
+ ;
+ #pragma omp task affinity( sf->b->c[0])
+ ;
+ #pragma omp task affinity( sf)
+ ;
+ #pragma omp task affinity( *sf)
+ ;
+ #pragma omp task affinity( sf[0])
+ ;
+ #pragma omp task affinity( sf[0].a)
+ ;
+ #pragma omp task affinity( sh.g.c[2])
+ ;
+}
+
+void
+foo6 (void)
+{
+ #pragma omp task affinity( sd[:2].b->c[2]) /* { dg-error "expected" } */
+ ;
+ #pragma omp task affinity( sd[1:].b->c[2]) /* { dg-error "expected" } */
+ ;
+ #pragma omp task affinity( sd[0:1].a) /* { dg-error "expected" } */
+ ;
+ #pragma omp task affinity( se[3:2]->a) /* { dg-error "expected" } */
+ ;
+ #pragma omp task affinity( se[2:2]->b->c) /* { dg-error "expected" } */
+ ;
+ #pragma omp task affinity( se[1]->b->c[2:1]) /* { dg-error "expected" } */
+ ;
+ #pragma omp task affinity( sf + 0) /* { dg-error "'sf' is not lvalue expression nor array section in 'affinity' clause" } */
+ ;
+ #pragma omp task affinity( sf[0:1].a) /* { dg-error "expected" } */
+ ;
+ #pragma omp task affinity( sh.g.c[2:1]) /* { dg-error "expected" } */
+ ;
+ #pragma omp task affinity( si.a) /* { dg-error "bit-field 'si\\..*a' in 'affinity' clause" } */
+ ;
+}
+/* { dg-additional-options "-Wno-volatile" { target c++ } } */
diff --git a/gcc/testsuite/c-c++-common/gomp/affinity-3.c b/gcc/testsuite/c-c++-common/gomp/affinity-3.c
new file mode 100644
index 00000000000..1a476543048
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/affinity-3.c
@@ -0,0 +1,77 @@
+/* { dg-additional-options "-Wno-volatile" { target c++ } } */
+
+int arr[64], arr2[64];
+struct S { int a[4]; } k;
+short arr4[4];
+volatile int v;
+#define TEST_EQ(x,y) ({ int o[x == y ? 1 : -1]; 0; })
+
+void
+foo (unsigned char i, signed char j)
+{
+ #pragma omp task affinity (iterator (j=6:2:-2) : \
+ arr[TEST_EQ (sizeof (j), sizeof (int)), \
+ TEST_EQ (sizeof (i), sizeof (unsigned char)), \
+ TEST_EQ (sizeof (k), sizeof (struct S)), j], \
+ arr2[TEST_EQ (((__typeof (j)) -1) < 0, 1), \
+ TEST_EQ (((__typeof (i)) -1) < 0, 0), \
+ TEST_EQ (((__typeof (k.a[0])) -1) < 0, 1), j]) \
+ affinity(arr[0]) \
+ affinity (iterator (long long i=__LONG_LONG_MAX__ - 4:__LONG_LONG_MAX__ - 2:2, \
+ unsigned short j=~0U-16:~0U-8:3, \
+ short *k=&arr4[1]:&arr4[2]:1) : \
+ arr[TEST_EQ (sizeof (i), sizeof (long long)), \
+ TEST_EQ (sizeof (j), sizeof (unsigned short)), \
+ TEST_EQ (sizeof (k), sizeof (short *)), \
+ TEST_EQ (sizeof (*k), sizeof (short)), i - __LONG_LONG_MAX__ + 4], \
+ arr2[TEST_EQ (((__typeof (i)) -1) < 0, 1), \
+ TEST_EQ (((__typeof (j)) -1) < 0, 0), \
+ TEST_EQ (((__typeof (*k)) -1) < 0, 1), j - (~0U-16)], \
+ arr2[k - &arr4[0]]) \
+ affinity( k)
+ v++;
+}
+
+void
+bar (unsigned char i, signed char j)
+{
+ int m = j;
+ int n = j + 2;
+ #pragma omp task affinity (iterator (j=6:2:m) : \
+ arr[TEST_EQ (sizeof (j), sizeof (int)), \
+ TEST_EQ (sizeof (i), sizeof (unsigned char)), \
+ TEST_EQ (sizeof (k), sizeof (struct S)), j], \
+ arr2[TEST_EQ (((__typeof (j)) -1) < 0, 1), \
+ TEST_EQ (((__typeof (i)) -1) < 0, 0), \
+ TEST_EQ (((__typeof (k.a[0])) -1) < 0, 1), j]) \
+ affinity( arr[0]) \
+ affinity (iterator (long long i=__LONG_LONG_MAX__ - 4 - n:__LONG_LONG_MAX__ - 2:2, \
+ unsigned short j=~0U-16:~0U-8-n:3, \
+ short *k=&arr4[1]:&arr4[n + 2]:1) : \
+ arr[TEST_EQ (sizeof (i), sizeof (long long)), \
+ TEST_EQ (sizeof (j), sizeof (unsigned short)), \
+ TEST_EQ (sizeof (k), sizeof (short *)), \
+ TEST_EQ (sizeof (*k), sizeof (short)), i - __LONG_LONG_MAX__ + 4], \
+ arr2[TEST_EQ (((__typeof (i)) -1) < 0, 1), \
+ TEST_EQ (((__typeof (j)) -1) < 0, 0), \
+ TEST_EQ (((__typeof (*k)) -1) < 0, 1), j - (~0U-16)], \
+ arr2[k - &arr4[0]:10]) \
+ affinity( k)
+ v++;
+}
+
+void
+baz (void)
+{
+ #pragma omp parallel
+ #pragma omp master
+ {
+ #pragma omp task affinity(iterator(unsigned long int k = 0 : 2) : \
+ arr[TEST_EQ (sizeof (k), sizeof (unsigned long)), \
+ TEST_EQ (((__typeof (k)) -1) < 0, 0), k]) \
+ affinity(iterator(signed char s = -3 : -12 : -1) : \
+ arr[TEST_EQ (sizeof (s), sizeof (signed char)), \
+ TEST_EQ (((__typeof (s)) -1) < 0, 1), s + 12])
+ v++;
+ }
+}
diff --git a/gcc/testsuite/c-c++-common/gomp/affinity-4.c b/gcc/testsuite/c-c++-common/gomp/affinity-4.c
new file mode 100644
index 00000000000..2a4df6dafa3
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/affinity-4.c
@@ -0,0 +1,77 @@
+int a, b[64];
+struct S { int c; } *d, *e;
+struct T;
+struct T *f, *g;
+int *h;
+
+void
+f1 (void)
+{
+ #pragma omp task affinity (iterator : a) /* { dg-error "expected" } */
+ ;
+ #pragma omp task affinity (iterator (for = 0 : 2) : a) /* { dg-error "expected" } */
+ ;
+ #pragma omp task affinity (iterator (5 = 0 : 2) : a) /* { dg-error "expected" } */
+ ;
+ #pragma omp task affinity (iterator (i : 0 : 2) : a) /* { dg-error "expected '='|name a type|expected" } */
+ ;
+ #pragma omp task affinity (iterator (i = 0, 1 : 2) : a) /* { dg-error "expected" } */
+ ;
+ #pragma omp task affinity (iterator (i = (0, 1) : 2) : a)
+ ;
+ #pragma omp task affinity (iterator (i = 0 : 1 : 2 : 3) : a) /* { dg-error "expected '.'" } */
+ ;
+ #pragma omp task affinity (iterator (i = 0 : 2, 3) : a) /* { dg-error "expected" } */
+ ;
+ #pragma omp task affinity (iterator (i = 0 : 10 : 2, 3) : a) /* { dg-error "expected" } */
+ ;
+ #pragma omp task affinity (iterator (i = 0:1), iterator (j = 0:1) : a) /* { dg-error "expected ':' before ',' token" } */
+ ;
+ #pragma omp task affinity (iterator (i = 0:32) : b[i*2:2])
+ ;
+ #pragma omp task affinity (iterator (struct S i = 0:1) : a) /* { dg-error "iterator 'i' has neither integral nor pointer type" } */
+ ;
+ #pragma omp task affinity (iterator (void i = 0:1) : a) /* { dg-error "iterator 'i' has neither integral nor pointer type" } */
+ ;
+ #pragma omp task affinity (iterator (float f = 0.2:0.4) : a) /* { dg-error "iterator 'f' has neither integral nor pointer type" } */
+ ;
+ #pragma omp task affinity (iterator (struct S *p = d:e:2) : a)
+ ;
+ #pragma omp task affinity (iterator (struct T *p = f:g) , a) /* { dg-error "expected ':' before ',' token" } */
+ ;
+ #pragma omp task affinity (iterator (int i = 0:4, \
+ struct U { int (*p)[i + 2]; } *p = 0:2) : a) /* { dg-error "type of iterator 'p' refers to outer iterator 'i'" "" { target c } } */
+ ; /* { dg-error "types may not be defined in iterator type|not an integral constant" "" { target c++ } .-1 } */
+ #pragma omp task affinity (iterator (i = 0:4, j = i:16) : a) /* { dg-error "begin expression refers to outer iterator 'i'" } */
+ ;
+ #pragma omp task affinity (iterator (i = 0:4, j = 2:i:1) : a) /* { dg-error "end expression refers to outer iterator 'i'" } */
+ ;
+ #pragma omp task affinity (iterator (i = 0:4, j = 2:8:i) : a) /* { dg-error "step expression refers to outer iterator 'i'" } */
+ ;
+ #pragma omp task affinity (iterator (i = *d:2) : a) /* { dg-error "aggregate value used where an integer was expected" "" { target c } } */
+ ; /* { dg-error "invalid cast from type 'S' to type 'int'" "" { target c++ } .-1 } */
+ #pragma omp task affinity (iterator (i = 2:*d:2) : a) /* { dg-error "aggregate value used where an integer was expected" "" { target c } } */
+ ; /* { dg-error "invalid cast from type 'S' to type 'int'" "" { target c++ } .-1 } */
+ #pragma omp task affinity (iterator (i = 2:4:*d) : a) /* { dg-error "iterator step with non-integral type" } */
+ ;
+ #pragma omp task affinity (iterator (i = 1.25:2.5:3) : a)
+ ;
+ #pragma omp task affinity (iterator (i = 1:2:3.5) : a) /* { dg-error "iterator step with non-integral type" } */
+ ;
+ #pragma omp task affinity (iterator (int *p = 23 : h) : a)
+ ;
+ #pragma omp task affinity (iterator (short i=1:3:0) : a) /* { dg-error "iterator 'i' has zero step" } */
+ ;
+ #pragma omp task affinity (iterator (i = 1 : 3 : 3 - 3) : a) /* { dg-error "iterator 'i' has zero step" } */
+ ;
+ #pragma omp task affinity (iterator (int *p = &b[6]:&b[9]:4 - 4) : a) /* { dg-error "iterator 'p' has zero step" } */
+ ;
+ #pragma omp task affinity (iterator (const int i = 0 : 2) : a) /* { dg-error "const qualified" } */
+ ;
+ #pragma omp task affinity (iterator (const long long unsigned i = 0 : 2) : a) /* { dg-error "const qualified" } */
+ ;
+#if !defined (__cplusplus) && __STDC_VERSION__ >= 201112L
+ #pragma omp task affinity (iterator (_Atomic unsigned i = 0 : 2) : a) /* { dg-error "_Atomic" "" { target c } } */
+ ;
+#endif
+}
diff --git a/gcc/testsuite/c-c++-common/gomp/affinity-5.c b/gcc/testsuite/c-c++-common/gomp/affinity-5.c
new file mode 100644
index 00000000000..194286d5818
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/affinity-5.c
@@ -0,0 +1,32 @@
+/* { dg-additional-options "-fdump-tree-gimple" } */
+int bar (int);
+int bar2 (int);
+
+void foobar()
+{
+ int d[64], e[64], f[64];
+#pragma omp task affinity (d, e[bar(5)], f[4:10])
+ ;
+}
+
+void
+foo (void)
+{
+ int a[64];
+#pragma omp task affinity (iterator (j=bar(0):bar(1):bar(2)) : a[bar(j)])
+ ;
+}
+void
+qux (void)
+{
+ int a[64], b[64], c[64];
+#pragma omp task affinity (iterator (j=bar(0):bar(1):bar(2)) : a[bar(j+1)], b[bar(j+2)], c[bar(j+3)])
+ ;
+}
+
+/* { dg-final { scan-tree-dump-times "= bar \\(5\\);" 1 "gimple" } } */
+/* { dg-final { scan-tree-dump-times "= bar \\(0\\);" 2 "gimple" } } */
+/* { dg-final { scan-tree-dump-times "= bar \\(1\\);" 2 "gimple" } } */
+/* { dg-final { scan-tree-dump-times "= bar \\(2\\);" 2 "gimple" } } */
+/* { dg-final { scan-tree-dump-times "= bar \\(j\\);" 1 "gimple" } } */
+/* { dg-final { scan-tree-dump-times "= bar \\(_.\\);" 3 "gimple" } } */
diff --git a/gcc/testsuite/c-c++-common/gomp/affinity-6.c b/gcc/testsuite/c-c++-common/gomp/affinity-6.c
new file mode 100644
index 00000000000..0c9cd59cccf
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/affinity-6.c
@@ -0,0 +1,36 @@
+/* { dg-additional-options "-fdump-tree-gimple" } */
+int bar (int);
+int bar2 (int);
+
+void foobar()
+{
+ int d[64], e[64], f[64];
+#pragma omp parallel default(none) /* { dg-note "enclosing 'parallel'" } */
+#pragma omp task affinity (d, e[bar(5)], f[4:10])
+ ;
+/* { dg-error "'f' not specified in enclosing 'parallel'" "" { target *-*-* } .-2 } */
+/* { dg-error "'e' not specified in enclosing 'parallel'" "" { target *-*-* } .-3 } */
+/* { dg-error "'d' not specified in enclosing 'parallel'" "" { target *-*-* } .-4 } */
+}
+
+void
+foo (void)
+{
+ int a[64];
+#pragma omp parallel default(none) /* { dg-note "enclosing 'parallel'" } */
+#pragma omp task affinity (iterator (j=bar(0):bar(1):bar(2)) : a[bar(j)])
+ ;
+/* { dg-error "'a' not specified in enclosing 'parallel'" "" { target *-*-* } .-2 } */
+}
+
+void
+qux (void)
+{
+ int a[64], b[64], c[64];
+#pragma omp parallel default(none) /* { dg-note "enclosing 'parallel'" } */
+#pragma omp task affinity (iterator (j=bar(0):bar(1):bar(2)) : a[bar(j+1)], b[bar(j+2)], c[bar(j+3)])
+ ;
+/* { dg-error "'a' not specified in enclosing 'parallel'" "" { target *-*-* } .-2 } */
+/* { dg-error "'c' not specified in enclosing 'parallel'" "" { target *-*-* } .-3 } */
+/* { dg-error "'b' not specified in enclosing 'parallel'" "" { target *-*-* } .-4 } */
+}
diff --git a/gcc/testsuite/gfortran.dg/gomp/affinity-clause-1.f90 b/gcc/testsuite/gfortran.dg/gomp/affinity-clause-1.f90
new file mode 100644
index 00000000000..13bdd36d0b4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/affinity-clause-1.f90
@@ -0,0 +1,33 @@
+! { dg-additional-options "-fdump-tree-original" }
+subroutine foo(x)
+ integer :: x
+ integer :: a, b(5), cc, d(5,5)
+ !$omp taskgroup
+ !$omp task affinity(a)
+ !$omp end task
+ !$omp task affinity(iterator(i=int(cos(1.0+a)):5, jj =2:5:2) : b(i), d(i,jj))
+ !$omp end task
+ !$omp task affinity(iterator(i=int(cos(1.0+a)):5) : b(i), d(i,i))
+ !$omp end task
+ !$omp task affinity (iterator(i=1:5): a)
+ !$omp end task
+ !$omp task affinity (iterator(i=1:5): a) affinity(iterator(i=1:5) : x)
+ !$omp end task
+ !$omp task affinity (iterator(integer(8) :: j=1:5, k=7:4:-1) : b(j+k),a) affinity (cc)
+ !$omp end task
+ !$omp end taskgroup
+end
+
+! { dg-final { scan-tree-dump-times "#pragma omp task affinity\\(a\\)" 1 "original" } }
+
+! { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ = .integer.kind=4.. __builtin_cosf ..real.kind=4.. a \\+ 1.0e\\+0\\);" 2 "original" } }
+
+! { dg-final { scan-tree-dump-times "#pragma omp task affinity\\(iterator\\(integer\\(kind=4\\) jj=2:5:2, integer\\(kind=4\\) i=D\\.\[0-9\]+:5:1\\):\\*\\(c_char \\*\\) &b\\\[.* <?i>? \\+ -1\\\]\\) affinity\\(iterator\\(integer\\(kind=4\\) jj=2:5:2, integer\\(kind=4\\) i=D\\.\[0-9\]+:5:1\\):\\*\\(c_char \\*\\) &d\\\[\\(.*jj \\* 5 \\+ .* <?i>?\\) \\+ -6\\\]\\)" 1 "original" } }
+
+! { dg final { scan-tree-dump-times "#pragma omp task affinity\\(iterator\\(integer\\(kind=4\\) i=D.3938:5:1\\):\\*\\(c_char \\*\\) &b\\\[\\(.* <?i>? \\+ -1\\\]\\) affinity\\(iterator\\(integer\\(kind=4\\) i=D\\.\[0-9\]+:5:1\\):\\*\\(c_char \\*\\) &d\\\[\\(\\(integer\\(kind=8\\)\\) i \\+ -1\\) \\* 6\\\]\\)" 1 "original" } }
+
+! { dg-final { scan-tree-dump-times "#pragma omp task affinity\\(iterator\\(integer\\(kind=4\\) i=1:5:1\\):a\\)\[^ \]" 1 "original" } }
+
+! { dg-final { scan-tree-dump-times "#pragma omp task affinity\\(iterator\\(integer\\(kind=4\\) i=1:5:1\\):a\\) affinity\\(iterator\\(integer\\(kind=4\\) i=1:5:1\\):\\*x\\)" 1 "original" } }
+
+! { dg-final { scan-tree-dump-times "#pragma omp task affinity\\(iterator\\(integer\\(kind=4\\) k=7:4:-1, integer\\(kind=8\\) j=1:5:1\\):\\*\\(c_char \\*\\) &b\\\[\\(?\\(integer\\(kind=.\\).* \[jk\] \\+ .*\[kj\]\\) \\+ -1\\\]\\) affinity\\(iterator\\(integer\\(kind=4\\) k=7:4:-1, integer\\(kind=8\\) j=1:5:1\\):a\\) affinity\\(cc\\)" 1 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/gomp/affinity-clause-2.f90 b/gcc/testsuite/gfortran.dg/gomp/affinity-clause-2.f90
new file mode 100644
index 00000000000..6a21ad26a89
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/affinity-clause-2.f90
@@ -0,0 +1,27 @@
+subroutine foo
+ implicit none
+ external bar
+ integer :: i, b(10)
+ !$omp task affinity(bar(1)) ! { dg-error "not a variable" }
+ !!$omp end task
+ !$omp task affinity(b(1.0)) ! { dg-warning "Legacy Extension: REAL array index" }
+ !$omp end task
+ !$omp task affinity( iterator( real :: i=1.0:5:1) : b(i)) ! { dg-error "Expected INTEGER type" }
+ !!$omp end task
+ !$omp task affinity(iterator(i=1.0:5:1) : b(i)) ! { dg-error "Scalar integer expression for range begin expected" }
+ !$omp end task
+ !$omp task affinity(iterator(i=1:5.0:1) : b(i)) ! { dg-error "Scalar integer expression for range end expected" }
+ !$omp end task
+ !$omp task affinity(iterator(i=1:5:1.0) : b(i)) ! { dg-error "Scalar integer expression for range step expected" }
+ !$omp end task
+ !$omp task affinity(iterator(j=1:3:5, i=1:5:0) : b(i)) ! { dg-error "Nonzero range step expected" }
+ !$omp end task
+ !$omp task affinity(iterator(=1:5:0) : b(i)) ! { dg-error "Expected identifier" }
+ !!$omp end task
+ !$omp task affinity(iterator(b(2)=1:5:0) : b(i)) ! { dg-error "Failed to match clause" }
+ !!$omp end task
+ !$omp task affinity(iterator(i=1:5:0, i=4:6) : b(i)) ! { dg-error "Same identifier 'i' specified again" }
+ !!$omp end task
+ !$omp task affinity(iterator(i=1) : b(i)) ! { dg-error "Expected range-specification" }
+ !!$omp end task
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/affinity-clause-3.f90 b/gcc/testsuite/gfortran.dg/gomp/affinity-clause-3.f90
new file mode 100644
index 00000000000..3fd39fe6b8b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/affinity-clause-3.f90
@@ -0,0 +1,14 @@
+! { dg-additional-options "-fdump-tree-gimple" }
+subroutine foo
+ integer :: A(10), B(10), C(10)
+ interface
+ integer function ibar(x)
+ integer :: x
+ end function ibar
+ end interface
+
+ !$omp task affinity (iterator(j=ibar(0):ibar(1):ibar(2)) : a(ibar(j)), b(j), c(j))
+ !$omp end task
+end
+! { dg-final { scan-tree-dump-times "= ibar \\(&C\\." 3 "gimple" } }
+! { dg-final { scan-tree-dump-times "= ibar \\(j\\." 1 "gimple" } }
diff --git a/gcc/testsuite/gfortran.dg/gomp/affinity-clause-4.f90 b/gcc/testsuite/gfortran.dg/gomp/affinity-clause-4.f90
new file mode 100644
index 00000000000..0d07efd3f30
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/affinity-clause-4.f90
@@ -0,0 +1,16 @@
+subroutine foo
+ integer :: A(10), B(10), C(10)
+ interface
+ integer function ibar(x)
+ integer :: x
+ end function ibar
+ end interface
+
+ !$omp parallel default(none) ! { dg-note "enclosing 'parallel'" }
+ !$omp task affinity (iterator(j=ibar(0):ibar(1):ibar(2)) : a(ibar(j)), b(j), c(j))
+ !$omp end task
+ !$omp end parallel
+! { dg-error "'a' not specified in enclosing 'parallel'" "" { target *-*-* } .-3 }
+! { dg-error "'b' not specified in enclosing 'parallel'" "" { target *-*-* } .-4 }
+! { dg-error "'c' not specified in enclosing 'parallel'" "" { target *-*-* } .-5 }
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/depend-iterator-1.f90 b/gcc/testsuite/gfortran.dg/gomp/depend-iterator-1.f90
new file mode 100644
index 00000000000..cad36aaf8b7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/depend-iterator-1.f90
@@ -0,0 +1,45 @@
+! { dg-do run }
+
+module mymod
+ implicit none (type, external)
+ integer, target :: var(0:5) = [0,1,2,3,4,5]
+end module mymod
+
+program main
+ use mymod
+ implicit none
+
+ type t
+ integer :: x(0:64)
+ integer :: y
+ end type t
+ type(t) :: dep2(0:64)
+ integer :: dep1(0:64)
+
+ integer arr(0:63)
+ !$omp parallel
+ !$omp master
+ block
+ integer :: i
+ do i = 0, 63
+ !$omp task depend (iterator (j=i:i+1) , out : dep1 (j))
+ arr(i) = i
+ !$omp end task
+ !$omp task depend (iterator (j=i:i+1) , out : dep2 (j))
+ arr(i) = i
+ !$omp end task
+ !$omp task depend (iterator (j=i:i+1) , out : dep2 (j)%y)
+ arr(i) = i
+ !$omp end task
+ !$omp task depend (iterator (j=i:i+1) , out : dep2 (j)%x(j))
+ arr(i) = i
+ !$omp end task
+ !$omp task depend (out : dep2 (:4))
+ arr(i) = i
+ !$omp end task
+ !$omp taskwait depend(out: dep1(1))
+ end do
+ end block
+ !$omp end master
+ !$omp end parallel
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/depend-iterator-2.f90 b/gcc/testsuite/gfortran.dg/gomp/depend-iterator-2.f90
new file mode 100644
index 00000000000..fa826a71097
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/depend-iterator-2.f90
@@ -0,0 +1,44 @@
+! { dg-do run }
+
+module mymod
+ implicit none (type, external)
+ integer, target :: var(0:5) = [0,1,2,3,4,5]
+contains
+ function foo (i)
+ integer :: i
+ integer, pointer :: foo
+ foo => var(mod(i, 6))
+ end
+end module mymod
+
+program main
+ use mymod
+ implicit none
+
+ type t
+ integer :: x(0:64)
+ integer :: y
+ end type t
+ type(t) :: dep2(0:64)
+ integer :: dep1(0:64)
+
+ integer arr(0:63)
+ !$omp parallel
+ !$omp master
+ block
+ integer :: i
+ do i = 0, 63
+ ! NB: Revoking foo (pointer returning function) as in 'foo(i)' is a variable in the Fortran sense
+ !$omp task depend (iterator (j=i:i+1) , out : foo (j)) ! { dg-error "is not a variable" }
+ arr(i) = i
+ !!$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 end task
+
+ end do
+ end block
+ !$omp end master
+ !$omp end parallel
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/depend-iterator-3.f90 b/gcc/testsuite/gfortran.dg/gomp/depend-iterator-3.f90
new file mode 100644
index 00000000000..85465ee4c7a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/depend-iterator-3.f90
@@ -0,0 +1,27 @@
+subroutine foo
+ implicit none
+ external bar
+ integer :: i, b(10)
+ !$omp task depend(in : bar(1)) ! { dg-error "not a variable" }
+ !!$omp end task
+ !$omp task depend(out : b(1.0)) ! { dg-warning "Legacy Extension: REAL array index" }
+ !$omp end task
+ !$omp task depend( iterator( real :: i=1.0:5:1), in : b(i)) ! { dg-error "Expected INTEGER type" }
+ !!$omp end task
+ !$omp task depend(iterator(i=1.0:5:1), out : b(i)) ! { dg-error "Scalar integer expression for range begin expected" }
+ !$omp end task
+ !$omp task depend(iterator(i=1:5.0:1), in : b(i)) ! { dg-error "Scalar integer expression for range end expected" }
+ !$omp end task
+ !$omp task depend(iterator(i=1:5:1.0), in : b(i)) ! { dg-error "Scalar integer expression for range step expected" }
+ !$omp end task
+ !$omp task depend(iterator(j=1:3:5, i=1:5:0), out : b(i)) ! { dg-error "Nonzero range step expected" }
+ !$omp end task
+ !$omp task depend(iterator(=1:5:0), in : b(i)) ! { dg-error "Expected identifier" }
+ !!$omp end task
+ !$omp task depend(iterator(b(2)=1:5:1), in : b(i)) ! { dg-error "Failed to match clause" }
+ !!$omp end task
+ !$omp task depend(iterator(i=1:5:0, i=4:6), out: b(i)) ! { dg-error "Same identifier 'i' specified again" }
+ !!$omp end task
+ !$omp task depend(iterator(i=1) ,out: b(i)) ! { dg-error "Expected range-specification" }
+ !!$omp end task
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/taskwait.f90 b/gcc/testsuite/gfortran.dg/gomp/taskwait.f90
new file mode 100644
index 00000000000..80ae24a1191
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/taskwait.f90
@@ -0,0 +1,7 @@
+! { dg-additional-options "-fdump-tree-original" }
+!$omp taskwait
+!$omp taskwait depend(out:foo)
+end
+
+! { dg-final { scan-tree-dump-times "__builtin_GOMP_taskwait \\(\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "#pragma omp taskwait depend\\(out:foo\\)" 1 "original" } }
diff --git a/gcc/tree-core.h b/gcc/tree-core.h
index 07ddf91a230..e15e6c651f0 100644
--- a/gcc/tree-core.h
+++ b/gcc/tree-core.h
@@ -277,6 +277,9 @@ enum omp_clause_code {
/* OpenMP clause: linear (variable-list[:linear-step]). */
OMP_CLAUSE_LINEAR,
+ /* OpenMP clause: affinity([depend-modifier :] variable-list). */
+ OMP_CLAUSE_AFFINITY,
+
/* OpenMP clause: aligned (variable-list[:alignment]). */
OMP_CLAUSE_ALIGNED,
diff --git a/gcc/tree-pretty-print.c b/gcc/tree-pretty-print.c
index 0a575eb9dad..d8a4f55b2ae 100644
--- a/gcc/tree-pretty-print.c
+++ b/gcc/tree-pretty-print.c
@@ -743,6 +743,22 @@ dump_omp_clause (pretty_printer *pp, tree clause, int spc, dump_flags_t flags)
pp_right_paren (pp);
break;
+ case OMP_CLAUSE_AFFINITY:
+ pp_string (pp, "affinity(");
+ {
+ tree t = OMP_CLAUSE_DECL (clause);
+ if (TREE_CODE (t) == TREE_LIST
+ && TREE_PURPOSE (t)
+ && TREE_CODE (TREE_PURPOSE (t)) == TREE_VEC)
+ {
+ dump_omp_iterators (pp, TREE_PURPOSE (t), spc, flags);
+ pp_colon (pp);
+ t = TREE_VALUE (t);
+ }
+ dump_generic_node (pp, t, spc, flags, false);
+ }
+ pp_right_paren (pp);
+ break;
case OMP_CLAUSE_DEPEND:
pp_string (pp, "depend(");
switch (OMP_CLAUSE_DEPEND_KIND (clause))
@@ -803,8 +819,11 @@ dump_omp_clause (pretty_printer *pp, tree clause, int spc, dump_flags_t flags)
pp_colon (pp);
t = TREE_VALUE (t);
}
- pp_string (pp, name);
- pp_colon (pp);
+ if (name[0])
+ {
+ pp_string (pp, name);
+ pp_colon (pp);
+ }
dump_generic_node (pp, t, spc, flags, false);
pp_right_paren (pp);
}
diff --git a/gcc/tree.c b/gcc/tree.c
index bdb29b82303..5000d9e9c22 100644
--- a/gcc/tree.c
+++ b/gcc/tree.c
@@ -288,6 +288,7 @@ unsigned const char omp_clause_num_ops[] =
1, /* OMP_CLAUSE_COPYIN */
1, /* OMP_CLAUSE_COPYPRIVATE */
3, /* OMP_CLAUSE_LINEAR */
+ 1, /* OMP_CLAUSE_AFFINITY */
2, /* OMP_CLAUSE_ALIGNED */
2, /* OMP_CLAUSE_ALLOCATE */
1, /* OMP_CLAUSE_DEPEND */
@@ -374,6 +375,7 @@ const char * const omp_clause_code_name[] =
"copyin",
"copyprivate",
"linear",
+ "affinity",
"aligned",
"allocate",
"depend",
@@ -11090,6 +11092,7 @@ walk_tree_1 (tree *tp, walk_tree_fn func, void *data,
WALK_SUBTREE (OMP_CLAUSE_OPERAND (*tp, 1));
/* FALLTHRU */
+ case OMP_CLAUSE_AFFINITY:
case OMP_CLAUSE_ASYNC:
case OMP_CLAUSE_WAIT:
case OMP_CLAUSE_WORKER:
diff --git a/libgomp/testsuite/libgomp.fortran/depend-iterator-2.f90 b/libgomp/testsuite/libgomp.fortran/depend-iterator-2.f90
new file mode 100644
index 00000000000..05090d36c80
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/depend-iterator-2.f90
@@ -0,0 +1,89 @@
+module m
+ implicit none (type, external)
+ integer, volatile :: v
+contains
+subroutine foo (p, i)
+ integer :: p(0:*)
+ integer :: i
+ !$omp task depend (out: p(0))
+ v = v + 1
+ !$omp end task
+ !$omp task depend (in: p(0))
+ v = v + 1
+ !$omp end task
+ !$omp task depend (inout: p(0))
+ v = v + 1
+ !$omp end task
+ !$omp task depend (mutexinoutset: p(0))
+ v = v + 1
+ !$omp end task
+ !$omp task depend (out: p(0)) depend (in: p(1))
+ v = v + 1
+ !$omp end task
+ !$omp task depend (in: p(0)) depend (inout: p(1))
+ v = v + 1
+ !$omp end task
+ !$omp task depend (inout: p(0)) depend (mutexinoutset: p(1))
+ v = v + 1
+ !$omp end task
+ !$omp task depend (mutexinoutset: p(0)) depend (out: p(1))
+ v = v + 1
+ !$omp end task
+ !$omp task depend (iterator (j=0:2) , out : p(j))
+ v = v + 1
+ !$omp end task
+ !$omp task depend (iterator (j=0:2) , in : p(j))
+ v = v + 1
+ !$omp end task
+ !$omp task depend (iterator (j=0:2) , inout : p(j))
+ v = v + 1
+ !$omp end task
+ !$omp task depend (iterator (j=0:2) , mutexinoutset : p(j))
+ v = v + 1
+ !$omp end task
+ !$omp task depend (iterator (j=0:2) , out : p(j)) depend (iterator (j=0:2) , in : p(j + 2))
+ v = v + 1
+ !$omp end task
+ !$omp task depend (iterator (j=0:2) , in : p(j)) depend (iterator (j=0:2) , inout : p(j + 2))
+ v = v + 1
+ !$omp end task
+ !$omp task depend (iterator (j=0:2) , inout : p(j)) depend (iterator (j=0:2) , mutexinoutset : p(j + 2))
+ v = v + 1
+ !$omp end task
+ !$omp task depend (iterator (j=0:2) , mutexinoutset : p(j)) depend (iterator (j=0:2) , out : p(j + 2))
+ v = v + 1
+ !$omp end task
+ !$omp task depend (iterator (j=0:i) , out : p(j))
+ v = v + 1
+ !$omp end task
+ !$omp task depend (iterator (j=0:i) , in : p(j))
+ v = v + 1
+ !$omp end task
+ !$omp task depend (iterator (j=0:i) , inout : p(j))
+ v = v + 1
+ !$omp end task
+ !$omp task depend (iterator (j=0:i) , mutexinoutset : p(j))
+ v = v + 1
+ !$omp end task
+ !$omp task depend (iterator (j=0:i) , out : p(j)) depend (iterator (j=0:i) , in : p(j + 2))
+ v = v + 1
+ !$omp end task
+ !$omp task depend (iterator (j=0:i) , in : p(j)) depend (iterator (j=0:i) , inout : p(j + 2))
+ v = v + 1
+ !$omp end task
+ !$omp task depend (iterator (j=0:i) , inout : p(j)) depend (iterator (j=0:i) , mutexinoutset : p(j + 2))
+ v = v + 1
+ !$omp end task
+ !$omp task depend (iterator (j=0:i) , mutexinoutset : p(j)) depend (iterator (j=0:i) , out : p(j + 2))
+ v = v + 1
+ !$omp end task
+end
+end module
+
+program main
+ use m
+ implicit none (external, type)
+ integer p(4)
+ call foo (p, 2)
+ call foo (p, -1)
+end
