* [Patch] OpenMP: Add iterator support to Fortran's depend; add affinity clause
@ 2021-04-27 13:36 Tobias Burnus
2021-04-28 13:41 ` Jakub Jelinek
0 siblings, 1 reply; 13+ messages in thread
From: Tobias Burnus @ 2021-04-27 13:36 UTC (permalink / raw)
To: gcc-patches, fortran, Jakub Jelinek
[-- Attachment #1: Type: text/plain, Size: 1994 bytes --]
OpenMP 5's iterator can be used for
- depend clause
- affinity clause
- mapping (unsupported and not touched)
(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.
The way the iterator is stored in Fortran is a bit convoluted,
but should be fine:
new namespace (such that symbols can be overridden and resolution works),
using symbol->value for the iteration (begin:end:step) as array constructor,
and abusing the ns->proc_name + its '->tlink' to generate an linked list,
which avoids walking the ns->sym_root tree and has the user's order in
the dump instead of the tree-walking order.
The ME implementation also seems to require a very special way the
variables are stored. – It seems as if it works correctly for depend;
hence, I hope I did correctly read the dump and tree sharing is correctly
handled.
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:
'iterator(integer i=1:10)' – namely: is this the integer 'i' or the variable
'integeri' (as spaces are ignored in fixed-form Fortran)?
NOTE 2: The way it is implemented, the 'begin:end:step' expression is evaluated
multiple times - once per list item; I think this matches C, but I am not completely
sure nor whether that is a problem. (Unlikely a real-world problem.)
NOTE 3: I did have some trouble reading the spec with regards to what in C is permitted
for 'affinity' ('locator-list); the code now mostly follows what is permitted for 'depend'.
OK?
Tobias
-----------------
Mentor Graphics (Deutschland) GmbH, Arnulfstrasse 201, 80634 München Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung, Frank Thürauf
[-- Attachment #2: omp-iterator-affinity.diff --]
[-- Type: text/x-patch, Size: 90048 bytes --]
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.
* gfortran.dg/gomp/affinity-clause-1.f90: New test.
* gfortran.dg/gomp/affinity-clause-2.f90: New test.
* gfortran.dg/gomp/depend-iterator-2.f90: New test.
* gfortran.dg/gomp/depend-iterator.f90: New test.
gcc/c-family/c-pragma.h | 1 +
gcc/c/c-parser.c | 64 ++++-
gcc/c/c-typeck.c | 54 ++--
gcc/cp/parser.c | 76 +++++-
gcc/cp/semantics.c | 56 +++--
gcc/fortran/dump-parse-tree.c | 51 +++-
gcc/fortran/gfortran.h | 9 +-
gcc/fortran/match.c | 18 +-
gcc/fortran/openmp.c | 280 +++++++++++++++++----
gcc/fortran/st.c | 2 +-
gcc/fortran/trans-openmp.c | 168 ++++++++++---
gcc/gimplify.c | 4 +
gcc/testsuite/c-c++-common/gomp/affinity-1.c | 20 ++
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 ++++++
.../gfortran.dg/gomp/affinity-clause-1.f90 | 31 +++
.../gfortran.dg/gomp/affinity-clause-2.f90 | 27 ++
.../gfortran.dg/gomp/depend-iterator-1.f90 | 45 ++++
.../gfortran.dg/gomp/depend-iterator-3.f90 | 27 ++
gcc/testsuite/gfortran.dg/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 +++++++
25 files changed, 1304 insertions(+), 140 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 5cdeb21a458..893cf755b0c 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,52 @@ c_parser_omp_iterators (c_parser *parser)
return ret ? ret : error_mark_node;
}
+/* OpenMP 5.0:
+ affinity( [depend-modifier :] variable-list)
+ depend-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 %<:%>"))
+ 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 +16523,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";
@@ -19239,7 +19292,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 51a62c800f7..47713c8fd9f 100644
--- a/gcc/c/c-typeck.c
+++ b/gcc/c/c-typeck.c
@@ -13063,7 +13063,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",
@@ -13114,14 +13115,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))
{
@@ -13130,7 +13133,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)))
{
@@ -13201,7 +13205,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)
@@ -13269,7 +13274,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)
@@ -13290,7 +13296,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)
@@ -13328,7 +13335,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)
@@ -13373,6 +13381,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),
@@ -13409,7 +13418,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)
@@ -13421,7 +13431,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;
@@ -14509,6 +14520,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)
@@ -14517,7 +14529,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))
@@ -14563,7 +14576,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 "
@@ -14578,17 +14592,24 @@ 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 (c) == OMP_CLAUSE_DEPEND
+ ? "depend" : "affinity");
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 (c) == OMP_CLAUSE_DEPEND
+ ? "depend" : "affinity");
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)))
{
@@ -14599,7 +14620,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 e1b1617da68..30d6dc14eb5 100644
--- a/gcc/cp/parser.c
+++ b/gcc/cp/parser.c
@@ -35063,7 +35063,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;
@@ -35322,7 +35324,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
@@ -35351,7 +35353,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;
@@ -35363,7 +35365,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,
@@ -35409,6 +35411,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:
@@ -35435,12 +35438,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))
@@ -35454,7 +35457,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;
@@ -35467,7 +35470,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)
@@ -37707,6 +37710,56 @@ cp_parser_omp_iterators (cp_parser *parser)
return ret ? ret : error_mark_node;
}
+/* OpenMP 5.0:
+ affinity( [depend-modifier :] variable-list)
+ depend-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))
+ {
+ 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 )
@@ -38649,6 +38702,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);
@@ -41234,7 +41291,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 4520181d4e5..47640efcefa 100644
--- a/gcc/cp/semantics.c
+++ b/gcc/cp/semantics.c
@@ -4999,7 +4999,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),
@@ -5086,7 +5087,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)
@@ -5154,7 +5156,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)
@@ -5175,7 +5178,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)
@@ -5213,7 +5217,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)
@@ -5257,7 +5262,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),
@@ -5305,7 +5311,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)
@@ -5317,7 +5324,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;
@@ -7428,6 +7436,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)
@@ -7436,7 +7445,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;
@@ -7461,7 +7471,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 "
@@ -7486,22 +7498,31 @@ 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 (c) == OMP_CLAUSE_DEPEND
+ ? "depend" : "affinity");
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 (c) == OMP_CLAUSE_DEPEND
+ ? "depend" : "affinity");
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 (c) == OMP_CLAUSE_DEPEND
+ ? "depend" : "affinity");
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))
@@ -7514,9 +7535,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 b50265ac742..7edcf8988d8 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 d12be0cdbab..1dda02edc72 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1256,7 +1256,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;
}
@@ -1274,6 +1278,7 @@ enum
OMP_LIST_SHARED,
OMP_LIST_COPYIN,
OMP_LIST_UNIFORM,
+ OMP_LIST_AFFINITY,
OMP_LIST_ALIGNED,
OMP_LIST_LINEAR,
OMP_LIST_DEPEND,
@@ -3319,7 +3324,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 a1b057227b7..c6f78a3cf70 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));
@@ -261,6 +263,7 @@ gfc_match_omp_variable_list (const char *str, gfc_omp_namelist **list,
case MATCH_YES:
gfc_expr *expr;
expr = NULL;
+ gfc_gobble_whitespace ();
if ((allow_sections && gfc_peek_ascii_char () == '(')
|| (allow_derived && gfc_peek_ascii_char () == '%'))
{
@@ -354,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;
}
@@ -444,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;
}
@@ -551,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;
}
@@ -842,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
@@ -995,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 ) */
@@ -1137,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)
@@ -1145,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;
@@ -1201,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;
@@ -1229,6 +1334,33 @@ 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)
+ 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)
@@ -1373,6 +1505,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)
@@ -1388,11 +1526,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;
@@ -1401,19 +1552,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
@@ -1665,7 +1823,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;
@@ -1673,7 +1831,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;
@@ -2808,7 +2966,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 \
@@ -3061,14 +3219,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;
}
@@ -4209,14 +4367,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));
}
@@ -4782,7 +4939,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",
@@ -5229,6 +5386,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:
@@ -5236,6 +5394,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
@@ -5377,7 +5569,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]
@@ -5385,9 +5578,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;
}
}
@@ -5631,23 +5826,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)
@@ -5686,14 +5881,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,
@@ -7321,6 +7516,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 9e761996eec..f6a0a6b5d57 100644
--- a/gcc/fortran/st.c
+++ b/gcc/fortran/st.c
@@ -267,7 +267,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 bf3f2617776..6209ba8b38c 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"
@@ -1750,7 +1751,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;
@@ -1869,9 +1870,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);
}
@@ -1880,7 +1881,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;
@@ -1930,11 +1931,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);
@@ -1984,7 +1985,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));
@@ -1997,7 +1998,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));
@@ -2272,12 +2273,70 @@ 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, se.expr);
+
+ /* 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, se.expr);
+
+ /* 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, se.expr);
+ }
+ 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 iterator = NULL_TREE;
+ tree tree_block = NULL_TREE;
+ stmtblock_t iter_block;
int list, ifc;
enum omp_clause_code clause_code;
gfc_se se;
@@ -2482,10 +2541,22 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
}
}
break;
+ case OMP_LIST_AFFINITY:
case OMP_LIST_DEPEND:
for (; n != NULL; n = n->next)
{
- if (n->u.depend_op == OMP_DEPEND_SINK_FIRST)
+ gfc_init_block (&iter_block);
+ iterator = NULL_TREE;
+ if (n->u2.ns)
+ {
+ tree_block = make_node (BLOCK);
+ TREE_USED (tree_block) = 1;
+ BLOCK_VARS (tree_block) = NULL_TREE;
+ iterator = handle_iterator (n->u2.ns, &iter_block,
+ tree_block);
+ }
+ if (list == OMP_LIST_DEPEND
+ && n->u.depend_op == OMP_DEPEND_SINK_FIRST)
{
tree vec = NULL_TREE;
unsigned int i;
@@ -2539,7 +2610,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);
@@ -2573,33 +2647,42 @@ 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)
+ 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 (n->u2.ns)
{
- 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 ();
+ BLOCK_SUBBLOCKS (tree_block) = gfc_finish_block (&iter_block);
+ TREE_VEC_ELT (iterator, 5) = tree_block;
+ OMP_CLAUSE_DECL (node) = build_tree_list (iterator, OMP_CLAUSE_DECL (node));
}
+ else
+ gfc_add_block_to_block (block, &iter_block);
omp_clauses = gfc_trans_add_clause (node, omp_clauses);
}
break;
@@ -5675,10 +5758,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
@@ -6307,7 +6403,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 b65106b1459..cd03ca8d0cb 100644
--- a/gcc/gimplify.c
+++ b/gcc/gimplify.c
@@ -9506,6 +9506,10 @@ gimplify_scan_omp_clauses (tree *list_p, gimple_seq *pre_p,
goto do_add;
+ case OMP_CLAUSE_AFFINITY:
+ /* Ignore. */
+ 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..558e316bccd
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/affinity-1.c
@@ -0,0 +1,20 @@
+void
+foo(int x)
+{
+ int a, b[5], cc, d[5][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/gfortran.dg/gomp/affinity-clause-1.f90 b/gcc/testsuite/gfortran.dg/gomp/affinity-clause-1.f90
new file mode 100644
index 00000000000..3e99affdfb4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/affinity-clause-1.f90
@@ -0,0 +1,31 @@
+! { 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 "#pragma omp task affinity\\(iterator\\(integer\\(kind=4\\) jj=2:5:2, integer\\(kind=4\\) i=\\(integer\\(kind=4\\)\\) __builtin_cosf \\(\\(real\\(kind=4\\)\\) a \\+ 1.0e\\+0\\):5:1\\):\\*\\(c_char \\*\\) &b\\\[\\(integer\\(kind=8\\)\\) i \\+ -1\\\]\\) affinity\\(iterator\\(integer\\(kind=4\\) jj=2:5:2, integer\\(kind=4\\) i=\\(integer\\(kind=4\\)\\) __builtin_cosf \\(\\(real\\(kind=4\\)\\) a \\+ 1.0e\\+0\\):5:1\\):\\*\\(c_char \\*\\) &d\\\[\\(\\(integer\\(kind=8\\)\\) jj \\* 5 \\+ \\(integer\\(kind=8\\)\\) i\\) \\+ -6\\\]\\)" 1 "original" } }
+
+! { dg final { scan-tree-dump-times "#pragma omp task affinity\\(iterator\\(integer\\(kind=4\\) i=\\(integer\\(kind=4\\)\\) __builtin_cosf \\(\\(real\\(kind=4\\)\\) a \\+ 1.0e\\+0\\):5:1\\):\\*\\(c_char \\*\\) &b\\\[\\(integer\\(kind=8\\)\\) i \\+ -1\\\]\\) affinity\\(iterator\\(integer\\(kind=4\\) i=\\(integer\\(kind=4\\)\\) __builtin_cosf \\(\\(real\\(kind=4\\)\\) a \\+ 1.0e+0\\):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=8\\)\\) k \\+ j\\) \\+ -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/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-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/taskwait.f90 b/gcc/testsuite/gfortran.dg/taskwait.f90
new file mode 100644
index 00000000000..ea49d298cb0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/taskwait.f90
@@ -0,0 +1,7 @@
+! { dg-additional-arguments "-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 6129d911ee6..2d383e21e60 100644
--- a/gcc/tree.c
+++ b/gcc/tree.c
@@ -290,6 +290,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 */
@@ -376,6 +377,7 @@ const char * const omp_clause_code_name[] =
"copyin",
"copyprivate",
"linear",
+ "affinity",
"aligned",
"allocate",
"depend",
@@ -12227,6 +12229,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
^ permalink raw reply [flat|nested] 13+ messages in thread
* Re: [Patch] OpenMP: Add iterator support to Fortran's depend; add affinity clause
2021-04-27 13:36 [Patch] OpenMP: Add iterator support to Fortran's depend; add affinity clause Tobias Burnus
@ 2021-04-28 13:41 ` Jakub Jelinek
2021-04-28 20:26 ` [Patch] Fortran/OpenMP: Fix var-list expr parsing with array/dt (was: [Patch] OpenMP: Add iterator support to Fortran's depend; add affinity clause) Tobias Burnus
[not found] ` <3bfa68db-f904-a1cb-0d18-c1a17ecfc720@codesourcery.com>
0 siblings, 2 replies; 13+ messages in thread
From: Jakub Jelinek @ 2021-04-28 13:41 UTC (permalink / raw)
To: Tobias Burnus; +Cc: gcc-patches, fortran
On Tue, Apr 27, 2021 at 03:36:38PM +0200, Tobias Burnus wrote:
> OpenMP 5's iterator can be used for
> - depend clause
> - affinity clause
> - mapping (unsupported and not touched)
>
> (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.
>
> The way the iterator is stored in Fortran is a bit convoluted,
> but should be fine:
> new namespace (such that symbols can be overridden and resolution works),
> using symbol->value for the iteration (begin:end:step) as array constructor,
> and abusing the ns->proc_name + its '->tlink' to generate an linked list,
> which avoids walking the ns->sym_root tree and has the user's order in
> the dump instead of the tree-walking order.
>
> The ME implementation also seems to require a very special way the
> variables are stored. – It seems as if it works correctly for depend;
> hence, I hope I did correctly read the dump and tree sharing is correctly
> handled.
>
> 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?
> 'iterator(integer i=1:10)' – namely: is this the integer 'i' or the variable
> 'integeri' (as spaces are ignored in fixed-form Fortran)?
> NOTE 2: The way it is implemented, the 'begin:end:step' expression is evaluated
> multiple times - once per list item; I think this matches C, but I am not completely
> sure nor whether that is a problem. (Unlikely a real-world problem.)
I believe C evaluates them just once and it would be nice if that could be
the case for Fortran too.
At least, looking at:
int bar (int);
void
foo (void)
{
int a[64];
#pragma omp task depend (iterator (j=bar(0):bar(1):bar(2)) , out : a[j])
;
}
I see all the bar calls just once:
saved_stack.6 = __builtin_stack_save ();
try
{
_1 = bar (0);
_2 = bar (1);
D.2078 = bar (2);
and never afterwards. So, it would be nice if Fortran could do the same,
wrap stuff in SAVE_EXPR or whatever is needed for that.
And even
void
qux (void)
{
int a[64], b[64], c[64];
#pragma omp task depend (iterator (j=bar(0):bar(1):bar(2)) , out : a[j], b[j], c[j])
;
}
seems to evaluate just once.
> NOTE 3: I did have some trouble reading the spec with regards to what in C is permitted
> for 'affinity' ('locator-list); the code now mostly follows what is permitted for 'depend'.
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. Of course, depend (iterator (...),out : a[j]) depend(iterator (...),out : b[j])
will emit two different loops.
> @@ -15508,6 +15511,52 @@ c_parser_omp_iterators (c_parser *parser)
> return ret ? ret : error_mark_node;
> }
>
> +/* OpenMP 5.0:
> + affinity( [depend-modifier :] variable-list)
For consistency, I think the syntax for other clauses puts space
before ( and before ) too.
Also, s/depend-modifier/aff-modifier/
> + depend-modifier:
Likewise.
> + 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 %<:%>"))
> + return list;
I think in this case it should
if (iterators)
pop_scope ();
parens.skip_until_found_close (parser);
before doing 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;
> +}
> +
> +
> @@ -14578,17 +14592,24 @@ 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 (c) == OMP_CLAUSE_DEPEND
> + ? "depend" : "affinity");
You could just use omp_clause_code_name[OMP_CLAUSE_CODE (c)] here.
> 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 (c) == OMP_CLAUSE_DEPEND
> + ? "depend" : "affinity");
Likewise.
> @@ -37707,6 +37710,56 @@ cp_parser_omp_iterators (cp_parser *parser)
> return ret ? ret : error_mark_node;
> }
>
> +/* OpenMP 5.0:
> + affinity( [depend-modifier :] variable-list)
> + depend-modifier:
> + iterator ( iterators-definition ) */
See above.
> +
> +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))
> + {
Again, missing
if (iterators)
poplevel (0, 1, 0);
here.
> + cp_parser_skip_to_closing_parenthesis (parser,
> + /*recovering=*/true,
> + /*or_comma=*/false,
> + /*consume_paren=*/true);
> + return list;
> + }
> + }
> + }
> @@ -7461,7 +7471,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)
I think ()s should be added (I think at least emacs prefers that) when the
&& rhs doesn't fit on one line.
> @@ -7486,22 +7498,31 @@ 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 (c) == OMP_CLAUSE_DEPEND
> + ? "depend" : "affinity");
> 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 (c) == OMP_CLAUSE_DEPEND
> + ? "depend" : "affinity");
See above 2x.
> 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 (c) == OMP_CLAUSE_DEPEND
> + ? "depend" : "affinity");
And again.
> @@ -261,6 +263,7 @@ gfc_match_omp_variable_list (const char *str, gfc_omp_namelist **list,
> case MATCH_YES:
> gfc_expr *expr;
> expr = NULL;
> + gfc_gobble_whitespace ();
> if ((allow_sections && gfc_peek_ascii_char () == '(')
> || (allow_derived && gfc_peek_ascii_char () == '%'))
> {
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?
> --- a/gcc/gimplify.c
> +++ b/gcc/gimplify.c
> @@ -9506,6 +9506,10 @@ gimplify_scan_omp_clauses (tree *list_p, gimple_seq *pre_p,
>
> goto do_add;
>
> + case OMP_CLAUSE_AFFINITY:
> + /* Ignore. */
> + remove = true;
> + break;
> case OMP_CLAUSE_DEPEND:
> if (OMP_CLAUSE_DEPEND_KIND (c) == OMP_CLAUSE_DEPEND_SINK)
> {
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). We don't need to emit the loops we emit for depend, sure
(though if it is easier we could and hope for it to be optimized away).
Or at least we should evaluate the iterator expressions for side-effects
(i.e. gimplify them and ignore) and probably gimplify the affinity vars
too. If we emit the loops, just gimplify the location-list items in the
loop and then throw them away, if not, evaluate it like
step; iter = beg; if (iter cond end) expr; or so (so that expr isn't evaluated
if the cond isn't true and all of beg, end and step are evaluated.
> 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..558e316bccd
> --- /dev/null
> +++ b/gcc/testsuite/c-c++-common/gomp/affinity-1.c
> @@ -0,0 +1,20 @@
> +void
> +foo(int x)
> +{
> + int a, b[5], cc, d[5][5];
Can you please initialize the vars (at least those that are actually used
like a)?
> +#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)
> + { }
Perhaps just ; instead of { }, your choice.
Jakub
^ permalink raw reply [flat|nested] 13+ messages in thread
* [Patch] Fortran/OpenMP: Fix var-list expr parsing with array/dt (was: [Patch] OpenMP: Add iterator support to Fortran's depend; add affinity clause)
2021-04-28 13:41 ` Jakub Jelinek
@ 2021-04-28 20:26 ` Tobias Burnus
2021-04-28 20:31 ` Jakub Jelinek
[not found] ` <3bfa68db-f904-a1cb-0d18-c1a17ecfc720@codesourcery.com>
1 sibling, 1 reply; 13+ messages in thread
From: Tobias Burnus @ 2021-04-28 20:26 UTC (permalink / raw)
To: Jakub Jelinek; +Cc: gcc-patches, fortran
[-- Attachment #1: Type: text/plain, Size: 980 bytes --]
On 28.04.21 15:41, Jakub Jelinek wrote:
>> @@ -261,6 +263,7 @@ gfc_match_omp_variable_list (const char *str, gfc_omp_namelist **list,
>> + gfc_gobble_whitespace ();
>> if ((allow_sections && gfc_peek_ascii_char () == '(')
>> || (allow_derived && gfc_peek_ascii_char () == '%')
> 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?
I encountered it when writing a testcase - and the testcase was using it.
However, if you think it makes sense to have it separately.
It fixes the issue:
7 | !$omp target enter data map( to: a (:) )
| 1
Error: Syntax error in OpenMP variable list at (1)
OK for mainline?
Tobias
-----------------
Mentor Graphics (Deutschland) GmbH, Arnulfstrasse 201, 80634 München Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung, Frank Thürauf
[-- Attachment #2: var-space.diff --]
[-- Type: text/x-patch, Size: 1385 bytes --]
Fortran/OpenMP: Fix var-list expr parsing with array/dt
gcc/fortran/ChangeLog:
* openmp.c (gfc_match_omp_variable_list): Gobble whitespace before
checking whether a '%' or '(' follows as next character.
gcc/testsuite/ChangeLog:
* gfortran.dg/gomp/map-5.f90: New test.
gcc/fortran/openmp.c | 1 +
gcc/testsuite/gfortran.dg/gomp/map-5.f90 | 13 +++++++++++++
2 files changed, 14 insertions(+)
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index a1b057227b7..7eeabff8e76 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -261,6 +261,7 @@ gfc_match_omp_variable_list (const char *str, gfc_omp_namelist **list,
case MATCH_YES:
gfc_expr *expr;
expr = NULL;
+ gfc_gobble_whitespace ();
if ((allow_sections && gfc_peek_ascii_char () == '(')
|| (allow_derived && gfc_peek_ascii_char () == '%'))
{
diff --git a/gcc/testsuite/gfortran.dg/gomp/map-5.f90 b/gcc/testsuite/gfortran.dg/gomp/map-5.f90
new file mode 100644
index 00000000000..2b4b341bc51
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/map-5.f90
@@ -0,0 +1,13 @@
+implicit none
+type t
+ integer :: b(5)
+end type t
+integer :: a(5), x, y(5)
+type(t) :: b
+!$omp target enter data map( to: a (:) )
+!$omp target enter data map( to: b % b )
+!$omp target enter data map( to: a(:) )
+!$omp target depend(out: y (2)) nowait
+!$omp end target
+
+end
^ permalink raw reply [flat|nested] 13+ messages in thread
* Re: [Patch] Fortran/OpenMP: Fix var-list expr parsing with array/dt (was: [Patch] OpenMP: Add iterator support to Fortran's depend; add affinity clause)
2021-04-28 20:26 ` [Patch] Fortran/OpenMP: Fix var-list expr parsing with array/dt (was: [Patch] OpenMP: Add iterator support to Fortran's depend; add affinity clause) Tobias Burnus
@ 2021-04-28 20:31 ` Jakub Jelinek
0 siblings, 0 replies; 13+ messages in thread
From: Jakub Jelinek @ 2021-04-28 20:31 UTC (permalink / raw)
To: Tobias Burnus; +Cc: gcc-patches, fortran
On Wed, Apr 28, 2021 at 10:26:44PM +0200, Tobias Burnus wrote:
> On 28.04.21 15:41, Jakub Jelinek wrote:
> > > @@ -261,6 +263,7 @@ gfc_match_omp_variable_list (const char *str, gfc_omp_namelist **list,
> > > + gfc_gobble_whitespace ();
> > > if ((allow_sections && gfc_peek_ascii_char () == '(')
> > > || (allow_derived && gfc_peek_ascii_char () == '%')
> > 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?
>
> I encountered it when writing a testcase - and the testcase was using it.
> However, if you think it makes sense to have it separately.
>
> It fixes the issue:
>
> 7 | !$omp target enter data map( to: a (:) )
> | 1
> Error: Syntax error in OpenMP variable list at (1)
>
> OK for mainline?
Yes, thanks.
And IMHO also should be backported at least to 11.
Jakub
^ permalink raw reply [flat|nested] 13+ messages in thread
* Re: [Patch] OpenMP: Add iterator support to Fortran's depend; add affinity clause
[not found] ` <20210527082259.GM7746@tucnak>
@ 2021-05-27 18:30 ` Tobias Burnus
2021-05-27 18:42 ` Jakub Jelinek
2021-05-27 19:58 ` Joseph Myers
0 siblings, 2 replies; 13+ messages in thread
From: Tobias Burnus @ 2021-05-27 18:30 UTC (permalink / raw)
To: Jakub Jelinek, Joseph Myers; +Cc: gcc-patches, fortran
[-- Attachment #1: Type: text/plain, Size: 1455 bytes --]
@Joseph: I CC'ed you in case you have comments regarding
c-parser.c's c_parser_check_balanced_raw_token_sequence (comment update)
and c_parser_check_tight_balanced_raw_token_sequence (new); the latter
is essentially cp_parser_skip_balanced_tokens with slight adaptions.
On 27.05.21 10:22, Jakub Jelinek via Gcc-patches wrote:
> One important thing I've missed.
> Unlike depend clause where dependence-type : is required, in affinity clause
> the aff-modifier is optional.
Now handled for C, C++ and Fortran.
> What happens with this block 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);
> In the error handling?
Well, in the old code nothing – until the parent namespace
(gfc_current_ns) is beeing freed. Otherwise, it is walked
at several places but not ns->symtree but only ns->code
or ns->entry or ...
As it now can be used in a non-error case, I decided to
free it inside openmp.c instead of leaving it there for
later cleanup.
Tobias
-----------------
Mentor Graphics (Deutschland) GmbH, Arnulfstrasse 201, 80634 München Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung, Frank Thürauf
[-- Attachment #2: omp-iterator-affinity-v3.diff --]
[-- Type: text/x-patch, Size: 108966 bytes --]
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_check_balanced_raw_token_sequence): Update
description.
(c_parser_check_tight_balanced_raw_token_sequence,
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.
* c-c++-common/gomp/affinity-7.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/affinity-clause-5.f90: New test.
* gfortran.dg/gomp/affinity-clause-6.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 | 124 ++++++++-
gcc/c/c-typeck.c | 52 ++--
gcc/cp/parser.c | 84 +++++-
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 | 307 ++++++++++++++++++---
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 | 103 +++++++
gcc/testsuite/c-c++-common/gomp/affinity-5.c | 32 +++
gcc/testsuite/c-c++-common/gomp/affinity-6.c | 36 +++
gcc/testsuite/c-c++-common/gomp/affinity-7.c | 37 +++
.../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/affinity-clause-5.f90 | 23 ++
.../gfortran.dg/gomp/affinity-clause-6.f90 | 24 ++
.../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 ++++++
33 files changed, 1802 insertions(+), 145 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..76cbcdc0287 100644
--- a/gcc/c/c-parser.c
+++ b/gcc/c/c-parser.c
@@ -5005,8 +5005,9 @@ c_parser_std_attribute_specifier (c_parser *parser, bool for_tm)
}
/* Look past an optional balanced token sequence of raw look-ahead
- tokens starting with the *Nth token. *N is updated to point to the
- following token. Return true if such a sequence was found, false
+ tokens starting with the *Nth token; returns when the first non-balanced
+ ']', ')' or '}' has been found. *N is updated to point to the
+ that token. Return true if such a sequence was found, false
if the tokens parsed were not balanced. */
static bool
@@ -5078,6 +5079,48 @@ c_parser_check_balanced_raw_token_sequence (c_parser *parser, unsigned int *n)
}
}
+/* Look past an balanced token sequence of raw look-ahead tokens starting with
+ the *Nth token; expects a '[', '(' or '{' as first token - and returns after
+ its closing counterpart has been found. *N is updated to point to the
+ following token. Return true if such a sequence was found, false
+ if the tokens parsed were not balanced. */
+
+static bool
+c_parser_check_tight_balanced_raw_token_sequence (c_parser *parser,
+ unsigned int *n)
+{
+ int nparens = 0, nbraces = 0, nsquares = 0;
+ do
+ switch (c_parser_peek_nth_token_raw (parser, (*n)++)->type)
+ {
+ case CPP_PRAGMA_EOL:
+ case CPP_EOF:
+ return false;
+ case CPP_OPEN_PAREN:
+ ++nparens;
+ break;
+ case CPP_OPEN_BRACE:
+ ++nbraces;
+ break;
+ case CPP_OPEN_SQUARE:
+ ++nsquares;
+ break;
+ case CPP_CLOSE_PAREN:
+ --nparens;
+ break;
+ case CPP_CLOSE_BRACE:
+ --nbraces;
+ break;
+ case CPP_CLOSE_SQUARE:
+ --nsquares;
+ break;
+ default:
+ break;
+ }
+ while (nparens || nbraces || nsquares);
+ return true;
+}
+
/* Return whether standard attributes start with the Nth token. */
static bool
@@ -12601,7 +12644,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 +12945,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 +13085,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 +13136,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 +13176,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 +15554,65 @@ 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);
+ bool parse_iter = (strcmp ("iterator", p) == 0);
+ if (parse_iter)
+ {
+ unsigned n = 2;
+ parse_iter
+ = (c_parser_check_tight_balanced_raw_token_sequence (parser, &n)
+ && (c_parser_peek_nth_token_raw (parser, n)->type == CPP_COLON));
+ }
+ if (parse_iter)
+ {
+ 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 +16579,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 +19358,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..7ef5c0e3bf6 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,64 @@ 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);
+ bool parse_iter = (strcmp ("iterator", p) == 0);
+ if (parse_iter)
+ {
+ size_t n = cp_parser_skip_balanced_tokens (parser, 2);
+ parse_iter = cp_lexer_nth_token_is (parser->lexer, n, CPP_COLON);
+ }
+ if (parse_iter)
+ {
+ 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 +38814,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 +41414,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..4ed6a0d64c8 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,132 @@ 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, bool permit_var)
+{
+ locus old_loc = gfc_current_locus;
+
+ 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 prev_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", &prev_loc);
+ return MATCH_ERROR;
+ }
+ permit_var = false;
+ }
+ else
+ {
+ ts.type = BT_INTEGER;
+ ts.kind = gfc_default_integer_kind;
+ gfc_current_locus = prev_loc;
+ }
+ prev_loc = gfc_current_locus;
+ if (gfc_match_name (name) != MATCH_YES)
+ {
+ gfc_error ("Expected identifier at %C");
+ goto failed;
+ }
+ if (gfc_find_symtree ((*ns)->sym_root, name))
+ {
+ gfc_error ("Same identifier %qs specified again at %C", name);
+ goto failed;
+ }
+
+ gfc_symbol *sym = gfc_new_symbol (name, *ns);
+ if (last)
+ last->tlink = sym;
+ else
+ (*ns)->proc_name = sym;
+ last = sym;
+ sym->declared_at = prev_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;
+
+ prev_loc = gfc_current_locus;
+ if (gfc_match (" = ") != MATCH_YES)
+ goto failed;
+ permit_var = false;
+ 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);
+ goto failed;
+ }
+ }
+
+ gfc_expr *e = gfc_get_expr ();
+ e->where = prev_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)
+ goto failed;
+ }
+ return MATCH_YES;
+
+failed:
+ gfc_namespace *prev_ns = NULL;
+ for (gfc_namespace *it = gfc_current_ns->contained; it; it = it->sibling)
+ {
+ if (it == *ns)
+ {
+ if (prev_ns)
+ prev_ns->sibling = it->sibling;
+ else
+ gfc_current_ns->contained = it->sibling;
+ gfc_free_namespace (it);
+ break;
+ }
+ prev_ns = it;
+ }
+ *ns = NULL;
+ if (!permit_var)
+ return MATCH_ERROR;
+ gfc_current_locus = old_loc;
+ return MATCH_NO;
+}
+
/* reduction ( reduction-modifier, reduction-operator : variable-list )
in_reduction ( reduction-operator : variable-list )
task_reduction ( reduction-operator : variable-list ) */
@@ -1138,7 +1267,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 +1275,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 +1331,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 +1359,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, true);
+ 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 +1533,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, false);
+ 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 +1554,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 +1580,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 +1851,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 +1859,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 +3029,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 +3282,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 +4437,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 +5009,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 +5457,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 +5465,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 +5640,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 +5649,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 +5897,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 +5952,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 +7591,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..dee3ed97783
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/affinity-4.c
@@ -0,0 +1,103 @@
+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 "'iterator' undeclared " "" { target c } .-2 } */
+ /* { dg-error "found ':' in nested-name-specifier, expected '::'" "" { target c++ } .-3 } */
+ /* { dg-error "'iterator' has not been declared" "" { target c++ } .-4 } */
+}
+
+void
+f2 (void)
+{
+ #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 "'iterator' undeclared " "" { target c } .-2 } */
+ /* { dg-error "'i' was not declared in this scope" "" { target c++ } .-3 } */
+ /* { dg-error "'iterator' was not declared in this scope" "" { target c++ } .-4 } */
+ /* { dg-error "'j' was not declared in this scope" "" { target c++ } .-5 } */
+ /* { dg-error "expected '\\)' before ':' token" "" { target c++ } .-6 } */
+}
+
+void
+f3 (void)
+{
+ #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 "'iterator' undeclared " "" { target c } .-2 } */
+ /* { dg-error "expected primary-expression before 'struct'" "" { target c++ } .-3 } */
+ /* { dg-error "'iterator' was not declared in this scope" "" { target c++ } .-4 } */
+}
+
+void
+f4 (void)
+{
+ #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/c-c++-common/gomp/affinity-7.c b/gcc/testsuite/c-c++-common/gomp/affinity-7.c
new file mode 100644
index 00000000000..11684f521ad
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/affinity-7.c
@@ -0,0 +1,37 @@
+/* { dg-additional-options "-fdump-tree-original" } */
+int var[20];
+
+int *
+iterator(int i)
+{
+ return &var[i];
+}
+
+void
+foo (void)
+{
+ int iterator[10], i;
+ #pragma omp task affinity(iterator(i=4:2) : iterator[i] )
+ ;
+ #pragma omp task affinity(iterator)
+ ;
+ #pragma omp task affinity(iterator[4:3])
+ ;
+}
+
+void
+bar (void)
+{
+ int j = 3;
+ ;
+ #pragma omp task affinity(iterator(i=4:2) : iterator(i)[2] )
+ ;
+ #pragma omp task affinity(iterator(j)[4])
+ ;
+}
+
+/* { dg-final { scan-tree-dump-times "#pragma omp task affinity\\(iterator\\(int i=4:2:1\\):iterator\\\[SAVE_EXPR <i>\\\]\\)" 1 "original" } } */
+/* { dg-final { scan-tree-dump-times "#pragma omp task affinity\\(iterator\\)" 1 "original" } } */
+/* { dg-final { scan-tree-dump-times "#pragma omp task affinity\\(iterator\\\[4\\\]\\)" 1 "original" } } */
+/* { dg-final { scan-tree-dump-times "#pragma omp task affinity\\(iterator\\(int i=4:2:1\\):\\*\\(iterator \\(i\\) \\+ 8\\)\\)" 1 "original" } } */
+/* { dg-final { scan-tree-dump-times "#pragma omp task affinity\\(\\*\\(iterator \\(j\\) \\+ 16\\)\\)" 1 "original" } } */
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..54768a8aeb2
--- /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 "31:Syntax error in OpenMP variable list" }
+ !!$omp end task
+ !$omp task affinity(iterator(b(2)=1:5:0) : b(i)) ! { dg-error "31:Syntax error in OpenMP variable list" }
+ !!$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/affinity-clause-5.f90 b/gcc/testsuite/gfortran.dg/gomp/affinity-clause-5.f90
new file mode 100644
index 00000000000..538b5a54191
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/affinity-clause-5.f90
@@ -0,0 +1,23 @@
+! { dg-additional-options "-fdump-tree-original" }
+implicit none
+integer :: iterator(10), i
+
+!$omp taskgroup
+ !$omp task affinity(iterator)
+ !$omp end task
+
+ !$omp task affinity(iterator(3))
+ !$omp end task
+
+ !$omp task affinity(iterator(i=1:10) : iterator(i))
+ !$omp end task
+
+!$omp end taskgroup
+
+end
+
+! { dg-final { scan-tree-dump-times "pragma omp task affinity\\(iterator\\)" 1 "original" } }
+
+! { dg-final { scan-tree-dump-times "#pragma omp task affinity\\(\\*\\(c_char \\*\\) &iterator\\\[2\\\]\\)" 1 "original" } }
+
+! { dg-final { scan-tree-dump-times "#pragma omp task affinity\\(iterator\\(integer\\(kind=4\\) i=1:10:1\\):\\*\\(c_char \\*\\) &iterator\\\[.* <?i>? \\+ -1\\\]\\)" 1 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/gomp/affinity-clause-6.f90 b/gcc/testsuite/gfortran.dg/gomp/affinity-clause-6.f90
new file mode 100644
index 00000000000..90ec0acd1e1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/affinity-clause-6.f90
@@ -0,0 +1,24 @@
+implicit none
+integer :: iterator(10), i
+
+!$omp taskgroup
+ !$omp task affinity(iterator)
+ !$omp end task
+
+ !$omp task affinity(iterator(3))
+ !$omp end task
+
+ !$omp task affinity(iterator(i=1:10) : iterator(i))
+ !$omp end task
+
+ !$omp task affinity(iterator(integer :: i)) ! { dg-error "Failed to match clause at" }
+ !!$omp end task
+
+ !$omp task affinity(iterator(integer :: i=1:1)) ! { dg-error "Expected ':' at" }
+ !!$omp end task
+
+ !$omp task affinity(iterator(i=)) ! { dg-error "Expected range-specification at" }
+! !$omp end task
+!$omp end taskgroup
+
+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 9cafe4384ae..1aa6e557a04 100644
--- a/gcc/tree.c
+++ b/gcc/tree.c
@@ -289,6 +289,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 */
@@ -375,6 +376,7 @@ const char * const omp_clause_code_name[] =
"copyin",
"copyprivate",
"linear",
+ "affinity",
"aligned",
"allocate",
"depend",
@@ -11091,6 +11093,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
^ permalink raw reply [flat|nested] 13+ messages in thread
* Re: [Patch] OpenMP: Add iterator support to Fortran's depend; add affinity clause
2021-05-27 18:30 ` [Patch] OpenMP: Add iterator support to Fortran's depend; add affinity clause Tobias Burnus
@ 2021-05-27 18:42 ` Jakub Jelinek
2021-05-27 19:58 ` Joseph Myers
1 sibling, 0 replies; 13+ messages in thread
From: Jakub Jelinek @ 2021-05-27 18:42 UTC (permalink / raw)
To: Tobias Burnus; +Cc: Joseph Myers, gcc-patches, fortran
On Thu, May 27, 2021 at 08:30:33PM +0200, Tobias Burnus wrote:
> + if (c_parser_next_token_is (parser, CPP_NAME))
> + {
> + const char *p = IDENTIFIER_POINTER (c_parser_peek_token (parser)->value);
> + bool parse_iter = (strcmp ("iterator", p) == 0);
> + if (parse_iter)
I'd add here && c_parser_peek_2nd_token (parser)->type == CPP_OPEN_PAREN
> + if (parse_iter)
And similarly here && cp_lexer_nth_token_is (parser->lexer, 2, CPP_OPEN_PAREN)
Otherwise LGTM, but please give Joseph some time to comment on the new
function.
Jakub
^ permalink raw reply [flat|nested] 13+ messages in thread
* Re: [Patch] OpenMP: Add iterator support to Fortran's depend; add affinity clause
2021-05-27 18:30 ` [Patch] OpenMP: Add iterator support to Fortran's depend; add affinity clause Tobias Burnus
2021-05-27 18:42 ` Jakub Jelinek
@ 2021-05-27 19:58 ` Joseph Myers
2021-05-27 20:15 ` Jakub Jelinek
2021-05-27 22:59 ` Tobias Burnus
1 sibling, 2 replies; 13+ messages in thread
From: Joseph Myers @ 2021-05-27 19:58 UTC (permalink / raw)
To: Tobias Burnus; +Cc: Jakub Jelinek, gcc-patches, fortran
On Thu, 27 May 2021, Tobias Burnus wrote:
> @Joseph: I CC'ed you in case you have comments regarding
> c-parser.c's c_parser_check_balanced_raw_token_sequence (comment update)
> and c_parser_check_tight_balanced_raw_token_sequence (new); the latter
> is essentially cp_parser_skip_balanced_tokens with slight adaptions.
I don't understand why the name says either "tight" or "balanced". As far
as I can see, c_parser_check_tight_balanced_raw_token_sequence isn't
checking for balanced token sequences (in the sense defined in C2x) at all
and would accept e.g. }]{[ as being balanced. Is that really what's
supposed to be accepted there? If it is, the comment on the function
definition needs to explain the exact definition of what token sequences
are accepted.
--
Joseph S. Myers
joseph@codesourcery.com
^ permalink raw reply [flat|nested] 13+ messages in thread
* Re: [Patch] OpenMP: Add iterator support to Fortran's depend; add affinity clause
2021-05-27 19:58 ` Joseph Myers
@ 2021-05-27 20:15 ` Jakub Jelinek
2021-05-27 22:59 ` Tobias Burnus
1 sibling, 0 replies; 13+ messages in thread
From: Jakub Jelinek @ 2021-05-27 20:15 UTC (permalink / raw)
To: Joseph Myers; +Cc: Tobias Burnus, gcc-patches, fortran
On Thu, May 27, 2021 at 07:58:03PM +0000, Joseph Myers wrote:
> On Thu, 27 May 2021, Tobias Burnus wrote:
>
> > @Joseph: I CC'ed you in case you have comments regarding
> > c-parser.c's c_parser_check_balanced_raw_token_sequence (comment update)
> > and c_parser_check_tight_balanced_raw_token_sequence (new); the latter
> > is essentially cp_parser_skip_balanced_tokens with slight adaptions.
>
> I don't understand why the name says either "tight" or "balanced". As far
> as I can see, c_parser_check_tight_balanced_raw_token_sequence isn't
> checking for balanced token sequences (in the sense defined in C2x) at all
> and would accept e.g. }]{[ as being balanced. Is that really what's
> supposed to be accepted there? If it is, the comment on the function
> definition needs to explain the exact definition of what token sequences
> are accepted.
Not }]{[ but {[}], true.
I guess what Tobias posted comes from the C++ FE cp_parser_skip_balanced_tokens
which is apparently my fault.
The C++ grammar is:
balanced-token-seq:
balanced-token
balanced-token-seq balanced-token
balanced-token:
( balanced-token-seq opt )
[ balanced-token-seq opt ]
{ balanced-token-seq opt }
any token other than a parenthesis, a bracket, or a brace
so I bet we need something like the C c_parser_check_balanced_raw_token_sequence
instead in the C++ FE too.
For the particular OpenMP use case, I think it really doesn't matter which
one we use, if the opening and closing parens kinds/counts would match but
they wouldn't be balanced, it would be invalid in any case and we'd reported
it during parsing of the iterators.
Jakub
^ permalink raw reply [flat|nested] 13+ messages in thread
* Re: [Patch] OpenMP: Add iterator support to Fortran's depend; add affinity clause
2021-05-27 19:58 ` Joseph Myers
2021-05-27 20:15 ` Jakub Jelinek
@ 2021-05-27 22:59 ` Tobias Burnus
2021-05-29 8:03 ` Jakub Jelinek
1 sibling, 1 reply; 13+ messages in thread
From: Tobias Burnus @ 2021-05-27 22:59 UTC (permalink / raw)
To: Joseph Myers; +Cc: Jakub Jelinek, gcc-patches, fortran
[-- Attachment #1: Type: text/plain, Size: 1163 bytes --]
On 27.05.21 21:58, Joseph Myers wrote:
> On Thu, 27 May 2021, Tobias Burnus wrote:
>> @Joseph: I CC'ed you in case you have comments regarding
>> c-parser.c's c_parser_check_balanced_raw_token_sequence
Pilot error on my side – doing three things in parallel
(fixing a patch, updating docs + attending a spec conference)
does not work well.
Unsurprisingly, when properly used, calling
c_parser_check_balanced_raw_token_sequence does work.
Hence, I removed my balanced function & only the OpenMP specific
omp_affinity function remains.
(Updated version attached.)
> As far as I can see, ... isn't
> checking for balanced token sequences (in the sense defined in C2x) at all
> and would accept e.g. }]{[ as being balanced.
It looks as if one should/could update the gcc/cp/ function to use the same
algorithm as the gcc/c/ one – as the latter has also this issue. But that's
a separate issue and completely independent of this patch.
Thanks,
Tobias
-----------------
Mentor Graphics (Deutschland) GmbH, Arnulfstrasse 201, 80634 München Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung, Frank Thürauf
[-- Attachment #2: omp-iterator-affinity-v5.diff --]
[-- Type: text/x-patch, Size: 107243 bytes --]
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.
* c-c++-common/gomp/affinity-7.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/affinity-clause-5.f90: New test.
* gfortran.dg/gomp/affinity-clause-6.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 | 81 +++++-
gcc/c/c-typeck.c | 52 ++--
gcc/cp/parser.c | 86 +++++-
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 | 307 ++++++++++++++++++---
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 | 103 +++++++
gcc/testsuite/c-c++-common/gomp/affinity-5.c | 32 +++
gcc/testsuite/c-c++-common/gomp/affinity-6.c | 36 +++
gcc/testsuite/c-c++-common/gomp/affinity-7.c | 37 +++
.../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/affinity-clause-5.f90 | 23 ++
.../gfortran.dg/gomp/affinity-clause-6.f90 | 24 ++
.../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 ++++++
33 files changed, 1763 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..d71fd0abe90 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,69 @@ 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);
+ bool parse_iter = ((strcmp ("iterator", p) == 0)
+ && (c_parser_peek_2nd_token (parser)->type
+ == CPP_OPEN_PAREN));
+ if (parse_iter)
+ {
+ unsigned n = 3;
+ parse_iter = (c_parser_check_balanced_raw_token_sequence (parser, &n)
+ && (c_parser_peek_nth_token_raw (parser, n)->type
+ == CPP_CLOSE_PAREN)
+ && (c_parser_peek_nth_token_raw (parser, n + 1)->type
+ == CPP_COLON));
+ }
+ if (parse_iter)
+ {
+ 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 +16540,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 +19319,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..84c6be87873 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,66 @@ 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);
+ bool parse_iter = ((strcmp ("iterator", p) == 0)
+ && (cp_lexer_nth_token_is (parser->lexer, 2,
+ CPP_OPEN_PAREN)));
+ if (parse_iter)
+ {
+ size_t n = cp_parser_skip_balanced_tokens (parser, 2);
+ parse_iter = cp_lexer_nth_token_is (parser->lexer, n, CPP_COLON);
+ }
+ if (parse_iter)
+ {
+ 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 +38816,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 +41416,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..4ed6a0d64c8 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,132 @@ 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, bool permit_var)
+{
+ locus old_loc = gfc_current_locus;
+
+ 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 prev_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", &prev_loc);
+ return MATCH_ERROR;
+ }
+ permit_var = false;
+ }
+ else
+ {
+ ts.type = BT_INTEGER;
+ ts.kind = gfc_default_integer_kind;
+ gfc_current_locus = prev_loc;
+ }
+ prev_loc = gfc_current_locus;
+ if (gfc_match_name (name) != MATCH_YES)
+ {
+ gfc_error ("Expected identifier at %C");
+ goto failed;
+ }
+ if (gfc_find_symtree ((*ns)->sym_root, name))
+ {
+ gfc_error ("Same identifier %qs specified again at %C", name);
+ goto failed;
+ }
+
+ gfc_symbol *sym = gfc_new_symbol (name, *ns);
+ if (last)
+ last->tlink = sym;
+ else
+ (*ns)->proc_name = sym;
+ last = sym;
+ sym->declared_at = prev_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;
+
+ prev_loc = gfc_current_locus;
+ if (gfc_match (" = ") != MATCH_YES)
+ goto failed;
+ permit_var = false;
+ 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);
+ goto failed;
+ }
+ }
+
+ gfc_expr *e = gfc_get_expr ();
+ e->where = prev_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)
+ goto failed;
+ }
+ return MATCH_YES;
+
+failed:
+ gfc_namespace *prev_ns = NULL;
+ for (gfc_namespace *it = gfc_current_ns->contained; it; it = it->sibling)
+ {
+ if (it == *ns)
+ {
+ if (prev_ns)
+ prev_ns->sibling = it->sibling;
+ else
+ gfc_current_ns->contained = it->sibling;
+ gfc_free_namespace (it);
+ break;
+ }
+ prev_ns = it;
+ }
+ *ns = NULL;
+ if (!permit_var)
+ return MATCH_ERROR;
+ gfc_current_locus = old_loc;
+ return MATCH_NO;
+}
+
/* reduction ( reduction-modifier, reduction-operator : variable-list )
in_reduction ( reduction-operator : variable-list )
task_reduction ( reduction-operator : variable-list ) */
@@ -1138,7 +1267,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 +1275,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 +1331,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 +1359,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, true);
+ 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 +1533,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, false);
+ 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 +1554,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 +1580,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 +1851,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 +1859,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 +3029,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 +3282,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 +4437,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 +5009,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 +5457,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 +5465,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 +5640,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 +5649,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 +5897,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 +5952,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 +7591,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..dee3ed97783
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/affinity-4.c
@@ -0,0 +1,103 @@
+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 "'iterator' undeclared " "" { target c } .-2 } */
+ /* { dg-error "found ':' in nested-name-specifier, expected '::'" "" { target c++ } .-3 } */
+ /* { dg-error "'iterator' has not been declared" "" { target c++ } .-4 } */
+}
+
+void
+f2 (void)
+{
+ #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 "'iterator' undeclared " "" { target c } .-2 } */
+ /* { dg-error "'i' was not declared in this scope" "" { target c++ } .-3 } */
+ /* { dg-error "'iterator' was not declared in this scope" "" { target c++ } .-4 } */
+ /* { dg-error "'j' was not declared in this scope" "" { target c++ } .-5 } */
+ /* { dg-error "expected '\\)' before ':' token" "" { target c++ } .-6 } */
+}
+
+void
+f3 (void)
+{
+ #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 "'iterator' undeclared " "" { target c } .-2 } */
+ /* { dg-error "expected primary-expression before 'struct'" "" { target c++ } .-3 } */
+ /* { dg-error "'iterator' was not declared in this scope" "" { target c++ } .-4 } */
+}
+
+void
+f4 (void)
+{
+ #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/c-c++-common/gomp/affinity-7.c b/gcc/testsuite/c-c++-common/gomp/affinity-7.c
new file mode 100644
index 00000000000..11684f521ad
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/affinity-7.c
@@ -0,0 +1,37 @@
+/* { dg-additional-options "-fdump-tree-original" } */
+int var[20];
+
+int *
+iterator(int i)
+{
+ return &var[i];
+}
+
+void
+foo (void)
+{
+ int iterator[10], i;
+ #pragma omp task affinity(iterator(i=4:2) : iterator[i] )
+ ;
+ #pragma omp task affinity(iterator)
+ ;
+ #pragma omp task affinity(iterator[4:3])
+ ;
+}
+
+void
+bar (void)
+{
+ int j = 3;
+ ;
+ #pragma omp task affinity(iterator(i=4:2) : iterator(i)[2] )
+ ;
+ #pragma omp task affinity(iterator(j)[4])
+ ;
+}
+
+/* { dg-final { scan-tree-dump-times "#pragma omp task affinity\\(iterator\\(int i=4:2:1\\):iterator\\\[SAVE_EXPR <i>\\\]\\)" 1 "original" } } */
+/* { dg-final { scan-tree-dump-times "#pragma omp task affinity\\(iterator\\)" 1 "original" } } */
+/* { dg-final { scan-tree-dump-times "#pragma omp task affinity\\(iterator\\\[4\\\]\\)" 1 "original" } } */
+/* { dg-final { scan-tree-dump-times "#pragma omp task affinity\\(iterator\\(int i=4:2:1\\):\\*\\(iterator \\(i\\) \\+ 8\\)\\)" 1 "original" } } */
+/* { dg-final { scan-tree-dump-times "#pragma omp task affinity\\(\\*\\(iterator \\(j\\) \\+ 16\\)\\)" 1 "original" } } */
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..54768a8aeb2
--- /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 "31:Syntax error in OpenMP variable list" }
+ !!$omp end task
+ !$omp task affinity(iterator(b(2)=1:5:0) : b(i)) ! { dg-error "31:Syntax error in OpenMP variable list" }
+ !!$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/affinity-clause-5.f90 b/gcc/testsuite/gfortran.dg/gomp/affinity-clause-5.f90
new file mode 100644
index 00000000000..538b5a54191
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/affinity-clause-5.f90
@@ -0,0 +1,23 @@
+! { dg-additional-options "-fdump-tree-original" }
+implicit none
+integer :: iterator(10), i
+
+!$omp taskgroup
+ !$omp task affinity(iterator)
+ !$omp end task
+
+ !$omp task affinity(iterator(3))
+ !$omp end task
+
+ !$omp task affinity(iterator(i=1:10) : iterator(i))
+ !$omp end task
+
+!$omp end taskgroup
+
+end
+
+! { dg-final { scan-tree-dump-times "pragma omp task affinity\\(iterator\\)" 1 "original" } }
+
+! { dg-final { scan-tree-dump-times "#pragma omp task affinity\\(\\*\\(c_char \\*\\) &iterator\\\[2\\\]\\)" 1 "original" } }
+
+! { dg-final { scan-tree-dump-times "#pragma omp task affinity\\(iterator\\(integer\\(kind=4\\) i=1:10:1\\):\\*\\(c_char \\*\\) &iterator\\\[.* <?i>? \\+ -1\\\]\\)" 1 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/gomp/affinity-clause-6.f90 b/gcc/testsuite/gfortran.dg/gomp/affinity-clause-6.f90
new file mode 100644
index 00000000000..90ec0acd1e1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/affinity-clause-6.f90
@@ -0,0 +1,24 @@
+implicit none
+integer :: iterator(10), i
+
+!$omp taskgroup
+ !$omp task affinity(iterator)
+ !$omp end task
+
+ !$omp task affinity(iterator(3))
+ !$omp end task
+
+ !$omp task affinity(iterator(i=1:10) : iterator(i))
+ !$omp end task
+
+ !$omp task affinity(iterator(integer :: i)) ! { dg-error "Failed to match clause at" }
+ !!$omp end task
+
+ !$omp task affinity(iterator(integer :: i=1:1)) ! { dg-error "Expected ':' at" }
+ !!$omp end task
+
+ !$omp task affinity(iterator(i=)) ! { dg-error "Expected range-specification at" }
+! !$omp end task
+!$omp end taskgroup
+
+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 9cafe4384ae..1aa6e557a04 100644
--- a/gcc/tree.c
+++ b/gcc/tree.c
@@ -289,6 +289,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 */
@@ -375,6 +376,7 @@ const char * const omp_clause_code_name[] =
"copyin",
"copyprivate",
"linear",
+ "affinity",
"aligned",
"allocate",
"depend",
@@ -11091,6 +11093,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
^ permalink raw reply [flat|nested] 13+ messages in thread
* Re: [Patch] OpenMP: Add iterator support to Fortran's depend; add affinity clause
2021-05-27 22:59 ` Tobias Burnus
@ 2021-05-29 8:03 ` Jakub Jelinek
2021-05-31 8:14 ` Christophe Lyon
2021-05-31 14:43 ` Tobias Burnus
0 siblings, 2 replies; 13+ messages in thread
From: Jakub Jelinek @ 2021-05-29 8:03 UTC (permalink / raw)
To: Tobias Burnus; +Cc: Joseph Myers, gcc-patches, fortran
On Fri, May 28, 2021 at 12:59:20AM +0200, Tobias Burnus wrote:
> * gfortran.dg/gomp/depend-iterator-1.f90: New test.
> * gfortran.dg/gomp/depend-iterator-2.f90: New test.
Something I've missed during the review but it shows up during testing:
> 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 }
gcc/testsuite/*/gomp/ shouldn't have dg-do run tests, either
it is meant to be a runtime test and then it should be moved to
libgomp/testsuite/libgomp.fortran/ , or it should be changed to
dg-do compile.
> --- /dev/null
> +++ b/gcc/testsuite/gfortran.dg/gomp/depend-iterator-2.f90
> @@ -0,0 +1,44 @@
> +! { dg-do run }
And this one has dg-error in it, so this one must be dg-do compile.
> + !$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" }
Jakub
^ permalink raw reply [flat|nested] 13+ messages in thread
* Re: [Patch] OpenMP: Add iterator support to Fortran's depend; add affinity clause
2021-05-29 8:03 ` Jakub Jelinek
@ 2021-05-31 8:14 ` Christophe Lyon
2021-05-31 8:19 ` Jakub Jelinek
2021-05-31 14:43 ` Tobias Burnus
1 sibling, 1 reply; 13+ messages in thread
From: Christophe Lyon @ 2021-05-31 8:14 UTC (permalink / raw)
To: Jakub Jelinek; +Cc: Tobias Burnus, gcc-patches, fortran, Joseph Myers
On Sat, 29 May 2021 at 10:03, Jakub Jelinek via Gcc-patches
<gcc-patches@gcc.gnu.org> wrote:
>
> On Fri, May 28, 2021 at 12:59:20AM +0200, Tobias Burnus wrote:
> > * gfortran.dg/gomp/depend-iterator-1.f90: New test.
> > * gfortran.dg/gomp/depend-iterator-2.f90: New test.
>
> Something I've missed during the review but it shows up during testing:
>
> > 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 }
>
> gcc/testsuite/*/gomp/ shouldn't have dg-do run tests, either
> it is meant to be a runtime test and then it should be moved to
> libgomp/testsuite/libgomp.fortran/ , or it should be changed to
> dg-do compile.
>
In addition, on arm/aarch64 at least, I can see the test failing to compile:
gfortran: fatal error: cannot read spec file 'libgomp.spec': No such
file or directory
Christophe
> > --- /dev/null
> > +++ b/gcc/testsuite/gfortran.dg/gomp/depend-iterator-2.f90
> > @@ -0,0 +1,44 @@
> > +! { dg-do run }
>
> And this one has dg-error in it, so this one must be dg-do compile.
>
> > + !$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" }
>
> Jakub
>
^ permalink raw reply [flat|nested] 13+ messages in thread
* Re: [Patch] OpenMP: Add iterator support to Fortran's depend; add affinity clause
2021-05-31 8:14 ` Christophe Lyon
@ 2021-05-31 8:19 ` Jakub Jelinek
0 siblings, 0 replies; 13+ messages in thread
From: Jakub Jelinek @ 2021-05-31 8:19 UTC (permalink / raw)
To: Christophe Lyon; +Cc: Tobias Burnus, gcc-patches, fortran, Joseph Myers
On Mon, May 31, 2021 at 10:14:34AM +0200, Christophe Lyon wrote:
> > Something I've missed during the review but it shows up during testing:
> >
> > > 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 }
> >
> > gcc/testsuite/*/gomp/ shouldn't have dg-do run tests, either
> > it is meant to be a runtime test and then it should be moved to
> > libgomp/testsuite/libgomp.fortran/ , or it should be changed to
> > dg-do compile.
> >
>
> In addition, on arm/aarch64 at least, I can see the test failing to compile:
> gfortran: fatal error: cannot read spec file 'libgomp.spec': No such
> file or directory
That is the same thing, libgomp.spec is also needed during linking with
-fopenmp, and if it would be found, libgomp.so wouldn't.
While e.g. g++.dg/ testsuite has code to find and add the libstdc++ headers
and includes also to g++.dg tests, for libgomp we have that code only in
the libgomp testsuite.
Jakub
^ permalink raw reply [flat|nested] 13+ messages in thread
* Re: [Patch] OpenMP: Add iterator support to Fortran's depend; add affinity clause
2021-05-29 8:03 ` Jakub Jelinek
2021-05-31 8:14 ` Christophe Lyon
@ 2021-05-31 14:43 ` Tobias Burnus
1 sibling, 0 replies; 13+ messages in thread
From: Tobias Burnus @ 2021-05-31 14:43 UTC (permalink / raw)
To: Jakub Jelinek; +Cc: gcc-patches, fortran
[-- Attachment #1: Type: text/plain, Size: 507 bytes --]
On 29.05.21 10:03, Jakub Jelinek wrote:
> On Fri, May 28, 2021 at 12:59:20AM +0200, Tobias Burnus wrote:
>> * gfortran.dg/gomp/depend-iterator-1.f90: New test.
>> * gfortran.dg/gomp/depend-iterator-2.f90: New test.
> Something I've missed during the review but it shows up during testing:
Now fixed.
Tobias
-----------------
Mentor Graphics (Deutschland) GmbH, Arnulfstrasse 201, 80634 München Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung, Frank Thürauf
[-- Attachment #2: committed.diff --]
[-- Type: text/x-patch, Size: 1501 bytes --]
commit 9faaa091e53db9cb4aee137bb4a6a9c6a18c7af5
Author: Tobias Burnus <tobias@codesourcery.com>
Date: Mon May 31 16:38:05 2021 +0200
gfortran.dg/gomp/depend-iterator-{1,2}.f90: Use dg-do compile
'dg-do run' is pointless -1 due to dg-error. And it won't work except
by chance for gomp tests; as -2 only has depend(out:), a 'dg-do compile'
is sufficient.
gcc/testsuite/ChangeLog:
* gfortran.dg/gomp/depend-iterator-1.f90: Use dg-do compile.
* gfortran.dg/gomp/depend-iterator-2.f90: Use dg-do compile.
---
gcc/testsuite/gfortran.dg/gomp/depend-iterator-1.f90 | 2 +-
gcc/testsuite/gfortran.dg/gomp/depend-iterator-2.f90 | 2 +-
2 files changed, 2 insertions(+), 2 deletions(-)
diff --git a/gcc/testsuite/gfortran.dg/gomp/depend-iterator-1.f90 b/gcc/testsuite/gfortran.dg/gomp/depend-iterator-1.f90
index cad36aaf8b7..d852b95f1c2 100644
--- a/gcc/testsuite/gfortran.dg/gomp/depend-iterator-1.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/depend-iterator-1.f90
@@ -1,4 +1,4 @@
-! { dg-do run }
+! { dg-do compile }
module mymod
implicit none (type, external)
diff --git a/gcc/testsuite/gfortran.dg/gomp/depend-iterator-2.f90 b/gcc/testsuite/gfortran.dg/gomp/depend-iterator-2.f90
index fa826a71097..21fc3272974 100644
--- a/gcc/testsuite/gfortran.dg/gomp/depend-iterator-2.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/depend-iterator-2.f90
@@ -1,4 +1,4 @@
-! { dg-do run }
+! { dg-do compile }
module mymod
implicit none (type, external)
^ permalink raw reply [flat|nested] 13+ messages in thread
end of thread, other threads:[~2021-05-31 14:43 UTC | newest]
Thread overview: 13+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2021-04-27 13:36 [Patch] OpenMP: Add iterator support to Fortran's depend; add affinity clause Tobias Burnus
2021-04-28 13:41 ` Jakub Jelinek
2021-04-28 20:26 ` [Patch] Fortran/OpenMP: Fix var-list expr parsing with array/dt (was: [Patch] OpenMP: Add iterator support to Fortran's depend; add affinity clause) Tobias Burnus
2021-04-28 20:31 ` Jakub Jelinek
[not found] ` <3bfa68db-f904-a1cb-0d18-c1a17ecfc720@codesourcery.com>
[not found] ` <20210527082259.GM7746@tucnak>
2021-05-27 18:30 ` [Patch] OpenMP: Add iterator support to Fortran's depend; add affinity clause Tobias Burnus
2021-05-27 18:42 ` Jakub Jelinek
2021-05-27 19:58 ` Joseph Myers
2021-05-27 20:15 ` Jakub Jelinek
2021-05-27 22:59 ` Tobias Burnus
2021-05-29 8:03 ` Jakub Jelinek
2021-05-31 8:14 ` Christophe Lyon
2021-05-31 8:19 ` Jakub Jelinek
2021-05-31 14:43 ` Tobias Burnus
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).