Fortran: Add OpenMP 'interop' directive parsing support
Parse OpenMP's 'interop' directive but stop with a 'sorry, unimplemented'
after resolving.
Additionally, it moves some clause dumping away from the end directive as
that lead to 'nowait' not being printed when it should as some cases were
missed.
gcc/fortran/ChangeLog:
* dump-parse-tree.cc (show_omp_namelist): Handle OMP_LIST_INIT.
(show_omp_clauses): Handle OMP_LIST_{INIT,USE,DESTORY}; move 'nowait'
from end-directive to the directive dump.
(show_omp_node, show_code_node): Handle EXEC_OMP_INTEROP.
* gfortran.h (enum gfc_statement): Add ST_OMP_INTEROP.
(OMP_LIST_INIT, OMP_LIST_USE, OMP_LIST_DESTROY): Add.
(enum gfc_exec_op): Add EXEC_OMP_INTEROP.
(struct gfc_omp_namelist): Add interop items to union.
(gfc_free_omp_namelist): Add boolean arg.
* match.cc (gfc_free_omp_namelist): Update to free
interop union members.
* match.h (gfc_match_omp_interop): New.
* openmp.cc (gfc_omp_directives): Uncomment 'interop' entry.
(gfc_free_omp_clauses, gfc_match_omp_allocate,
gfc_match_omp_flush, gfc_match_omp_clause_reduction): Update
call.
(enum omp_mask2): Add OMP_CLAUSE_{INIT,USE,DESTROY}.
(OMP_INTEROP_CLAUSES): Use it.
(gfc_match_omp_clauses): Match those clauses.
(gfc_match_omp_prefer_type, gfc_match_omp_init,
gfc_match_omp_interop): New.
(resolve_omp_clauses): Handle interop clauses.
(omp_code_to_statement): Add ST_OMP_INTEROP.
(gfc_resolve_omp_directive): Add EXEC_OMP_INTEROP.
* parse.cc (decode_omp_directive): Parse 'interop' directive.
(next_statement, gfc_ascii_statement): Handle ST_OMP_INTEROP.
* st.cc (gfc_free_statement): Likewise
* resolve.cc (gfc_resolve_code): Handle EXEC_OMP_INTEROP.
* trans.cc (trans_code): Likewise.
* trans-openmp.cc (gfc_trans_omp_directive): Print 'sorry'
for EXEC_OMP_INTEROP.
gcc/testsuite/ChangeLog:
* gfortran.dg/gomp/interop-1.f90: New test.
* gfortran.dg/gomp/interop-2.f90: New test.
* gfortran.dg/gomp/interop-3.f90: New test.
gcc/fortran/dump-parse-tree.cc | 61 +++-
gcc/fortran/gfortran.h | 17 +-
gcc/fortran/match.cc | 13 +-
gcc/fortran/match.h | 1 +
gcc/fortran/openmp.cc | 412 +++++++++++++++++++++++++--
gcc/fortran/parse.cc | 7 +
gcc/fortran/resolve.cc | 1 +
gcc/fortran/st.cc | 3 +-
gcc/fortran/trans-openmp.cc | 3 +
gcc/fortran/trans.cc | 3 +-
gcc/testsuite/gfortran.dg/gomp/interop-1.f90 | 62 ++++
gcc/testsuite/gfortran.dg/gomp/interop-2.f90 | 46 +++
gcc/testsuite/gfortran.dg/gomp/interop-3.f90 | 59 ++++
13 files changed, 651 insertions(+), 37 deletions(-)
@@ -1374,6 +1374,8 @@ show_omp_namelist (int list_type, gfc_omp_namelist *n)
}
ns_iter = n->u2.ns;
}
+ else if (list_type == OMP_LIST_INIT && n != n2)
+ fputs (") INIT(", dumpfile);
if (list_type == OMP_LIST_ALLOCATE)
{
if (n->u2.allocator)
@@ -1525,6 +1527,39 @@ show_omp_namelist (int list_type, gfc_omp_namelist *n)
fputs (", ", dumpfile);
continue;
}
+ else if (list_type == OMP_LIST_INIT)
+ {
+ int i = 0;
+ if (n->u.init.target)
+ fputs ("target,", dumpfile);
+ if (n->u.init.targetsync)
+ fputs ("targetsync,", dumpfile);
+ char *prefer_type = n->u.init.str;
+ if (n->u.init.len)
+ fputs ("prefer_type(", dumpfile);
+ if (n->u.init.len)
+ while (*prefer_type)
+ {
+ fputc ('{', dumpfile);
+ if (n->u2.interop_int && n->u2.interop_int[i] != 0)
+ fprintf (dumpfile, "fr(%d),", n->u2.interop_int[i]);
+ else if (prefer_type[0] != ' ' || prefer_type[1] != '\0')
+ fprintf (dumpfile, "fr(\"%s\"),", prefer_type);
+ prefer_type += 1 + strlen (prefer_type);
+
+ while (*prefer_type)
+ {
+ fprintf (dumpfile, "attr(\"%s\"),", prefer_type);
+ prefer_type += 1 + strlen (prefer_type);
+ }
+ fputc ('}', dumpfile);
+ ++prefer_type;
+ ++i;
+ }
+ if (n->u.init.len)
+ fputc (')', dumpfile);
+ fputc (':', dumpfile);
+ }
fprintf (dumpfile, "%s", n->sym ? n->sym->name : "omp_all_memory");
if (list_type == OMP_LIST_LINEAR && n->u.linear.op != OMP_LINEAR_DEFAULT)
fputc (')', dumpfile);
@@ -1806,11 +1841,12 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses)
fputs (" UNTIED", dumpfile);
if (omp_clauses->mergeable)
fputs (" MERGEABLE", dumpfile);
+ if (omp_clauses->nowait)
+ fputs (" NOWAIT", dumpfile);
if (omp_clauses->collapse)
fprintf (dumpfile, " COLLAPSE(%d)", omp_clauses->collapse);
for (list_type = 0; list_type < OMP_LIST_NUM; list_type++)
- if (omp_clauses->lists[list_type] != NULL
- && list_type != OMP_LIST_COPYPRIVATE)
+ if (omp_clauses->lists[list_type] != NULL)
{
const char *type = NULL;
switch (list_type)
@@ -1855,6 +1891,9 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses)
case OMP_LIST_SCAN_IN: type = "INCLUSIVE"; break;
case OMP_LIST_SCAN_EX: type = "EXCLUSIVE"; break;
case OMP_LIST_USES_ALLOCATORS: type = "USES_ALLOCATORS"; break;
+ case OMP_LIST_INIT: type = "INIT"; break;
+ case OMP_LIST_USE: type = "USE"; break;
+ case OMP_LIST_DESTROY: type = "DESTROY"; break;
default:
gcc_unreachable ();
}
@@ -2186,6 +2225,7 @@ show_omp_node (int level, gfc_code *c)
case EXEC_OMP_DO_SIMD: name = "DO SIMD"; break;
case EXEC_OMP_ERROR: name = "ERROR"; break;
case EXEC_OMP_FLUSH: name = "FLUSH"; break;
+ case EXEC_OMP_INTEROP: name = "INTEROP"; break;
case EXEC_OMP_LOOP: name = "LOOP"; break;
case EXEC_OMP_MASKED: name = "MASKED"; break;
case EXEC_OMP_MASKED_TASKLOOP: name = "MASKED TASKLOOP"; break;
@@ -2286,6 +2326,7 @@ show_omp_node (int level, gfc_code *c)
case EXEC_OMP_DO:
case EXEC_OMP_DO_SIMD:
case EXEC_OMP_ERROR:
+ case EXEC_OMP_INTEROP:
case EXEC_OMP_LOOP:
case EXEC_OMP_ORDERED:
case EXEC_OMP_MASKED:
@@ -2379,6 +2420,7 @@ show_omp_node (int level, gfc_code *c)
|| c->op == EXEC_OMP_TARGET_UPDATE || c->op == EXEC_OMP_TARGET_ENTER_DATA
|| c->op == EXEC_OMP_TARGET_EXIT_DATA || c->op == EXEC_OMP_SCAN
|| c->op == EXEC_OMP_DEPOBJ || c->op == EXEC_OMP_ERROR
+ || c->op == EXEC_OMP_INTEROP
|| (c->op == EXEC_OMP_ORDERED && c->block == NULL))
return;
if (c->op == EXEC_OMP_SECTIONS || c->op == EXEC_OMP_PARALLEL_SECTIONS)
@@ -2401,19 +2443,7 @@ show_omp_node (int level, gfc_code *c)
fputc ('\n', dumpfile);
code_indent (level, 0);
fprintf (dumpfile, "!$%s END %s", is_oacc ? "ACC" : "OMP", name);
- if (omp_clauses != NULL)
- {
- if (omp_clauses->lists[OMP_LIST_COPYPRIVATE])
- {
- fputs (" COPYPRIVATE(", dumpfile);
- show_omp_namelist (OMP_LIST_COPYPRIVATE,
- omp_clauses->lists[OMP_LIST_COPYPRIVATE]);
- fputc (')', dumpfile);
- }
- else if (omp_clauses->nowait)
- fputs (" NOWAIT", dumpfile);
- }
- else if (c->op == EXEC_OMP_CRITICAL && c->ext.omp_clauses)
+ if (c->op == EXEC_OMP_CRITICAL && c->ext.omp_clauses)
fprintf (dumpfile, " (%s)", c->ext.omp_clauses->critical_name);
}
@@ -3529,6 +3559,7 @@ show_code_node (int level, gfc_code *c)
case EXEC_OMP_DO:
case EXEC_OMP_DO_SIMD:
case EXEC_OMP_ERROR:
+ case EXEC_OMP_INTEROP:
case EXEC_OMP_FLUSH:
case EXEC_OMP_LOOP:
case EXEC_OMP_MASKED:
@@ -323,7 +323,7 @@ enum gfc_statement
/* Note: gfc_match_omp_nothing returns ST_NONE. */
ST_OMP_NOTHING, ST_NONE,
ST_OMP_UNROLL, ST_OMP_END_UNROLL,
- ST_OMP_TILE, ST_OMP_END_TILE
+ ST_OMP_TILE, ST_OMP_END_TILE, ST_OMP_INTEROP
};
/* Types of interfaces that we can have. Assignment interfaces are
@@ -1381,6 +1381,13 @@ typedef struct gfc_omp_namelist
struct gfc_symbol *memspace_sym;
bool lastprivate_conditional;
bool present_modifier;
+ struct
+ {
+ char *str;
+ int len;
+ bool target;
+ bool targetsync;
+ } init;
} u;
union
{
@@ -1389,6 +1396,7 @@ typedef struct gfc_omp_namelist
gfc_expr *allocator;
struct gfc_symbol *traits_sym;
struct gfc_omp_namelist *duplicate_of;
+ int *interop_int;
} u2;
struct gfc_omp_namelist *next;
locus where;
@@ -1433,6 +1441,9 @@ enum
OMP_LIST_HAS_DEVICE_ADDR,
OMP_LIST_ENTER,
OMP_LIST_USES_ALLOCATORS,
+ OMP_LIST_INIT,
+ OMP_LIST_USE,
+ OMP_LIST_DESTROY,
OMP_LIST_NUM /* Must be the last. */
};
@@ -3044,7 +3055,7 @@ enum gfc_exec_op
EXEC_OMP_TARGET_TEAMS_LOOP, EXEC_OMP_MASKED, EXEC_OMP_PARALLEL_MASKED,
EXEC_OMP_PARALLEL_MASKED_TASKLOOP, EXEC_OMP_PARALLEL_MASKED_TASKLOOP_SIMD,
EXEC_OMP_MASKED_TASKLOOP, EXEC_OMP_MASKED_TASKLOOP_SIMD, EXEC_OMP_SCOPE,
- EXEC_OMP_UNROLL, EXEC_OMP_TILE,
+ EXEC_OMP_UNROLL, EXEC_OMP_TILE, EXEC_OMP_INTEROP,
EXEC_OMP_ERROR, EXEC_OMP_ALLOCATE, EXEC_OMP_ALLOCATORS
};
@@ -3683,7 +3694,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 *, bool, bool, bool);
+void gfc_free_omp_namelist (gfc_omp_namelist *, bool, bool, bool, bool);
void gfc_free_equiv (gfc_equiv *);
void gfc_free_equiv_until (gfc_equiv *, gfc_equiv *);
void gfc_free_data (gfc_data *);
@@ -5540,10 +5540,11 @@ gfc_free_namelist (gfc_namelist *name)
void
gfc_free_omp_namelist (gfc_omp_namelist *name, bool free_ns,
bool free_align_allocator,
- bool free_mem_traits_space)
+ bool free_mem_traits_space, bool free_init)
{
gfc_omp_namelist *n;
gfc_expr *last_allocator = NULL;
+ char *last_init_str = NULL;
for (; name; name = n)
{
@@ -5552,6 +5553,7 @@ gfc_free_omp_namelist (gfc_omp_namelist *name, bool free_ns,
gfc_free_expr (name->u.align);
else if (free_mem_traits_space)
{ } /* name->u.memspace_sym: shall not call gfc_free_symbol here. */
+
if (free_ns)
gfc_free_namespace (name->u2.ns);
else if (free_align_allocator)
@@ -5564,6 +5566,15 @@ gfc_free_omp_namelist (gfc_omp_namelist *name, bool free_ns,
}
else if (free_mem_traits_space)
{ } /* name->u2.traits_sym: shall not call gfc_free_symbol here. */
+ else if (free_init)
+ {
+ if (name->u.init.str != last_init_str)
+ {
+ last_init_str = name->u.init.str;
+ free (name->u.init.str);
+ free (name->u2.interop_int);
+ }
+ }
else if (name->u2.udr)
{
if (name->u2.udr->combiner)
@@ -172,6 +172,7 @@ match gfc_match_omp_do_simd (void);
match gfc_match_omp_loop (void);
match gfc_match_omp_error (void);
match gfc_match_omp_flush (void);
+match gfc_match_omp_interop (void);
match gfc_match_omp_masked (void);
match gfc_match_omp_masked_taskloop (void);
match gfc_match_omp_masked_taskloop_simd (void);
@@ -18,6 +18,8 @@ You should have received a copy of the GNU General Public License
along with GCC; see the file COPYING3. If not see
<http://www.gnu.org/licenses/>. */
+#define INCLUDE_VECTOR
+#define INCLUDE_STRING
#include "config.h"
#include "system.h"
#include "coretypes.h"
@@ -78,7 +80,7 @@ static const struct gfc_omp_directive gfc_omp_directives[] = {
/* "error" becomes GFC_OMP_DIR_EXECUTABLE with at(execution) */
{"error", GFC_OMP_DIR_UTILITY, ST_OMP_ERROR},
{"flush", GFC_OMP_DIR_EXECUTABLE, ST_OMP_FLUSH},
- /* {"interop", GFC_OMP_DIR_EXECUTABLE, ST_OMP_INTEROP}, */
+ {"interop", GFC_OMP_DIR_EXECUTABLE, ST_OMP_INTEROP},
{"loop", GFC_OMP_DIR_EXECUTABLE, ST_OMP_LOOP},
{"masked", GFC_OMP_DIR_EXECUTABLE, ST_OMP_MASKED},
/* {"metadirective", GFC_OMP_DIR_META, ST_OMP_METADIRECTIVE}, */
@@ -193,7 +195,8 @@ gfc_free_omp_clauses (gfc_omp_clauses *c)
gfc_free_omp_namelist (c->lists[i],
i == OMP_LIST_AFFINITY || i == OMP_LIST_DEPEND,
i == OMP_LIST_ALLOCATE,
- i == OMP_LIST_USES_ALLOCATORS);
+ i == OMP_LIST_USES_ALLOCATORS,
+ i == OMP_LIST_INIT);
gfc_free_expr_list (c->wait_list);
gfc_free_expr_list (c->tile_list);
gfc_free_expr_list (c->sizes_list);
@@ -559,7 +562,7 @@ syntax:
gfc_error ("Syntax error in OpenMP variable list at %C");
cleanup:
- gfc_free_omp_namelist (head, false, false, false);
+ gfc_free_omp_namelist (head, false, false, false, false);
gfc_current_locus = old_loc;
return MATCH_ERROR;
}
@@ -649,7 +652,7 @@ syntax:
gfc_error ("Syntax error in OpenMP variable list at %C");
cleanup:
- gfc_free_omp_namelist (head, false, false, false);
+ gfc_free_omp_namelist (head, false, false, false, false);
gfc_current_locus = old_loc;
return MATCH_ERROR;
}
@@ -758,7 +761,7 @@ syntax:
gfc_error ("Syntax error in OpenMP SINK dependence-type list at %C");
cleanup:
- gfc_free_omp_namelist (head, false, false, false);
+ gfc_free_omp_namelist (head, false, false, false, false);
gfc_current_locus = old_loc;
return MATCH_ERROR;
}
@@ -1106,6 +1109,9 @@ enum omp_mask2
OMP_CLAUSE_FULL, /* OpenMP 5.1. */
OMP_CLAUSE_PARTIAL, /* OpenMP 5.1. */
OMP_CLAUSE_SIZES, /* OpenMP 5.1. */
+ OMP_CLAUSE_INIT, /* OpenMP 5.1. */
+ OMP_CLAUSE_DESTROY, /* OpenMP 5.1. */
+ OMP_CLAUSE_USE, /* OpenMP 5.1. */
/* This must come last. */
OMP_MASK2_LAST
};
@@ -1517,7 +1523,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, false, false, false);
+ gfc_free_omp_namelist (n, false, false, false, false);
}
else
for (n = *head; n; n = n->next)
@@ -1808,11 +1814,330 @@ gfc_match_omp_clause_uses_allocators (gfc_omp_clauses *c)
return MATCH_YES;
error:
- gfc_free_omp_namelist (head, false, false, true);
+ gfc_free_omp_namelist (head, false, false, true, false);
return MATCH_ERROR;
}
+/* Match the 'prefer_type' modifier of the interop 'init' clause:
+ with either OpenMP 5.1's
+ prefer_type ( <const-int-expr|string literal> [, ...]
+ or
+ prefer_type ( '{' <fr(...) | attr (...)>, ...] '}' [, '{' ... '}' ] )
+ where 'fr' takes an integer named constant or a string literal
+ and 'attr takes a string literal, starting with 'ompx_')
+
+Document string + int format
+*/
+
+static match
+gfc_match_omp_prefer_type (char **pref_str, int *pref_str_len, int **pref_int_array)
+{
+ gfc_expr *e;
+ size_t cnt = 0;
+ std::vector<int> int_list;
+ std::string pref_string;
+ /* New syntax. */
+ if (gfc_peek_ascii_char () == '{')
+ do
+ {
+ if (gfc_match ("{ ") != MATCH_YES)
+ {
+ gfc_error ("Expected %<{%> at %C");
+ return MATCH_ERROR;
+ }
+ std::string attr;
+ bool fr_found = false;
+ do
+ {
+ if (gfc_match ("fr ( ") == MATCH_YES)
+ {
+ if (fr_found)
+ {
+ gfc_error ("Duplicated %<fr%> preference-selector-name "
+ "at %C");
+ return MATCH_ERROR;
+ }
+ fr_found = true;
+ gfc_symbol *sym = NULL;
+ locus loc = gfc_current_locus;
+ if (gfc_match_symbol (&sym, 0) != MATCH_YES
+ || gfc_match (" _") == MATCH_YES)
+ {
+ gfc_current_locus = loc;
+ if (gfc_match_expr (&e) == MATCH_ERROR)
+ return MATCH_ERROR;
+ }
+ if ((!sym && !e)
+ || (e && (!gfc_resolve_expr (e)
+ || e->expr_type != EXPR_CONSTANT
+ || e->ts.type != BT_CHARACTER
+ || e->ts.kind != gfc_default_character_kind
+ || e->value.character.length == 0))
+ || (sym && (sym->attr.flavor != FL_PARAMETER
+ || sym->ts.type != BT_INTEGER
+ || !mpz_fits_sint_p (sym->value->value.integer)
+ || sym->attr.dimension)))
+ {
+ gfc_error ("Expected constant integer identifier or "
+ "non-empty default-kind character literal at %L",
+ &e->where);
+ gfc_free_expr (e);
+ return MATCH_ERROR;
+ }
+ if (sym)
+ {
+ for (size_t i = int_list.size(); i < cnt; ++i)
+ int_list.push_back (0);
+ int_list.push_back (mpz_get_si (sym->value->value.integer));
+ pref_string += ' ';
+ pref_string += '\0';
+ }
+ else
+ {
+ char *str = XALLOCAVEC (char, e->value.character.length+1);
+ for (int i = 0; i < e->value.character.length + 1; i++)
+ str[i] = e->value.character.string[i];
+ if (memchr (str, '\0', e->value.character.length) != 0)
+ {
+ gfc_error ("Unexpected null character in character "
+ "literal at %L", &loc);
+ return MATCH_ERROR;
+ }
+ pref_string += str;
+ pref_string += '\0';
+ }
+ }
+ else if (gfc_match ("attr ( ") == MATCH_YES)
+ {
+ locus loc = gfc_current_locus;
+ if (gfc_match_expr (&e) != MATCH_YES
+ || e->expr_type != EXPR_CONSTANT
+ || e->ts.type != BT_CHARACTER)
+ {
+ gfc_error ("Expected default-kind character literal at %L",
+ &loc);
+ gfc_free_expr (e);
+ return MATCH_ERROR;
+ }
+ char *str = XALLOCAVEC (char, e->value.character.length+1);
+ for (int i = 0; i < e->value.character.length + 1; i++)
+ str[i] = e->value.character.string[i];
+ if (!startswith (str, "ompx_"))
+ {
+ gfc_error ("Character literal at %L must start with "
+ "%<ompx_%>", &e->where);
+ gfc_free_expr (e);
+ return MATCH_ERROR;
+ }
+ if (memchr (str, '\0', e->value.character.length) != 0
+ || memchr (str, ',', e->value.character.length) != 0)
+ {
+ gfc_error ("Unexpected null or %<,%> character in "
+ "character literal at %L", &e->where);
+ return MATCH_ERROR;
+ }
+ attr += str;
+ attr += '\0';
+ }
+ else
+ {
+ gfc_error ("Expected %<fr(%> or %<attr(%> at %C");
+ return MATCH_ERROR;
+ }
+ ++cnt;
+ if (gfc_match (") ") != MATCH_YES)
+ {
+ gfc_error ("Expected %<)%> at %C");
+ return MATCH_ERROR;
+ }
+ if (gfc_match (", ") == MATCH_YES)
+ continue;
+ if (gfc_match ("} ") == MATCH_YES)
+ break;
+ gfc_error ("Expected %<,%> or %<}%> at %C");
+ return MATCH_ERROR;
+ }
+ while (true);
+ if (!fr_found)
+ {
+ pref_string += ' ';
+ pref_string += '\0';
+ }
+ pref_string += attr;
+ pref_string += '\0';
+
+ if (gfc_match (", ") == MATCH_YES)
+ continue;
+ if (gfc_match (") ") == MATCH_YES)
+ break;
+ gfc_error ("Expected %<,%> or %<)%> at %C");
+ return MATCH_ERROR;
+ }
+ while (true);
+ else
+ do
+ {
+ if (gfc_match_expr (&e) != MATCH_YES)
+ return MATCH_ERROR;
+ if (!gfc_resolve_expr (e)
+ || e->expr_type != EXPR_CONSTANT
+ || (e->ts.type != BT_INTEGER && e->ts.type != BT_CHARACTER)
+ || (e->ts.type == BT_INTEGER
+ && !mpz_fits_sint_p (e->value.integer))
+ || (e->ts.type == BT_CHARACTER
+ && (e->ts.kind != gfc_default_character_kind
+ || e->value.character.length == 0)))
+ {
+ gfc_error ("Expected constant integer expression or non-empty "
+ "default-kind character literal at %L", &e->where);
+ gfc_free_expr (e);
+ return MATCH_ERROR;
+ }
+ if (e->ts.type == BT_INTEGER)
+ {
+ for (size_t i = int_list.size(); i < cnt; ++i)
+ int_list.push_back (0);
+ int_list.push_back (mpz_get_si (e->value.integer));
+ pref_string += ' ';
+ }
+ else
+ {
+ char *str = XALLOCAVEC (char, e->value.character.length+1);
+ for (int i = 0; i < e->value.character.length + 1; i++)
+ str[i] = e->value.character.string[i];
+ if (memchr (str, '\0', e->value.character.length) != 0)
+ {
+ gfc_error ("Unexpected null character in character literal "
+ "at %L", &e->where);
+ return MATCH_ERROR;
+ }
+ pref_string += str;
+ }
+ pref_string += '\0';
+ pref_string += '\0';
+ ++cnt;
+ gfc_free_expr (e);
+ if (gfc_match (", ") == MATCH_YES)
+ continue;
+ if (gfc_match (") ") == MATCH_YES)
+ break;
+ gfc_error ("Expected %<,%> or %<)%> at %C");
+ return MATCH_ERROR;
+ }
+ while (true);
+ if (!int_list.empty())
+ for (size_t i = int_list.size(); i < cnt; ++i)
+ int_list.push_back (0);
+
+ pref_string += '\0';
+
+ *pref_str_len = pref_string.length();
+ *pref_str = XNEWVEC (char, pref_string.length ());
+ memcpy (*pref_str, pref_string.data (), pref_string.length ());
+ if (!int_list.empty ())
+ {
+ *pref_int_array = XNEWVEC (int, cnt);
+ memcpy (*pref_int_array, int_list.data (), sizeof (int) * cnt);
+ }
+ return MATCH_YES;
+}
+
+
+/* Match OpenMP 5.1's 'init' clause for 'interop' objects:
+ init([prefer_type(...)][,][<target|targetsync>, ...] :] interop-obj-list) */
+
+static match
+gfc_match_omp_init (gfc_omp_namelist **list)
+{
+ bool target = false, targetsync = false;
+ char *pref_str = NULL;
+ int pref_str_len = 0;
+ int *pref_int_array = NULL;
+ match m;
+ locus old_loc = gfc_current_locus;
+ do {
+ if (gfc_match ("prefer_type ( ") == MATCH_YES)
+ {
+ if (pref_str)
+ {
+ gfc_error ("Duplicate %<prefer_type%> modifier at %C");
+ return MATCH_ERROR;
+ }
+ m = gfc_match_omp_prefer_type (&pref_str, &pref_str_len,
+ &pref_int_array);
+ if (m != MATCH_YES)
+ return m;
+ if (gfc_match (", ") == MATCH_YES)
+ continue;
+ if (gfc_match (": ") == MATCH_YES)
+ break;
+ gfc_error ("Expected %<,%> or %<:%> at %C");
+ return MATCH_ERROR;
+ }
+ if (gfc_match ("targetsync ") == MATCH_YES)
+ {
+ targetsync = true;
+ if (gfc_match (", ") == MATCH_YES)
+ continue;
+ if (gfc_match (": ") == MATCH_YES)
+ break;
+ gfc_char_t c = gfc_peek_char ();
+ if (!pref_str
+ && (c == ')'
+ || (gfc_current_form != FORM_FREE
+ && (c == '_' || ISALPHA (c)))))
+ {
+ gfc_current_locus = old_loc;
+ break;
+ }
+ gfc_error ("Expected %<,%> or %<:%> at %C");
+ return MATCH_ERROR;
+ }
+ if (gfc_match ("target ") == MATCH_YES)
+ {
+ target = true;
+ if (gfc_match (", ") == MATCH_YES)
+ continue;
+ if (gfc_match (": ") == MATCH_YES)
+ break;
+ gfc_char_t c = gfc_peek_char ();
+ if (!pref_str
+ && (c == ')'
+ || (gfc_current_form != FORM_FREE
+ && (c == '_' || ISALPHA (c)))))
+ {
+ gfc_current_locus = old_loc;
+ break;
+ }
+ gfc_error ("Expected %<,%> or %<:%> at %C");
+ return MATCH_ERROR;
+ }
+ if (pref_str)
+ {
+ gfc_error ("Expected %<target%> or %<targetsync%> at %C");
+ return MATCH_ERROR;
+ }
+ gfc_current_locus = old_loc;
+ break;
+ }
+ while (true);
+
+ gfc_omp_namelist **head = NULL;
+ if (gfc_match_omp_variable_list ("", list, false, NULL, &head) != MATCH_YES)
+ return MATCH_ERROR;
+ for (gfc_omp_namelist *n = *head; n; n = n->next)
+ {
+ n->u.init.target = target;
+ n->u.init.targetsync = targetsync;
+ n->u.init.str = pref_str;
+ n->u.init.len = pref_str_len;
+ n->u2.interop_int = pref_int_array;
+ }
+ return MATCH_YES;
+}
+
+
/* Match with duplicate check. Matches 'name'. If expr != NULL, it
then matches '(expr)', otherwise, if open_parens is true,
it matches a ' ( ' after 'name'.
@@ -1934,7 +2259,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, false, false, false);
+ gfc_free_omp_namelist (*head, false, false, false, false);
gfc_current_locus = old_loc;
*head = NULL;
break;
@@ -2498,6 +2823,11 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
}
continue;
}
+ if ((mask & OMP_CLAUSE_DESTROY)
+ && gfc_match_omp_variable_list ("destroy (",
+ &c->lists[OMP_LIST_DESTROY],
+ true) == MATCH_YES)
+ continue;
if ((mask & OMP_CLAUSE_DETACH)
&& !openacc
&& !c->detach
@@ -2856,6 +3186,14 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
c->indirect = 1;
continue;
}
+ if ((mask & OMP_CLAUSE_INIT)
+ && gfc_match ("init ( ") == MATCH_YES)
+ {
+ m = gfc_match_omp_init (&c->lists[OMP_LIST_INIT]);
+ if (m == MATCH_YES)
+ continue;
+ goto error;
+ }
if ((mask & OMP_CLAUSE_IS_DEVICE_PTR)
&& gfc_match_omp_variable_list
("is_device_ptr (",
@@ -2929,7 +3267,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, false, false, false);
+ gfc_free_omp_namelist (*head, false, false, false, false);
gfc_current_locus = old_loc;
*head = NULL;
break;
@@ -2940,7 +3278,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
{
if (gfc_match (" %e )", &step) != MATCH_YES)
{
- gfc_free_omp_namelist (*head, false, false, false);
+ gfc_free_omp_namelist (*head, false, false, false, false);
gfc_current_locus = old_loc;
*head = NULL;
goto error;
@@ -3037,7 +3375,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
}
if (has_error)
{
- gfc_free_omp_namelist (*head, false, false, false);
+ gfc_free_omp_namelist (*head, false, false, false, false);
*head = NULL;
goto error;
}
@@ -3774,6 +4112,11 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
needs_space = true;
continue;
}
+ if ((mask & OMP_CLAUSE_USE)
+ && gfc_match_omp_variable_list ("use (",
+ &c->lists[OMP_LIST_USE],
+ true) == MATCH_YES)
+ continue;
if ((mask & OMP_CLAUSE_USE_DEVICE)
&& gfc_match_omp_variable_list ("use_device (",
&c->lists[OMP_LIST_USE_DEVICE],
@@ -4590,6 +4933,9 @@ cleanup:
(omp_mask (OMP_CLAUSE_SIZES))
#define OMP_ALLOCATORS_CLAUSES \
omp_mask (OMP_CLAUSE_ALLOCATE)
+#define OMP_INTEROP_CLAUSES \
+ (omp_mask (OMP_CLAUSE_DEPEND) | OMP_CLAUSE_NOWAIT | OMP_CLAUSE_DEVICE \
+ | OMP_CLAUSE_INIT | OMP_CLAUSE_DESTROY | OMP_CLAUSE_USE)
static match
@@ -4669,7 +5015,7 @@ gfc_match_omp_allocate (void)
gfc_error ("Unexpected expression as list item at %L in ALLOCATE "
"directive", &n->expr->where);
- gfc_free_omp_namelist (vars, false, true, false);
+ gfc_free_omp_namelist (vars, false, true, false, false);
goto error;
}
@@ -5082,14 +5428,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, false, false, false);
+ gfc_free_omp_namelist (list, false, false, false, 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, false, false, false);
+ gfc_free_omp_namelist (list, false, false, false, false);
gfc_free_omp_clauses (c);
return MATCH_ERROR;
}
@@ -5768,6 +6114,14 @@ gfc_ignore_trait_property_extension_list (void)
}
}
+
+match
+gfc_match_omp_interop (void)
+{
+ return match_omp (EXEC_OMP_INTEROP, OMP_INTEROP_CLAUSES);
+}
+
+
/* OpenMP 5.0:
trait-selector:
@@ -7618,7 +7972,7 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
"DEVICE_RESIDENT", "LINK", "USE_DEVICE",
"CACHE", "IS_DEVICE_PTR", "USE_DEVICE_PTR", "USE_DEVICE_ADDR",
"NONTEMPORAL", "ALLOCATE", "HAS_DEVICE_ADDR", "ENTER",
- "USES_ALLOCATORS" };
+ "USES_ALLOCATORS", "INIT", "USE", "DESTROY" };
STATIC_ASSERT (ARRAY_SIZE (clause_names) == OMP_LIST_NUM);
if (omp_clauses == NULL)
@@ -8001,6 +8355,29 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
}
}
+ if (code
+ && code->op == EXEC_OMP_INTEROP
+ && omp_clauses->lists[OMP_LIST_DEPEND])
+ {
+ if (!omp_clauses->lists[OMP_LIST_INIT]
+ && !omp_clauses->lists[OMP_LIST_USE]
+ && !omp_clauses->lists[OMP_LIST_DESTROY])
+ {
+ gfc_error ("DEPEND clause at %L requires action clause with "
+ "%<targetsync%> interop-type",
+ &omp_clauses->lists[OMP_LIST_DEPEND]->where);
+ }
+ for (n = omp_clauses->lists[OMP_LIST_INIT]; n; n = n->next)
+ if (!n->u.init.targetsync)
+ {
+ gfc_error ("DEPEND clause at %L requires %<targetsync%> "
+ "interop-type, lacking it for %qs at %L",
+ &omp_clauses->lists[OMP_LIST_DEPEND]->where,
+ n->sym->name, &n->where);
+ break;
+ }
+ }
+
/* Detect specifically the case where we have "map(x) private(x)" and raise
an error. If we have "...simd" combined directives though, the "private"
applies to the simd part, so this is permitted though. */
@@ -8130,7 +8507,7 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
{
prev->next = n->next;
n->next = NULL;
- gfc_free_omp_namelist (n, false, true, false);
+ gfc_free_omp_namelist (n, false, true, false, false);
n = prev->next;
}
continue;
@@ -11283,6 +11660,8 @@ omp_code_to_statement (gfc_code *code)
return ST_OMP_ERROR;
case EXEC_OMP_FLUSH:
return ST_OMP_FLUSH;
+ case EXEC_OMP_INTEROP:
+ return ST_OMP_INTEROP;
case EXEC_OMP_DISTRIBUTE:
return ST_OMP_DISTRIBUTE;
case EXEC_OMP_DISTRIBUTE_PARALLEL_DO:
@@ -11841,6 +12220,7 @@ gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns)
case EXEC_OMP_ASSUME:
case EXEC_OMP_CANCEL:
case EXEC_OMP_ERROR:
+ case EXEC_OMP_INTEROP:
case EXEC_OMP_MASKED:
case EXEC_OMP_ORDERED:
case EXEC_OMP_PARALLEL_WORKSHARE:
@@ -1165,6 +1165,9 @@ decode_omp_directive (void)
case 'f':
matcho ("flush", gfc_match_omp_flush, ST_OMP_FLUSH);
break;
+ case 'i':
+ matcho ("interop", gfc_match_omp_interop, ST_OMP_INTEROP);
+ break;
case 'm':
matcho ("masked taskloop simd", gfc_match_omp_masked_taskloop_simd,
ST_OMP_MASKED_TASKLOOP_SIMD);
@@ -1881,6 +1884,7 @@ next_statement (void)
case ST_OMP_CANCEL: case ST_OMP_CANCELLATION_POINT: case ST_OMP_DEPOBJ: \
case ST_OMP_TARGET_UPDATE: case ST_OMP_TARGET_ENTER_DATA: \
case ST_OMP_TARGET_EXIT_DATA: case ST_OMP_ORDERED_DEPEND: case ST_OMP_ERROR: \
+ case ST_OMP_INTEROP: \
case ST_ERROR_STOP: case ST_OMP_SCAN: case ST_SYNC_ALL: \
case ST_SYNC_IMAGES: case ST_SYNC_MEMORY: case ST_LOCK: case ST_UNLOCK: \
case ST_FORM_TEAM: case ST_CHANGE_TEAM: \
@@ -2810,6 +2814,9 @@ gfc_ascii_statement (gfc_statement st, bool strip_sentinel)
case ST_OMP_FLUSH:
p = "!$OMP FLUSH";
break;
+ case ST_OMP_INTEROP:
+ p = "!$OMP INTEROP";
+ break;
case ST_OMP_LOOP:
p = "!$OMP LOOP";
break;
@@ -13237,6 +13237,7 @@ start:
case EXEC_OMP_DO:
case EXEC_OMP_DO_SIMD:
case EXEC_OMP_ERROR:
+ case EXEC_OMP_INTEROP:
case EXEC_OMP_LOOP:
case EXEC_OMP_MASTER:
case EXEC_OMP_MASTER_TASKLOOP:
@@ -229,6 +229,7 @@ gfc_free_statement (gfc_code *p)
case EXEC_OMP_DO:
case EXEC_OMP_DO_SIMD:
case EXEC_OMP_ERROR:
+ case EXEC_OMP_INTEROP:
case EXEC_OMP_LOOP:
case EXEC_OMP_END_SINGLE:
case EXEC_OMP_MASKED_TASKLOOP:
@@ -290,7 +291,7 @@ gfc_free_statement (gfc_code *p)
break;
case EXEC_OMP_FLUSH:
- gfc_free_omp_namelist (p->ext.omp_namelist, false, false, false);
+ gfc_free_omp_namelist (p->ext.omp_namelist, false, false, false, false);
break;
case EXEC_OMP_BARRIER:
@@ -8358,6 +8358,9 @@ gfc_trans_omp_directive (gfc_code *code)
return gfc_trans_omp_teams (code, NULL, NULL_TREE);
case EXEC_OMP_WORKSHARE:
return gfc_trans_omp_workshare (code, code->ext.omp_clauses);
+ case EXEC_OMP_INTEROP:
+ sorry ("%<!$OMP INTEROP%>");
+ return build_empty_stmt (input_location);
default:
gcc_unreachable ();
}
@@ -2606,9 +2606,10 @@ trans_code (gfc_code * code, tree cond)
case EXEC_OMP_DISTRIBUTE_SIMD:
case EXEC_OMP_DO:
case EXEC_OMP_DO_SIMD:
- case EXEC_OMP_LOOP:
case EXEC_OMP_ERROR:
case EXEC_OMP_FLUSH:
+ case EXEC_OMP_INTEROP:
+ case EXEC_OMP_LOOP:
case EXEC_OMP_MASKED:
case EXEC_OMP_MASKED_TASKLOOP:
case EXEC_OMP_MASKED_TASKLOOP_SIMD:
new file mode 100644
@@ -0,0 +1,62 @@
+module m
+ use iso_c_binding
+ implicit none
+
+ ! The following definitions are in omp_lib, which cannot be included
+ ! in gcc/testsuite/
+ integer, parameter :: omp_interop_kind = c_intptr_t
+ integer, parameter :: omp_interop_fr_kind = c_int
+
+ integer (omp_interop_kind), parameter :: omp_interop_none = 0_omp_interop_kind
+ integer (omp_interop_fr_kind), parameter :: omp_ifr_cuda = 1
+ integer (omp_interop_fr_kind), parameter :: omp_ifr_cuda_driver = 2
+ integer (omp_interop_fr_kind), parameter :: omp_ifr_opencl = 3
+ integer (omp_interop_fr_kind), parameter :: omp_ifr_sycl = 4
+ integer (omp_interop_fr_kind), parameter :: omp_ifr_hip = 5
+ integer (omp_interop_fr_kind), parameter :: omp_ifr_level_zero = 6
+ integer (omp_interop_fr_kind), parameter :: omp_ifr_hsa = 7
+end module m
+
+subroutine sub1
+ !$omp interop
+ integer :: y ! { dg-error "Unexpected data declaration statement" }
+end subroutine sub1
+
+program main
+use m
+implicit none
+
+!$omp requires reverse_offload
+
+integer(omp_interop_kind) :: obj1, obj2, obj3, obj4, obj5
+integer :: x
+
+!$omp interop init(obj1) init(target,targetsync,target,targetsync : obj2, obj3) nowait
+
+!$omp interop init(prefer_type("cu"//"da", omp_ifr_opencl, omp_ifr_level_zero, "hsa"), targetsync : obj1) &
+!$omp& destroy(obj2, obj3) depend(inout: x) use(obj4, obj5) device(device_num: 0)
+
+!$omp assume contains(interop)
+ !$omp interop init(prefer_type("cu"//char(1)//"da") : obj3)
+!$omp end assume
+
+!$omp interop init(prefer_type("cu"//char(0)//"da") : obj3) ! { dg-error "Unexpected null character in character literal" }
+
+!$omp interop depend(inout: x) , use(obj2), destroy(obj3) ! OK, use or destory might have 'targetsync'
+
+!$omp interop depend(inout: x) use(obj2), destroy(obj3) ! Likewise
+
+!$omp interop depend(inout: x) init(targetsync : obj5) use(obj2), destroy(obj3) init(prefer_type("cuda"), targetsync : obj4) ! OK
+
+!$omp interop init ( target , prefer_type( { fr("hsa") }, "hip") : obj1) ! { dg-error "Expected '\{' at .1." }
+
+!$omp interop init ( target , prefer_type( { fr("hsa"), attr("ompx_nothing") , fr("hsa" ) }) :obj1) ! { dg-error "Duplicated 'fr' preference-selector-name" }
+
+!$omp interop init ( prefer_type( 4, omp_ifr_hip*4) : obj1)
+!$omp interop init ( prefer_type( sin(3.3) : obj1) ! { dg-error "Expected constant integer expression or non-empty default-kind character literal" }
+!$omp interop init ( prefer_type( {fr(4) }) : obj1) ! { dg-error "Expected constant integer identifier or non-empty default-kind character literal" }
+!$omp interop init ( prefer_type( {fr(4_"cuda") }) : obj1) ! { dg-error "Expected constant integer identifier or non-empty default-kind character literal" }
+!$omp interop init ( prefer_type( {fr(c_char_"cuda") }) : obj1) ! OK
+!$omp interop init ( prefer_type( {fr(1_"cuda") }) : obj1) ! OK
+
+end
new file mode 100644
@@ -0,0 +1,46 @@
+module m
+ use iso_c_binding
+ implicit none
+
+ ! The following definitions are in omp_lib, which cannot be included
+ ! in gcc/testsuite/
+ integer, parameter :: omp_interop_kind = c_intptr_t
+ integer, parameter :: omp_interop_fr_kind = c_int
+
+ integer (omp_interop_kind), parameter :: omp_interop_none = 0_omp_interop_kind
+ integer (omp_interop_fr_kind), parameter :: omp_ifr_cuda = 1
+ integer (omp_interop_fr_kind), parameter :: omp_ifr_cuda_driver = 2
+ integer (omp_interop_fr_kind), parameter :: omp_ifr_opencl = 3
+ integer (omp_interop_fr_kind), parameter :: omp_ifr_sycl = 4
+ integer (omp_interop_fr_kind), parameter :: omp_ifr_hip = 5
+ integer (omp_interop_fr_kind), parameter :: omp_ifr_level_zero = 6
+ integer (omp_interop_fr_kind), parameter :: omp_ifr_hsa = 7
+end module m
+
+program main
+use m
+implicit none
+
+!$omp requires reverse_offload
+
+integer(omp_interop_kind) :: obj1, obj2, obj3, obj4, obj5
+integer :: x
+
+!$omp interop init ( prefer_type( {fr(1_"") }) : obj1) ! { dg-error "Expected constant integer identifier or non-empty default-kind character literal" }
+!$omp interop init ( prefer_type( {fr(1_"hip") , attr(omp_ifr_cuda) }) : obj1) ! { dg-error "Expected default-kind character literal" }
+
+!$omp interop init ( prefer_type( {fr(1_"hip") , attr("myooption") }) : obj1) ! { dg-error "Character literal at .1. must start with 'ompx_'" }
+!$omp interop init ( prefer_type( {fr(1_"hip") , attr("ompx_option") , attr("ompx_") } ) : obj1)
+!$omp interop init ( prefer_type( {fr(1_"hip") , attr("ompx_option") }, { attr("ompx_") } ) : obj1)
+!$omp interop init ( prefer_type( {fr(1_"hip") , attr("ompx_option") } { attr("ompx_") } ) : obj1) ! { dg-error "Expected ',' or '\\)'" }
+!$omp interop init ( prefer_type( {fr(1_"hip") , attr("ompx_option") ) : obj1) ! { dg-error "Expected ',' or '\}'" }
+
+!$omp interop init ( prefer_type( {fr(1_"hip") attr("ompx_option") ) : obj1) ! { dg-error "Expected ',' or '\}'" }
+!$omp interop init ( prefer_type( {fr(1_"hip")}), prefer_type("cuda") : obj1) ! { dg-error "Duplicate 'prefer_type' modifier" }
+
+!$omp interop init ( prefer_type( {attr("ompx_option1,ompx_option2") ) : obj1) ! { dg-error "Unexpected null or ',' character in character literal" }
+
+!$omp interop init ( targetsync other ) : obj1) ! { dg-error "Expected ',' or ':'" }
+!$omp interop init ( prefer_type( {fr(1_"cuda") } ), other : obj1) ! { dg-error "Expected 'target' or 'targetsync'" }
+!$omp interop init ( prefer_type( {fr(1_"cuda") } ), obj1) ! { dg-error "Expected 'target' or 'targetsync'" }
+end
new file mode 100644
@@ -0,0 +1,59 @@
+module m
+ use iso_c_binding
+ implicit none
+
+ ! The following definitions are in omp_lib, which cannot be included
+ ! in gcc/testsuite/
+ integer, parameter :: omp_interop_kind = c_intptr_t
+ integer, parameter :: omp_interop_fr_kind = c_int
+
+ integer (omp_interop_kind), parameter :: omp_interop_none = 0_omp_interop_kind
+ integer (omp_interop_fr_kind), parameter :: omp_ifr_cuda = 1
+ integer (omp_interop_fr_kind), parameter :: omp_ifr_cuda_driver = 2
+ integer (omp_interop_fr_kind), parameter :: omp_ifr_opencl = 3
+ integer (omp_interop_fr_kind), parameter :: omp_ifr_sycl = 4
+ integer (omp_interop_fr_kind), parameter :: omp_ifr_hip = 5
+ integer (omp_interop_fr_kind), parameter :: omp_ifr_level_zero = 6
+ integer (omp_interop_fr_kind), parameter :: omp_ifr_hsa = 7
+end module m
+
+program main
+use m
+implicit none
+
+!$omp requires reverse_offload
+
+integer(omp_interop_kind) :: obj1, obj2, obj3, obj4, obj5
+integer(omp_interop_kind) :: target, targetsync,prefer_type
+integer :: x
+
+!$omp interop init(obj1) init(target,targetsync,target,targetsync : obj2, obj3) nowait
+
+!$omp interop init(prefer_type("cu"//"da", omp_ifr_opencl, omp_ifr_level_zero, "hsa"), targetsync : obj1) &
+!$omp& destroy(obj2, obj3) depend(inout: x) use(obj4, obj5) device(device_num: 0)
+
+!$omp assume contains(interop)
+ !$omp interop init(prefer_type("cu"//char(1)//"da") : obj3)
+!$omp end assume
+
+!$omp interop init(obj1, obj2, obj1), use(obj4) destroy(obj4)
+! { dg-error "Symbol 'obj1' present on multiple clauses" "" { target *-*-* } .-1 }
+! { dg-error "Symbol 'obj4' present on multiple clauses" "" { target *-*-* } .-2 }
+
+!$omp interop depend(inout: x) ! { dg-error "DEPEND clause at .1. requires action clause with 'targetsync' interop-type" }
+
+!$omp interop depend(inout: x) , use(obj2), destroy(obj3) ! OK, use or destory might have 'targetsync'
+
+!$omp interop depend(inout: x) use(obj2), destroy(obj3) ! Likewise
+
+!$omp interop depend(inout: x) use(obj2), destroy(obj3) init(obj4) ! { dg-error "DEPEND clause at .1. requires 'targetsync' interop-type, lacking it for 'obj4' at .2." }
+
+!$omp interop depend(inout: x) init(targetsync : obj5) use(obj2), destroy(obj3) init(obj4) ! { dg-error "DEPEND clause at .1. requires 'targetsync' interop-type, lacking it for 'obj4' at .2." }
+!$omp interop depend(inout: x) init(targetsync : obj5) use(obj2), destroy(obj3) init(prefer_type("cuda"), targetsync : obj4) ! OK
+
+!$omp interop init(target, targetsync, prefer_type, obj1)
+!$omp interop init(prefer_type, obj1, target, targetsync)
+!$omp interop init(target, targetsync,target) ! { dg-error "Symbol 'target' present on multiple clauses" }
+
+!$omp interop init(, targetsync, prefer_type, obj1, target) ! { dg-error "Syntax error in OpenMP variable list" }
+end