https://gcc.gnu.org/g:ca716a50c92294ae8597925b12fbfbbc06dc93cc
commit ca716a50c92294ae8597925b12fbfbbc06dc93cc
Author: Tobias Burnus <tbur...@baylibre.com>
Date: Thu Jan 23 22:26:57 2025 +0100
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.
(cherry picked from commit 4ce9e0a579fcd216c1a3439525201473402a895d)
Diff:
---
gcc/fortran/ChangeLog.omp | 37 +++
gcc/fortran/dump-parse-tree.cc | 61 +++--
gcc/fortran/gfortran.h | 15 +-
gcc/fortran/match.cc | 12 +
gcc/fortran/match.h | 1 +
gcc/fortran/openmp.cc | 383 ++++++++++++++++++++++++++-
gcc/fortran/parse.cc | 7 +
gcc/fortran/resolve.cc | 1 +
gcc/fortran/st.cc | 1 +
gcc/fortran/trans-openmp.cc | 3 +
gcc/fortran/trans.cc | 3 +-
gcc/testsuite/ChangeLog.omp | 9 +
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 +++++
libgomp/ChangeLog | 36 ---
libgomp/ChangeLog.omp | 36 +++
17 files changed, 716 insertions(+), 56 deletions(-)
diff --git a/gcc/fortran/ChangeLog.omp b/gcc/fortran/ChangeLog.omp
index 31470f4852e4..051b90a6a7d7 100644
--- a/gcc/fortran/ChangeLog.omp
+++ b/gcc/fortran/ChangeLog.omp
@@ -1,3 +1,40 @@
+2025-01-23 Tobias Burnus <tbur...@baylibre.com>
+
+ Backported from master:
+ 2024-09-06 Tobias Burnus <tbur...@baylibre.com>
+
+ * 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.
+
2024-07-29 Tobias Burnus <tbur...@baylibre.com>
Backported from master:
diff --git a/gcc/fortran/dump-parse-tree.cc b/gcc/fortran/dump-parse-tree.cc
index 28e5b48dad0f..595f9c3c7c12 100644
--- a/gcc/fortran/dump-parse-tree.cc
+++ b/gcc/fortran/dump-parse-tree.cc
@@ -1376,6 +1376,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)
@@ -1529,6 +1531,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);
@@ -1810,11 +1845,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)
@@ -1859,6 +1895,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 ();
}
@@ -2190,6 +2229,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;
@@ -2291,6 +2331,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:
@@ -2384,6 +2425,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)
@@ -2425,19 +2467,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);
}
@@ -3553,6 +3583,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:
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 9a36810fa61c..ed23818ea374 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -325,7 +325,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
@@ -1390,6 +1390,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
{
@@ -1399,6 +1406,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;
@@ -1443,6 +1451,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. */
};
@@ -3103,7 +3114,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_METADIRECTIVE,
+ EXEC_OMP_UNROLL, EXEC_OMP_TILE, EXEC_OMP_METADIRECTIVE, EXEC_OMP_INTEROP,
EXEC_OMP_ERROR, EXEC_OMP_ALLOCATE, EXEC_OMP_ALLOCATORS
};
diff --git a/gcc/fortran/match.cc b/gcc/fortran/match.cc
index 1f7d8f1b6ccd..859cdfc727ba 100644
--- a/gcc/fortran/match.cc
+++ b/gcc/fortran/match.cc
@@ -5545,8 +5545,10 @@ gfc_free_omp_namelist (gfc_omp_namelist *name, int list)
|| list == OMP_LIST_FROM);
bool free_align_allocator = (list == OMP_LIST_ALLOCATE);
bool free_mem_traits_space = (list == OMP_LIST_USES_ALLOCATORS);
+ bool free_init = (list == OMP_LIST_INIT);
gfc_omp_namelist *n;
gfc_expr *last_allocator = NULL;
+ char *last_init_str = NULL;
for (; name; name = n)
{
@@ -5555,6 +5557,7 @@ gfc_free_omp_namelist (gfc_omp_namelist *name, int list)
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)
@@ -5567,6 +5570,15 @@ gfc_free_omp_namelist (gfc_omp_namelist *name, int list)
}
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 (free_mapper && name->u2.udm)
free (name->u2.udm);
else if (!free_mapper && name->u2.udr)
diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h
index 6a37c8cff4b3..929fe73e7c98 100644
--- a/gcc/fortran/match.h
+++ b/gcc/fortran/match.h
@@ -174,6 +174,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);
diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc
index e869146517a2..beaf10123894 100644
--- a/gcc/fortran/openmp.cc
+++ b/gcc/fortran/openmp.cc
@@ -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}, */
@@ -1138,6 +1140,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
};
@@ -1897,6 +1902,325 @@ 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'.
@@ -2620,6 +2944,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
@@ -2983,6 +3312,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 (",
@@ -3934,6 +4271,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],
@@ -4748,6 +5090,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
@@ -6073,6 +6418,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:
@@ -8821,7 +9174,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)
@@ -9039,6 +9392,29 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses
*omp_clauses,
gfc_error ("DEPOBJ in DEPOBJ construct at %L shall be a scalar integer "
"of OMP_DEPEND_KIND kind", &omp_clauses->depobj->where);
+ 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;
+ }
+ }
+
verify_omp_clauses_symbol_dups (code, omp_clauses, ns, openacc);
/* OpenACC reductions. */
@@ -11868,6 +12244,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:
@@ -12445,6 +12823,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:
diff --git a/gcc/fortran/parse.cc b/gcc/fortran/parse.cc
index 1a758405228f..182c293148d5 100644
--- a/gcc/fortran/parse.cc
+++ b/gcc/fortran/parse.cc
@@ -1180,6 +1180,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);
@@ -1908,6 +1911,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: \
@@ -2884,6 +2888,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;
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 383a34117759..ac81f10f1516 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -13106,6 +13106,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:
diff --git a/gcc/fortran/st.cc b/gcc/fortran/st.cc
index 83533db6e4d2..6db632b00c04 100644
--- a/gcc/fortran/st.cc
+++ b/gcc/fortran/st.cc
@@ -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:
diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc
index e6ba7b5839e3..d96dc17a05f4 100644
--- a/gcc/fortran/trans-openmp.cc
+++ b/gcc/fortran/trans-openmp.cc
@@ -10910,6 +10910,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 ();
}
diff --git a/gcc/fortran/trans.cc b/gcc/fortran/trans.cc
index 49b021606717..342b65092b02 100644
--- a/gcc/fortran/trans.cc
+++ b/gcc/fortran/trans.cc
@@ -2602,9 +2602,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:
diff --git a/gcc/testsuite/ChangeLog.omp b/gcc/testsuite/ChangeLog.omp
index d624f84bd3f2..0f0bacf153e8 100644
--- a/gcc/testsuite/ChangeLog.omp
+++ b/gcc/testsuite/ChangeLog.omp
@@ -1,3 +1,12 @@
+2025-01-23 Tobias Burnus <tbur...@baylibre.com>
+
+ Backported from master:
+ 2024-09-06 Tobias Burnus <tbur...@baylibre.com>
+
+ * gfortran.dg/gomp/interop-1.f90: New test.
+ * gfortran.dg/gomp/interop-2.f90: New test.
+ * gfortran.dg/gomp/interop-3.f90: New test.
+
2024-12-19 Thomas Schwinge <tschwi...@baylibre.com>
PR target/65181
diff --git a/gcc/testsuite/gfortran.dg/gomp/interop-1.f90
b/gcc/testsuite/gfortran.dg/gomp/interop-1.f90
new file mode 100644
index 000000000000..bbb1dea1be62
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/interop-1.f90
@@ -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
diff --git a/gcc/testsuite/gfortran.dg/gomp/interop-2.f90
b/gcc/testsuite/gfortran.dg/gomp/interop-2.f90
new file mode 100644
index 000000000000..c7673a662d0c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/interop-2.f90
@@ -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
diff --git a/gcc/testsuite/gfortran.dg/gomp/interop-3.f90
b/gcc/testsuite/gfortran.dg/gomp/interop-3.f90
new file mode 100644
index 000000000000..a6d2cc460fb0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/interop-3.f90
@@ -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
diff --git a/libgomp/ChangeLog b/libgomp/ChangeLog
index c536093070ce..1c4e2385c0f9 100644
--- a/libgomp/ChangeLog
+++ b/libgomp/ChangeLog
@@ -1,39 +1,3 @@
-2025-01-23 Tobias Burnus <tbur...@baylibre.com>
-
- Backported from master:
- 2024-08-28 Tobias Burnus <tbur...@baylibre.com>
-
- * fortran.c (omp_get_interop_str_, omp_get_interop_name_,
- omp_get_interop_type_desc_, omp_get_interop_rc_desc_): Add.
- * libgomp.map (GOMP_5.1.3): New; add interop routines.
- * omp.h.in: Add interop typedefs, enum and prototypes.
- (__GOMP_DEFAULT_NULL): Define.
- (omp_target_memcpy_async, omp_target_memcpy_rect_async):
- Use it for the optional depend argument.
- * omp_lib.f90.in: Add paramters and interfaces for interop.
- * omp_lib.h.in: Likewise; move F90 '&' to column 81 for
- -ffree-length-80.
- * target.c (omp_get_num_interop_properties, omp_get_interop_int,
- omp_get_interop_ptr, omp_get_interop_str, omp_get_interop_name,
- omp_get_interop_type_desc, omp_get_interop_rc_desc): Add.
- * config/gcn/target.c (omp_get_num_interop_properties,
- omp_get_interop_int, omp_get_interop_ptr, omp_get_interop_str,
- omp_get_interop_name, omp_get_interop_type_desc,
- omp_get_interop_rc_desc): Add.
- * config/nvptx/target.c (omp_get_num_interop_properties,
- omp_get_interop_int, omp_get_interop_ptr, omp_get_interop_str,
- omp_get_interop_name, omp_get_interop_type_desc,
- omp_get_interop_rc_desc): Add.
- * testsuite/libgomp.c-c++-common/interop-routines-1.c: New test.
- * testsuite/libgomp.c-c++-common/interop-routines-2.c: New test.
- * testsuite/libgomp.fortran/interop-routines-1.F90: New test.
- * testsuite/libgomp.fortran/interop-routines-2.F90: New test.
- * testsuite/libgomp.fortran/interop-routines-3.F: New test.
- * testsuite/libgomp.fortran/interop-routines-4.F: New test.
- * testsuite/libgomp.fortran/interop-routines-5.F: New test.
- * testsuite/libgomp.fortran/interop-routines-6.F: New test.
- * testsuite/libgomp.fortran/interop-routines-7.F90: New test.
-
2024-08-05 Paul Thomas <pa...@gcc.gnu.org>
Backported from master:
diff --git a/libgomp/ChangeLog.omp b/libgomp/ChangeLog.omp
index ddd6fda24491..da75f4eda917 100644
--- a/libgomp/ChangeLog.omp
+++ b/libgomp/ChangeLog.omp
@@ -1,3 +1,39 @@
+2025-01-23 Tobias Burnus <tbur...@baylibre.com>
+
+ Backported from master:
+ 2024-08-28 Tobias Burnus <tbur...@baylibre.com>
+
+ * fortran.c (omp_get_interop_str_, omp_get_interop_name_,
+ omp_get_interop_type_desc_, omp_get_interop_rc_desc_): Add.
+ * libgomp.map (GOMP_5.1.3): New; add interop routines.
+ * omp.h.in: Add interop typedefs, enum and prototypes.
+ (__GOMP_DEFAULT_NULL): Define.
+ (omp_target_memcpy_async, omp_target_memcpy_rect_async):
+ Use it for the optional depend argument.
+ * omp_lib.f90.in: Add paramters and interfaces for interop.
+ * omp_lib.h.in: Likewise; move F90 '&' to column 81 for
+ -ffree-length-80.
+ * target.c (omp_get_num_interop_properties, omp_get_interop_int,
+ omp_get_interop_ptr, omp_get_interop_str, omp_get_interop_name,
+ omp_get_interop_type_desc, omp_get_interop_rc_desc): Add.
+ * config/gcn/target.c (omp_get_num_interop_properties,
+ omp_get_interop_int, omp_get_interop_ptr, omp_get_interop_str,
+ omp_get_interop_name, omp_get_interop_type_desc,
+ omp_get_interop_rc_desc): Add.
+ * config/nvptx/target.c (omp_get_num_interop_properties,
+ omp_get_interop_int, omp_get_interop_ptr, omp_get_interop_str,
+ omp_get_interop_name, omp_get_interop_type_desc,
+ omp_get_interop_rc_desc): Add.
+ * testsuite/libgomp.c-c++-common/interop-routines-1.c: New test.
+ * testsuite/libgomp.c-c++-common/interop-routines-2.c: New test.
+ * testsuite/libgomp.fortran/interop-routines-1.F90: New test.
+ * testsuite/libgomp.fortran/interop-routines-2.F90: New test.
+ * testsuite/libgomp.fortran/interop-routines-3.F: New test.
+ * testsuite/libgomp.fortran/interop-routines-4.F: New test.
+ * testsuite/libgomp.fortran/interop-routines-5.F: New test.
+ * testsuite/libgomp.fortran/interop-routines-6.F: New test.
+ * testsuite/libgomp.fortran/interop-routines-7.F90: New test.
+
2024-12-19 Thomas Schwinge <tschwi...@baylibre.com>
PR target/65181
