https://gcc.gnu.org/g:77b9f96bd1e3bbf5506826e5e8c461f9792ff754
commit 77b9f96bd1e3bbf5506826e5e8c461f9792ff754
Author: Tobias Burnus <tbur...@baylibre.com>
Date: Thu Jan 30 11:44:01 2025 +0100
OpenMP: append_args clause fixes + Fortran support
This fixes a large number of smaller and larger issues with the append_args
clause to 'declare variant' and adds Fortran support for it; it also
contains
a larger number of testcases.
In particular, for Fortran, it also handles passing allocatable, pointer,
optional arguments to an interop dummy argument with or without value
attribute. And it changes the internal representation such that dumping the
tree does not lead to an ICE.
gcc/c/ChangeLog:
* c-parser.cc (c_finish_omp_declare_variant): Modify how
append_args is saved internally.
gcc/cp/ChangeLog:
* parser.cc (cp_finish_omp_declare_variant): Modify how append_args
is saved internally.
* pt.cc (tsubst_attribute): Likewise.
(tsubst_omp_clauses): Remove C_ORT_OMP_DECLARE_SIMD from interop
handling as no longer called for it.
* decl.cc (omp_declare_variant_finalize_one): Update append_args
changes; fixes for ADL input.
gcc/fortran/ChangeLog:
* gfortran.h (gfc_omp_declare_variant): Add append_args_list.
* openmp.cc (gfc_parser_omp_clause_init_modifiers): New;
splitt of from ...
(gfc_match_omp_init): ... here; call it.
(gfc_match_omp_declare_variant): Update to handle append_args
clause; some syntax handling fixes.
* trans-openmp.cc (gfc_trans_omp_declare_variant): Handle
append_args clause; add some diagnostic.
gcc/ChangeLog:
* gimplify.cc (gimplify_call_expr): For OpenMP's append_args clause
processed by 'omp dispatch', update for internal-representation
changes; fix handling of hidden arguments, add some comments and
handle Fortran's value dummy and optional/pointer/allocatable actual
args.
libgomp/ChangeLog:
* libgomp.texi (Impl. Status): Update for accumpulated changes
related to 'dispatch' and interop.
gcc/testsuite/ChangeLog:
* c-c++-common/gomp/append-args-1.c: Update dg-*.
* c-c++-common/gomp/append-args-3.c: Likewise.
* g++.dg/gomp/append-args-1.C: Likewise.
* gfortran.dg/gomp/adjust-args-1.f90: Likewise.
* gfortran.dg/gomp/adjust-args-3.f90: Likewise.
* gfortran.dg/gomp/declare-variant-2.f90: Likewise.
* c-c++-common/gomp/append-args-6.c: New test.
* c-c++-common/gomp/append-args-7.c: New test.
* c-c++-common/gomp/append-args-8.c: New test.
* c-c++-common/gomp/append-args-9.c: New test.
* g++.dg/gomp/append-args-4.C: New test.
* g++.dg/gomp/append-args-5.C: New test.
* g++.dg/gomp/append-args-6.C: New test.
* g++.dg/gomp/append-args-7.C: New test.
* gcc.dg/gomp/append-args-1.c: New test.
* gfortran.dg/gomp/append_args-1.f90: New test.
* gfortran.dg/gomp/append_args-2.f90: New test.
* gfortran.dg/gomp/append_args-3.f90: New test.
* gfortran.dg/gomp/append_args-4.f90: New test.
(cherry picked from commit bea86e82146b9b3655e8073eef37723832862ed4)
Diff:
---
gcc/ChangeLog.omp | 11 +
gcc/c/ChangeLog.omp | 8 +
gcc/c/c-parser.cc | 42 +--
gcc/cp/ChangeLog.omp | 13 +
gcc/cp/decl.cc | 35 ++-
gcc/cp/parser.cc | 27 +-
gcc/cp/pt.cc | 28 +-
gcc/fortran/ChangeLog.omp | 14 +
gcc/fortran/gfortran.h | 1 +
gcc/fortran/openmp.cc | 182 ++++++++++---
gcc/fortran/trans-openmp.cc | 159 ++++++++++-
gcc/gimplify.cc | 99 +++++--
gcc/testsuite/ChangeLog.omp | 25 ++
gcc/testsuite/c-c++-common/gomp/append-args-1.c | 32 ++-
gcc/testsuite/c-c++-common/gomp/append-args-3.c | 4 +-
gcc/testsuite/c-c++-common/gomp/append-args-6.c | 106 ++++++++
gcc/testsuite/c-c++-common/gomp/append-args-7.c | 47 ++++
gcc/testsuite/c-c++-common/gomp/append-args-8.c | 53 ++++
gcc/testsuite/c-c++-common/gomp/append-args-9.c | 34 +++
gcc/testsuite/g++.dg/gomp/append-args-1.C | 12 +-
gcc/testsuite/g++.dg/gomp/append-args-4.C | 17 ++
gcc/testsuite/g++.dg/gomp/append-args-5.C | 72 +++++
gcc/testsuite/g++.dg/gomp/append-args-6.C | 34 +++
gcc/testsuite/g++.dg/gomp/append-args-7.C | 113 ++++++++
gcc/testsuite/gcc.dg/gomp/append-args-1.c | 70 +++++
gcc/testsuite/gfortran.dg/gomp/adjust-args-1.f90 | 2 +-
gcc/testsuite/gfortran.dg/gomp/adjust-args-3.f90 | 2 +-
gcc/testsuite/gfortran.dg/gomp/append_args-1.f90 | 76 ++++++
gcc/testsuite/gfortran.dg/gomp/append_args-2.f90 | 199 ++++++++++++++
gcc/testsuite/gfortran.dg/gomp/append_args-3.f90 | 293 +++++++++++++++++++++
gcc/testsuite/gfortran.dg/gomp/append_args-4.f90 | 264 +++++++++++++++++++
.../gfortran.dg/gomp/declare-variant-2.f90 | 10 +-
libgomp/ChangeLog.omp | 8 +
libgomp/libgomp.texi | 17 +-
34 files changed, 1980 insertions(+), 129 deletions(-)
diff --git a/gcc/ChangeLog.omp b/gcc/ChangeLog.omp
index e9cd023b7b4c..b076819d4abc 100644
--- a/gcc/ChangeLog.omp
+++ b/gcc/ChangeLog.omp
@@ -1,3 +1,14 @@
+2025-01-30 Tobias Burnus <tbur...@baylibre.com>
+
+ Backported from master:
+ 2025-01-30 Tobias Burnus <tbur...@baylibre.com>
+
+ * gimplify.cc (gimplify_call_expr): For OpenMP's append_args clause
+ processed by 'omp dispatch', update for internal-representation
+ changes; fix handling of hidden arguments, add some comments and
+ handle Fortran's value dummy and optional/pointer/allocatable actual
+ args.
+
2025-01-28 Tobias Burnus <tbur...@baylibre.com>
Backported from master:
diff --git a/gcc/c/ChangeLog.omp b/gcc/c/ChangeLog.omp
index e7517d0263e8..4f0e16d4e0bc 100644
--- a/gcc/c/ChangeLog.omp
+++ b/gcc/c/ChangeLog.omp
@@ -1,3 +1,11 @@
+2025-01-30 Tobias Burnus <tbur...@baylibre.com>
+
+ Backported from master:
+ 2025-01-30 Tobias Burnus <tbur...@baylibre.com>
+
+ * c-parser.cc (c_finish_omp_declare_variant): Modify how
+ append_args is saved internally.
+
2025-01-28 Tobias Burnus <tbur...@baylibre.com>
Backported from master:
diff --git a/gcc/c/c-parser.cc b/gcc/c/c-parser.cc
index 2b1d7001bc70..1d17ec7802d9 100644
--- a/gcc/c/c-parser.cc
+++ b/gcc/c/c-parser.cc
@@ -26811,7 +26811,10 @@ c_finish_omp_declare_variant (c_parser *parser, tree
fndecl, tree parms)
else if (ccode == append_args)
{
if (append_args_tree)
- error_at (append_args_loc, "too many %qs clauses", "append_args");
+ {
+ error_at (append_args_loc, "too many %qs clauses", "append_args");
+ append_args_tree = NULL_TREE;
+ }
do
{
location_t loc = c_parser_peek_token (parser)->location;
@@ -26836,17 +26839,19 @@ c_finish_omp_declare_variant (c_parser *parser, tree
fndecl, tree parms)
|| !c_parser_require (parser, CPP_CLOSE_PAREN,
"expected %<)%> or %<,%>"))
goto fail;
- tree t = build_omp_clause (loc, OMP_CLAUSE_INIT);
+ tree t = build_tree_list (target ? boolean_true_node
+ : boolean_false_node,
+ targetsync ? boolean_true_node
+ : boolean_false_node);
+ t = build1_loc (loc, NOP_EXPR, void_type_node, t);
+ t = build_tree_list (t, prefer_type_tree);
if (append_args_tree)
- OMP_CLAUSE_CHAIN (append_args_last) = t;
+ {
+ TREE_CHAIN (append_args_last) = t;
+ append_args_last = t;
+ }
else
append_args_tree = append_args_last = t;
- if (target)
- OMP_CLAUSE_INIT_TARGET (t) = 1;
- if (targetsync)
- OMP_CLAUSE_INIT_TARGETSYNC (t) = 1;
- if (prefer_type_tree)
- OMP_CLAUSE_INIT_PREFER_TYPE (t) = prefer_type_tree;
if (c_parser_next_token_is (parser, CPP_CLOSE_PAREN))
break;
if (!c_parser_require (parser, CPP_COMMA, "expected %<)%> or
%<,%>"))
@@ -26864,9 +26869,7 @@ c_finish_omp_declare_variant (c_parser *parser, tree
fndecl, tree parms)
OMP_TRAIT_CONSTRUCT_SIMD))
{
bool fail = false;
- if (append_args_tree
- && TYPE_ARG_TYPES (TREE_TYPE (fndecl)) != NULL_TREE
- && TYPE_ARG_TYPES (TREE_TYPE (variant)) != NULL_TREE)
+ if (append_args_tree)
{
int nappend_args = 0;
int nbase_args = 0;
@@ -26876,6 +26879,11 @@ c_finish_omp_declare_variant (c_parser *parser, tree
fndecl, tree parms)
for (tree t = append_args_tree; t; t = TREE_CHAIN (t))
nappend_args++;
+ /* Store as purpose = arg number after which to append
+ and value = list of interop items. */
+ append_args_tree = build_tree_list (build_int_cst (integer_type_node,
+ nbase_args),
+ append_args_tree);
tree args, arg;
args = arg = TYPE_ARG_TYPES (TREE_TYPE (variant));
for (int j = 0; j < nbase_args && arg; j++, arg = TREE_CHAIN (arg))
@@ -26883,7 +26891,7 @@ c_finish_omp_declare_variant (c_parser *parser, tree
fndecl, tree parms)
for (int i = 0; i < nappend_args && arg; i++)
arg = TREE_CHAIN (arg);
tree saved_args;
- if (nbase_args)
+ if (nbase_args && args)
{
saved_args = TREE_CHAIN (args);
TREE_CHAIN (args) = arg;
@@ -26892,13 +26900,17 @@ c_finish_omp_declare_variant (c_parser *parser, tree
fndecl, tree parms)
{
saved_args = args;
TYPE_ARG_TYPES (TREE_TYPE (variant)) = arg;
+ TYPE_NO_NAMED_ARGS_STDARG_P (TREE_TYPE (variant)) = 1;
}
if (!comptypes (TREE_TYPE (fndecl), TREE_TYPE (variant)))
fail = true;
- if (nbase_args)
+ if (nbase_args && args)
TREE_CHAIN (args) = saved_args;
else
- TYPE_ARG_TYPES (TREE_TYPE (variant)) = saved_args;
+ {
+ TYPE_ARG_TYPES (TREE_TYPE (variant)) = saved_args;
+ TYPE_NO_NAMED_ARGS_STDARG_P (TREE_TYPE (variant)) = 0;
+ }
arg = saved_args;
if (!fail)
for (int i = 0; i < nappend_args; i++, arg = TREE_CHAIN (arg))
diff --git a/gcc/cp/ChangeLog.omp b/gcc/cp/ChangeLog.omp
index 31c5b7f79300..68fe685fe22a 100644
--- a/gcc/cp/ChangeLog.omp
+++ b/gcc/cp/ChangeLog.omp
@@ -1,3 +1,16 @@
+2025-01-30 Tobias Burnus <tbur...@baylibre.com>
+
+ Backported from master:
+ 2025-01-30 Tobias Burnus <tbur...@baylibre.com>
+
+ * parser.cc (cp_finish_omp_declare_variant): Modify how append_args
+ is saved internally.
+ * pt.cc (tsubst_attribute): Likewise.
+ (tsubst_omp_clauses): Remove C_ORT_OMP_DECLARE_SIMD from interop
+ handling as no longer called for it.
+ * decl.cc (omp_declare_variant_finalize_one): Update append_args
+ changes; fixes for ADL input.
+
2025-01-28 Tobias Burnus <tbur...@baylibre.com>
Backported from master:
diff --git a/gcc/cp/decl.cc b/gcc/cp/decl.cc
index be36e9a58d82..44cdcc55a009 100644
--- a/gcc/cp/decl.cc
+++ b/gcc/cp/decl.cc
@@ -8279,27 +8279,33 @@ omp_declare_variant_finalize_one (tree decl, tree attr)
if (append_args_list)
{
append_args_list = TREE_VALUE (append_args_list);
- if (append_args_list)
- append_args_list = TREE_CHAIN (append_args_list);
+ append_args_list = (append_args_list && TREE_CHAIN (append_args_list)
+ ? TREE_VALUE (TREE_CHAIN (append_args_list))
+ : NULL_TREE);
for (tree t = append_args_list; t; t = TREE_CHAIN (t))
nappend_args++;
if (nappend_args)
{
tree type;
- if ((type = lookup_qualified_name (current_scope (),
+ if ((type = lookup_qualified_name (global_namespace,
"omp_interop_t",
LOOK_want::NORMAL,
/*complain*/false)) == NULL_TREE
|| !c_omp_interop_t_p (TREE_TYPE (type)))
{
+ location_t loc = input_location;
variant = tree_strip_any_location_wrapper (variant);
- if (TREE_CODE (variant) == OVERLOAD && OVL_SINGLE_P (variant))
- variant = OVL_FIRST (variant);
- error_at (EXPR_LOC_OR_LOC (variant, DECL_SOURCE_LOCATION
(variant)),
- "argument %d of %qE must be of %<omp_interop_t%>",
+ if (!identifier_p (variant))
+ {
+ if (TREE_CODE (variant) == OVERLOAD && OVL_SINGLE_P (variant))
+ variant = OVL_FIRST (variant);
+ loc = EXPR_LOC_OR_LOC (variant,
+ DECL_SOURCE_LOCATION (variant));
+ }
+ error_at (loc, "argument %d of %qE must be of %<omp_interop_t%>",
args->length () + 1, variant);
- inform (OMP_CLAUSE_LOCATION (append_args_list),
- "%<append_args%> specified here");
+ inform (EXPR_LOCATION (TREE_PURPOSE (append_args_list)),
+ "%<append_args%> specified here");
return true;
}
for (unsigned i = 0; i < nappend_args; i++)
@@ -8404,7 +8410,7 @@ omp_declare_variant_finalize_one (tree decl, tree attr)
error_at (DECL_SOURCE_LOCATION (variant),
"argument %d of %qD must be of %<omp_interop_t%>",
nbase_args + i + 1, variant);
- inform (OMP_CLAUSE_LOCATION (append_args_list),
+ inform (EXPR_LOCATION (TREE_PURPOSE (append_args_list)),
"%<append_args%> specified here");
break;
}
@@ -8447,6 +8453,15 @@ omp_declare_variant_finalize_one (tree decl, tree attr)
= build_int_cst (TREE_TYPE (t),
tree_to_uhwi (TREE_VALUE (t)) + 1);
}
+ if (DECL_NONSTATIC_MEMBER_P (variant) && append_args_list)
+ {
+ /* Shift likewise the number of args after which the
+ interop object should be added. */
+ tree nargs = TREE_CHAIN (TREE_VALUE (adjust_args_list));
+ TREE_PURPOSE (nargs)
+ = build_int_cst (TREE_TYPE (nargs),
+ tree_to_uhwi (TREE_PURPOSE (nargs)) + 1);
+ }
DECL_ATTRIBUTES (variant) = tree_cons (
get_identifier ("omp declare variant variant args"),
TREE_VALUE (adjust_args_list), DECL_ATTRIBUTES (variant));
diff --git a/gcc/cp/parser.cc b/gcc/cp/parser.cc
index 70f3f188aebc..5d28c8986516 100644
--- a/gcc/cp/parser.cc
+++ b/gcc/cp/parser.cc
@@ -50566,17 +50566,19 @@ cp_finish_omp_declare_variant (cp_parser *parser,
cp_token *pragma_tok,
&targetsync,
&prefer_type_tree))
goto fail;
- tree t = build_omp_clause (loc, OMP_CLAUSE_INIT);
+ tree t = build_tree_list (target ? boolean_true_node
+ : boolean_false_node,
+ targetsync ? boolean_true_node
+ : boolean_false_node);
+ t = build1_loc (loc, NOP_EXPR, void_type_node, t);
+ t = build_tree_list (t, prefer_type_tree);
if (append_args_tree)
- OMP_CLAUSE_CHAIN (append_args_last) = t;
+ {
+ TREE_CHAIN (append_args_last) = t;
+ append_args_last = t;
+ }
else
append_args_tree = append_args_last = t;
- if (target)
- OMP_CLAUSE_INIT_TARGET (t) = 1;
- if (targetsync)
- OMP_CLAUSE_INIT_TARGETSYNC (t) = 1;
- if (prefer_type_tree)
- OMP_CLAUSE_INIT_PREFER_TYPE (t) = prefer_type_tree;
if (cp_lexer_next_token_is_not (parser->lexer, CPP_CLOSE_PAREN))
{
cp_parser_error (parser, "expected %<)%> or %<,%>");
@@ -50596,6 +50598,15 @@ cp_finish_omp_declare_variant (cp_parser *parser,
cp_token *pragma_tok,
cp_lexer_consume_token (parser->lexer); // ','
}
while (true);
+ int nbase_args = 0;
+ for (tree t = parms;
+ t && TREE_VALUE (t) != void_type_node; t = TREE_CHAIN (t))
+ nbase_args++;
+ /* Store as purpose = arg number after which to append
+ and value = list of interop items. */
+ append_args_tree = build_tree_list (build_int_cst (integer_type_node,
+ nbase_args),
+ append_args_tree);
}
} while (cp_lexer_next_token_is_not (parser->lexer, CPP_PRAGMA_EOL));
diff --git a/gcc/cp/pt.cc b/gcc/cp/pt.cc
index 7f9c2a8ec8e9..a736ecdec5c7 100644
--- a/gcc/cp/pt.cc
+++ b/gcc/cp/pt.cc
@@ -12002,13 +12002,27 @@ tsubst_attribute (tree t, tree *decl_p, tree args,
location_t match_loc = cp_expr_loc_or_input_loc (TREE_PURPOSE (chain));
tree ctx = copy_list (TREE_VALUE (val));
tree append_args_list = TREE_CHAIN (TREE_CHAIN (chain));
- if (append_args_list)
+ if (append_args_list && TREE_VALUE (append_args_list))
{
- append_args_list = TREE_VALUE (append_args_list);
- if (append_args_list)
- TREE_CHAIN (append_args_list)
- = tsubst_omp_clauses (TREE_CHAIN (append_args_list),
- C_ORT_OMP_DECLARE_SIMD, args, complain,
in_decl);
+ append_args_list = TREE_VALUE (TREE_VALUE (append_args_list));
+ for (; append_args_list;
+ append_args_list = TREE_CHAIN (append_args_list))
+ {
+ tree pref_list = TREE_VALUE (append_args_list);
+ tree fr_list = TREE_VALUE (pref_list);
+ int len = TREE_VEC_LENGTH (fr_list);
+ for (int i = 0; i < len; i++)
+ {
+ tree *fr_expr = &TREE_VEC_ELT (fr_list, i);
+ /* Preserve NOP_EXPR to have a location. */
+ if (*fr_expr && TREE_CODE (*fr_expr) == NOP_EXPR)
+ TREE_OPERAND (*fr_expr, 0)
+ = tsubst_expr (TREE_OPERAND (*fr_expr, 0), args, complain,
+ in_decl);
+ else
+ *fr_expr = tsubst_expr (*fr_expr, args, complain, in_decl);
+ }
+ }
}
for (tree tss = ctx; tss; tss = TREE_CHAIN (tss))
{
@@ -17846,7 +17860,7 @@ tsubst_omp_clauses (tree clauses, enum
c_omp_region_type ort,
complain, in_decl);
break;
case OMP_CLAUSE_INIT:
- if ((ort == C_ORT_OMP_INTEROP || ort == C_ORT_OMP_DECLARE_SIMD)
+ if (ort == C_ORT_OMP_INTEROP
&& OMP_CLAUSE_INIT_PREFER_TYPE (nc)
&& TREE_CODE (OMP_CLAUSE_INIT_PREFER_TYPE (nc)) == TREE_LIST
&& (OMP_CLAUSE_CHAIN (nc) == NULL_TREE
diff --git a/gcc/fortran/ChangeLog.omp b/gcc/fortran/ChangeLog.omp
index 60d58e539a43..a5d7bbfed544 100644
--- a/gcc/fortran/ChangeLog.omp
+++ b/gcc/fortran/ChangeLog.omp
@@ -1,3 +1,17 @@
+2025-01-30 Tobias Burnus <tbur...@baylibre.com>
+
+ Backported from master:
+ 2025-01-30 Tobias Burnus <tbur...@baylibre.com>
+
+ * gfortran.h (gfc_omp_declare_variant): Add append_args_list.
+ * openmp.cc (gfc_parser_omp_clause_init_modifiers): New;
+ splitt of from ...
+ (gfc_match_omp_init): ... here; call it.
+ (gfc_match_omp_declare_variant): Update to handle append_args
+ clause; some syntax handling fixes.
+ * trans-openmp.cc (gfc_trans_omp_declare_variant): Handle
+ append_args clause; add some diagnostic.
+
2025-01-28 Tobias Burnus <tbur...@baylibre.com>
Backported from master:
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 019f9a70ef6a..5ef66173e696 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1735,6 +1735,7 @@ typedef struct gfc_omp_declare_variant
gfc_omp_set_selector *set_selectors;
gfc_omp_namelist *adjust_args_list;
+ gfc_omp_namelist *append_args_list;
bool checked_p : 1; /* Set if previously checked for errors. */
bool error_p : 1; /* Set if error found in directive. */
diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc
index aaff28b57d9e..6894f638100c 100644
--- a/gcc/fortran/openmp.cc
+++ b/gcc/fortran/openmp.cc
@@ -2184,33 +2184,51 @@ gfc_match_omp_prefer_type (char **type_str, int
*type_str_len)
}
-/* Match OpenMP 5.1's 'init' clause for 'interop' objects:
- init([prefer_type(...)][,][<target|targetsync>, ...] :] interop-obj-list)
*/
+/* Match OpenMP 5.1's 'init'-clause modifiers, used by the 'init' clause of
+ the 'interop' directive and the 'append_args' directive of 'declare
variant'.
+ [prefer_type(...)][,][<target|targetsync>, ...])
+
+ If is_init_clause, there might be no modifiers but variables like 'target';
+ additionally, the modifier parsing ends with a ':'.
+ If not is_init_clause (i.e. append_args), there must be modifiers and the
+ parsing ends with ')'. */
static match
-gfc_match_omp_init (gfc_omp_namelist **list)
-{
- bool target = false, targetsync = false;
- char *type_str = NULL;
- int type_str_len = 0;
+gfc_parser_omp_clause_init_modifiers (bool &target, bool &targetsync,
+ char **type_str, int &type_str_len,
+ bool is_init_clause)
+{
+ target = false;
+ targetsync = false;
+ *type_str = NULL;
+ type_str_len = 0;
match m;
locus old_loc = gfc_current_locus;
do {
if (gfc_match ("prefer_type ( ") == MATCH_YES)
{
- if (type_str)
+ if (*type_str)
{
gfc_error ("Duplicate %<prefer_type%> modifier at %C");
return MATCH_ERROR;
}
- m = gfc_match_omp_prefer_type (&type_str, &type_str_len);
+ m = gfc_match_omp_prefer_type (type_str, &type_str_len);
if (m != MATCH_YES)
return m;
if (gfc_match (", ") == MATCH_YES)
continue;
- if (gfc_match (": ") == MATCH_YES)
- break;
- gfc_error ("Expected %<,%> or %<:%> at %C");
+ if (is_init_clause)
+ {
+ if (gfc_match (": ") == MATCH_YES)
+ break;
+ gfc_error ("Expected %<,%> or %<:%> at %C");
+ }
+ else
+ {
+ if (gfc_match (") ") == MATCH_YES)
+ break;
+ gfc_error ("Expected %<,%> or %<)%> at %C");
+ }
return MATCH_ERROR;
}
if (gfc_match ("targetsync ") == MATCH_YES)
@@ -2225,11 +2243,18 @@ gfc_match_omp_init (gfc_omp_namelist **list)
targetsync = true;
if (gfc_match (", ") == MATCH_YES)
continue;
+ if (!is_init_clause)
+ {
+ if (gfc_match (") ") == MATCH_YES)
+ break;
+ gfc_error ("Expected %<,%> or %<)%> at %C");
+ return MATCH_ERROR;
+ }
if (gfc_match (": ") == MATCH_YES)
break;
gfc_char_t c = gfc_peek_char ();
- if (!type_str && (c == ')' || (gfc_current_form != FORM_FREE
- && (c == '_' || ISALPHA (c)))))
+ if (!*type_str && (c == ')' || (gfc_current_form != FORM_FREE
+ && (c == '_' || ISALPHA (c)))))
{
gfc_current_locus = old_loc;
break;
@@ -2247,11 +2272,18 @@ gfc_match_omp_init (gfc_omp_namelist **list)
target = true;
if (gfc_match (", ") == MATCH_YES)
continue;
+ if (!is_init_clause)
+ {
+ if (gfc_match (") ") == MATCH_YES)
+ break;
+ gfc_error ("Expected %<,%> or %<)%> at %C");
+ return MATCH_ERROR;
+ }
if (gfc_match (": ") == MATCH_YES)
break;
gfc_char_t c = gfc_peek_char ();
- if (!type_str && (c == ')' || (gfc_current_form != FORM_FREE
- && (c == '_' || ISALPHA (c)))))
+ if (!*type_str && (c == ')' || (gfc_current_form != FORM_FREE
+ && (c == '_' || ISALPHA (c)))))
{
gfc_current_locus = old_loc;
break;
@@ -2259,7 +2291,7 @@ gfc_match_omp_init (gfc_omp_namelist **list)
gfc_error ("Expected %<,%> or %<:%> at %C");
return MATCH_ERROR;
}
- if (type_str)
+ if (*type_str)
{
gfc_error ("Expected %<target%> or %<targetsync%> at %C");
return MATCH_ERROR;
@@ -2268,6 +2300,21 @@ gfc_match_omp_init (gfc_omp_namelist **list)
break;
}
while (true);
+ 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, targetsync;
+ char *type_str = NULL;
+ int type_str_len;
+ if (gfc_parser_omp_clause_init_modifiers (target, targetsync, &type_str,
+ type_str_len, true) == MATCH_ERROR)
+ return MATCH_ERROR;
gfc_omp_namelist **head = NULL;
if (gfc_match_omp_variable_list ("", list, false, NULL, &head) != MATCH_YES)
@@ -6927,32 +6974,39 @@ gfc_match_omp_declare_variant (void)
return MATCH_ERROR;
}
- bool has_match = false, has_adjust_args = false, error_p = false;
+ bool has_match = false, has_adjust_args = false, has_append_args = false;
+ bool error_p = false;
locus adjust_args_loc;
+ locus append_args_loc;
+ gfc_gobble_whitespace ();
+ gfc_match_char (',');
for (;;)
{
gfc_gobble_whitespace ();
- gfc_match_char (',');
- gfc_gobble_whitespace ();
enum clause
{
match,
- adjust_args
+ adjust_args,
+ append_args
} ccode;
- if (gfc_match (" match") == MATCH_YES)
+ if (gfc_match ("match") == MATCH_YES)
ccode = match;
- else if (gfc_match (" adjust_args") == MATCH_YES)
+ else if (gfc_match ("adjust_args") == MATCH_YES)
{
ccode = adjust_args;
adjust_args_loc = gfc_current_locus;
}
+ else if (gfc_match ("append_args") == MATCH_YES)
+ {
+ ccode = append_args;
+ append_args_loc = gfc_current_locus;
+ }
else
{
- if (gfc_match_omp_eos () != MATCH_YES)
- error_p = true;
+ error_p = true;
break;
}
@@ -6964,6 +7018,12 @@ gfc_match_omp_declare_variant (void)
if (ccode == match)
{
+ if (has_match)
+ {
+ gfc_error ("%qs clause at %L specified more than once",
+ "match", &gfc_current_locus);
+ return MATCH_ERROR;
+ }
has_match = true;
if (gfc_match_omp_context_selector_specification (&odv->set_selectors,
false)
@@ -7000,20 +7060,82 @@ gfc_match_omp_declare_variant (void)
for (gfc_omp_namelist *n = *head; n != NULL; n = n->next)
n->u.need_device_ptr = true;
}
+ else if (ccode == append_args)
+ {
+ if (has_append_args)
+ {
+ gfc_error ("%qs clause at %L specified more than once",
+ "append_args", &gfc_current_locus);
+ return MATCH_ERROR;
+ }
+ has_append_args = true;
+ gfc_omp_namelist *append_args_last = NULL;
+ do
+ {
+ gfc_gobble_whitespace ();
+ if (gfc_match ("interop ") != MATCH_YES)
+ {
+ gfc_error ("expected %<interop%> at %C");
+ return MATCH_ERROR;
+ }
+ if (gfc_match ("( ") != MATCH_YES)
+ {
+ gfc_error ("expected %<(%> at %C");
+ return MATCH_ERROR;
+ }
+
+ bool target, targetsync;
+ char *type_str = NULL;
+ int type_str_len;
+ locus loc = gfc_current_locus;
+ if (gfc_parser_omp_clause_init_modifiers (target, targetsync,
+ &type_str, type_str_len,
+ false) == MATCH_ERROR)
+ return MATCH_ERROR;
+
+ gfc_omp_namelist *n = gfc_get_omp_namelist();
+ n->where = loc;
+ n->u.init.target = target;
+ n->u.init.targetsync = targetsync;
+ n->u.init.len = type_str_len;
+ n->u2.init_interop = type_str;
+ if (odv->append_args_list)
+ {
+ append_args_last->next = n;
+ append_args_last = n;
+ }
+ else
+ append_args_last = odv->append_args_list = n;
+
+ gfc_gobble_whitespace ();
+ if (gfc_match_char (',') == MATCH_YES)
+ continue;
+ if (gfc_match_char (')') == MATCH_YES)
+ break;
+ gfc_error ("Expected %<,%> or %<)%> at %C");
+ return MATCH_ERROR;
+ }
+ while (true);
+ }
+ gfc_gobble_whitespace ();
+ if (gfc_match_omp_eos () == MATCH_YES)
+ break;
+ gfc_match_char (',');
}
- if (error_p || (!has_match && !has_adjust_args))
+ if (error_p || (!has_match && !has_adjust_args && !has_append_args))
{
- gfc_error ("expected %<match%> or %<adjust_args%> at %C");
+ gfc_error ("expected %<match%>, %<adjust_args%> or %<append_args%> at
%C");
return MATCH_ERROR;
}
- if (has_adjust_args && !has_match)
+ if ((has_adjust_args || has_append_args) && !has_match)
{
- gfc_error ("an %<adjust_args%> clause at %L can only be specified if the
"
+ gfc_error ("the %qs clause at %L can only be specified if the "
"%<dispatch%> selector of the construct selector set appears "
"in the %<match%> clause",
- &adjust_args_loc);
+ has_adjust_args ? "adjust_args" : "append_args",
+ has_adjust_args ? &adjust_args_loc : &append_args_loc);
return MATCH_ERROR;
}
diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc
index 5e5d01380967..f4a338078ebd 100644
--- a/gcc/fortran/trans-openmp.cc
+++ b/gcc/fortran/trans-openmp.cc
@@ -11337,6 +11337,34 @@ gfc_trans_omp_declare_variant (gfc_namespace *ns)
== NULL_TREE)
{
char err[256];
+ gfc_formal_arglist *last_arg = NULL, *extra_arg = NULL;
+ int nappend_args = 0;
+ if (odv->append_args_list)
+ {
+ gfc_formal_arglist *arg;
+ int nargs = 0;
+ for (arg = gfc_sym_get_dummy_args (ns->proc_name);
+ arg; arg = arg->next)
+ nargs++;
+
+ last_arg = gfc_sym_get_dummy_args (variant_proc_sym);
+ for (int i = 1 ; i < nargs && last_arg; i++)
+ last_arg = last_arg->next;
+ if (nargs == 0)
+ {
+ extra_arg = last_arg;
+ last_arg = NULL;
+ variant_proc_sym->formal = NULL;
+ }
+ else if (last_arg)
+ {
+ extra_arg = last_arg->next;
+ last_arg->next = NULL;
+ }
+ for (gfc_omp_namelist *n = odv->append_args_list; n != NULL;
+ n = n->next)
+ nappend_args++;
+ }
if (!gfc_compare_interfaces (ns->proc_name, variant_proc_sym,
variant_proc_sym->name, 0, 1,
err, sizeof (err), NULL, NULL))
@@ -11345,18 +11373,73 @@ gfc_trans_omp_declare_variant (gfc_namespace *ns)
"incompatible types: %s",
variant_proc_name, ns->proc_name->name,
&odv->where, err);
+ if (nappend_args)
+ inform (gfc_get_location (&odv->append_args_list->where),
+ "%<append_args%> clause implies that %qs has %d "
+ "dummy arguments of integer type with "
+ "%<omp_interop_kind%> kind", variant_proc_name,
+ nappend_args);
+ variant_proc_sym = NULL;
+ }
+ if (last_arg)
+ last_arg->next = extra_arg;
+ else if (extra_arg)
+ variant_proc_sym->formal = extra_arg;
+ locus *loc = (odv->adjust_args_list
+ ? &odv->append_args_list->where : &odv->where);
+ int nextra_arg = 0;
+ for (; extra_arg; extra_arg = extra_arg->next)
+ {
+ nextra_arg++;
+ if (!variant_proc_sym)
+ continue;
+ if (extra_arg->sym->ts.type != BT_INTEGER
+ || extra_arg->sym->ts.kind != gfc_index_integer_kind
+ || extra_arg->sym->attr.dimension
+ || extra_arg->sym->attr.codimension
+ || extra_arg->sym->attr.pointer
+ || extra_arg->sym->attr.allocatable
+ || extra_arg->sym->attr.proc_pointer)
+ {
+ gfc_error ("%qs at %L must be a nonpointer, "
+ "nonallocatable scalar integer dummy argument "
+ "of %<omp_interop_kind%> kind as it utilized "
+ "with the %<append_args%> clause at %L",
+ extra_arg->sym->name,
+ &extra_arg->sym->declared_at, loc);
+ variant_proc_sym = NULL;
+ }
+ if (extra_arg->sym->attr.optional)
+ {
+ gfc_error ("%qs at %L with OPTIONAL attribute "
+ "not support when utilized with the "
+ "%<append_args%> clause at %L",
+ extra_arg->sym->name,
+ &extra_arg->sym->declared_at, loc);
+ variant_proc_sym = NULL;
+ }
+ }
+ if (variant_proc_sym && nappend_args != nextra_arg)
+ {
+ gfc_error ("%qs at %L has %d but requires %d "
+ "%<omp_interop_kind%> kind dummy arguments as it "
+ "is utilized with the %<append_args%> clause at "
+ "%L", variant_proc_sym->name,
+ &variant_proc_sym->declared_at, nextra_arg,
+ nappend_args, loc);
variant_proc_sym = NULL;
}
}
- if (odv->adjust_args_list != NULL
+ if ((odv->adjust_args_list != NULL || odv->append_args_list != NULL)
&& omp_get_context_selector (set_selectors,
OMP_TRAIT_SET_CONSTRUCT,
OMP_TRAIT_CONSTRUCT_DISPATCH)
== NULL_TREE)
{
- gfc_error ("an %<adjust_args%> clause can only be specified if "
+ gfc_error ("the %qs clause can only be specified if "
"the %<dispatch%> selector of the construct "
"selector set appears in the %<match%> clause at %L",
+ odv->adjust_args_list ? "adjust_args" : "append_args",
&odv->where);
variant_proc_sym = NULL;
}
@@ -11372,15 +11455,13 @@ gfc_trans_omp_declare_variant (gfc_namespace *ns)
if (omp_context_selector_matches (set_selectors,
NULL_TREE, false))
{
+ tree need_device_ptr_list = NULL_TREE;
+ tree append_args_tree = NULL_TREE;
tree id = get_identifier ("omp declare variant base");
tree variant = gfc_get_symbol_decl (variant_proc_sym);
DECL_ATTRIBUTES (base_fn_decl)
= tree_cons (id, build_tree_list (variant, set_selectors),
DECL_ATTRIBUTES (base_fn_decl));
-
- // Handle adjust_args
- tree need_device_ptr_list = make_node (TREE_LIST);
- vec<gfc_symbol *> adjust_args_list = vNULL;
int arg_idx_offset = 0;
if (gfc_return_by_reference (ns->proc_name))
{
@@ -11388,6 +11469,56 @@ gfc_trans_omp_declare_variant (gfc_namespace *ns)
if (ns->proc_name->ts.type == BT_CHARACTER)
arg_idx_offset++;
}
+ if (odv->append_args_list)
+ {
+ int append_arg_no = arg_idx_offset;
+ gfc_formal_arglist *arg;
+ for (arg = gfc_sym_get_dummy_args (ns->proc_name); arg;
+ arg = arg->next)
+ append_arg_no++;
+ tree last_arg = NULL_TREE;
+ for (gfc_omp_namelist *n = odv->append_args_list;
+ n != NULL; n = n->next)
+ {
+ tree pref = NULL_TREE;
+ if (n->u.init.len)
+ {
+ tree pref = build_string (n->u.init.len,
+ n->u2.init_interop);
+ TREE_TYPE (pref) = build_array_type_nelts (
+ unsigned_char_type_node,
+ n->u.init.len);
+ }
+ /* Save location, (target + target sync) and
+ prefer_type list in a tree list. */
+ tree t = build_tree_list (n->u.init.target
+ ? boolean_true_node
+ : boolean_false_node,
+ n->u.init.targetsync
+ ? boolean_true_node
+ : boolean_false_node);
+ t = build1_loc (gfc_get_location (&n->where),
+ NOP_EXPR, void_type_node, t);
+ t = build_tree_list (t, pref);
+ if (append_args_tree)
+ {
+ TREE_CHAIN (last_arg) = t;
+ last_arg = t;
+ }
+ else
+ append_args_tree = last_arg = t;
+ }
+ /* Store as (purpose = arg number to be used for inserting
+ and value = list of interop items. */
+ append_args_tree = build_tree_list (
+ build_int_cst (integer_type_node,
+ append_arg_no),
+ append_args_tree);
+ }
+
+ if (odv->adjust_args_list)
+ need_device_ptr_list = make_node (TREE_LIST);
+ vec<gfc_symbol *> adjust_args_list = vNULL;
for (gfc_omp_namelist *arg_list = odv->adjust_args_list;
arg_list != NULL; arg_list = arg_list->next)
{
@@ -11425,12 +11556,16 @@ gfc_trans_omp_declare_variant (gfc_namespace *ns)
idx + arg_idx_offset)));
}
}
-
- DECL_ATTRIBUTES (variant) = tree_cons (
- get_identifier ("omp declare variant variant args"),
- build_tree_list (need_device_ptr_list,
- NULL_TREE /*need_device_addr */),
- DECL_ATTRIBUTES (variant));
+ tree t = NULL_TREE;
+ if (need_device_ptr_list || append_args_tree)
+ {
+ t = build_tree_list (need_device_ptr_list,
+ NULL_TREE /*need_device_addr */),
+ TREE_CHAIN (t) = append_args_tree;
+ DECL_ATTRIBUTES (variant) = tree_cons (
+ get_identifier ("omp declare variant variant args"), t,
+ DECL_ATTRIBUTES (variant));
+ }
}
}
}
diff --git a/gcc/gimplify.cc b/gcc/gimplify.cc
index 58952f143455..1dce579cbbcb 100644
--- a/gcc/gimplify.cc
+++ b/gcc/gimplify.cc
@@ -4342,9 +4342,20 @@ gimplify_call_expr (tree *expr_p, gimple_seq *pre_p,
fallback_t fallback)
bool returns_twice = call_expr_flags (*expr_p) & ECF_RETURNS_TWICE;
tree dispatch_device_num = NULL_TREE;
- tree dispatch_interop = NULL_TREE;
- tree dispatch_append_args = NULL_TREE;
tree dispatch_adjust_args_list = NULL_TREE;
+ /* OpenMP: Handle the append_args and adjust_args clauses of declare_variant.
+ This is active if enclosed in 'omp dispatch' but only for the outermost
+ function call, which is therefore enclosed in IFN_GOMP_DISPATCH.
+
+ 'append_args' cause's interop objects are added after the last regular
+ (nonhidden, nonvariadic) arguments of the variant function.
+ 'adjust_args' with need_device_{addr,ptr} converts the pointer target of
+ a pointer from a host to a device address. This uses either the default
+ device or the passed device number, which then sets the default device
+ address.
+
+ FIXME: This code should be moved into an extra function,
+ cf. above + PR118457. */
if (flag_openmp
&& omp_dispatch_p
&& gimplify_omp_ctxp != NULL
@@ -4353,6 +4364,9 @@ gimplify_call_expr (tree *expr_p, gimple_seq *pre_p,
fallback_t fallback)
&& EXPR_P (CALL_EXPR_FN (*expr_p))
&& DECL_P (TREE_OPERAND (CALL_EXPR_FN (*expr_p), 0)))
{
+ tree dispatch_interop = NULL_TREE;
+ tree dispatch_append_args = NULL_TREE;
+ int nfirst_args = 0;
if (variant_substituted_p)
dispatch_adjust_args_list
= lookup_attribute ("omp declare variant variant args",
@@ -4365,6 +4379,11 @@ gimplify_call_expr (tree *expr_p, gimple_seq *pre_p,
fallback_t fallback)
&& TREE_VALUE (dispatch_adjust_args_list) == NULL_TREE)
dispatch_adjust_args_list = NULL_TREE;
}
+ if (dispatch_append_args)
+ {
+ nfirst_args = tree_to_shwi (TREE_PURPOSE (dispatch_append_args));
+ dispatch_append_args = TREE_VALUE (dispatch_append_args);
+ }
dispatch_device_num = omp_find_clause (gimplify_omp_ctxp->clauses,
OMP_CLAUSE_DEVICE);
if (dispatch_device_num)
@@ -4402,7 +4421,7 @@ gimplify_call_expr (tree *expr_p, gimple_seq *pre_p,
fallback_t fallback)
"%<declare variant%> candidate %qD",
ninterop, nappend, fndecl);
inform (dispatch_append_args
- ? OMP_CLAUSE_LOCATION (dispatch_append_args)
+ ? EXPR_LOCATION (TREE_PURPOSE (dispatch_append_args))
: DECL_SOURCE_LOCATION (fndecl),
"%<declare variant%> candidate %qD declared here",
fndecl);
@@ -4417,34 +4436,76 @@ gimplify_call_expr (tree *expr_p, gimple_seq *pre_p,
fallback_t fallback)
}
if (dispatch_append_args && nappend != ninterop)
{
- sorry_at (OMP_CLAUSE_LOCATION (dispatch_append_args),
- "%<append_args%> clause not yet supported for %qD", fndecl);
+ sorry_at (EXPR_LOCATION (TREE_PURPOSE (dispatch_append_args)),
+ "%<append_args%> clause not yet supported for %qD, except "
+ "when specifying all %d objects in the %<interop%> clause "
+ "of the %<dispatch%> directive", fndecl, nappend);
inform (gimplify_omp_ctxp->location,
"required by %<dispatch%> construct");
}
else if (dispatch_append_args)
{
- // Append interop objects
- int last_arg = 0;
- for (tree t = TYPE_ARG_TYPES (TREE_TYPE (fndecl));
- t && TREE_VALUE(t) != void_type_node; t = TREE_CHAIN (t))
- last_arg++;
- last_arg = last_arg - nappend;
-
- int nvariadic = nargs - last_arg;
- nargs = last_arg + nappend + nvariadic;
- tree *buffer = XALLOCAVEC (tree, nargs);
+ tree *buffer = XALLOCAVEC (tree, nargs + nappend);
+ tree arg = TYPE_ARG_TYPES (TREE_TYPE (fndecl));
+ /* Copy the first arguments; insert then the interop objects,
+ and then copy the rest (nargs - nfirst_args) args. */
int i;
- for (i = 0; i < last_arg; i++)
- buffer[i] = CALL_EXPR_ARG (*expr_p, i);
+ for (i = 0; i < nfirst_args; i++)
+ {
+ arg = TREE_CHAIN (arg);
+ buffer[i] = CALL_EXPR_ARG (*expr_p, i);
+ }
int j = nappend;
for (tree t = dispatch_interop;
t; t = TREE_CHAIN (t))
if (OMP_CLAUSE_CODE (t) == OMP_CLAUSE_INTEROP)
buffer[i + --j] = OMP_CLAUSE_DECL (t);
+ gcc_checking_assert (j == 0);
+ for (j = 0; j < nappend; j++)
+ {
+ /* Fortran permits by-reference or by-value for the dummy arg
+ and by-value, by-reference, ptr by-reference as actual
+ argument. Handle this. */
+ tree obj = buffer[i + j]; // interop object
+ tree a2 = TREE_VALUE (arg); // parameter type
+ if (POINTER_TYPE_P (TREE_TYPE (obj))
+ && POINTER_TYPE_P (TREE_TYPE (TREE_TYPE (obj))))
+ {
+ gcc_checking_assert (INTEGRAL_TYPE_P (
+ TREE_TYPE (TREE_TYPE (TREE_TYPE (obj)))));
+ obj = fold_build1 (INDIRECT_REF,
+ TREE_TYPE (TREE_TYPE (obj)), obj);
+ }
+ if (POINTER_TYPE_P (TREE_TYPE (obj))
+ && INTEGRAL_TYPE_P (a2))
+ {
+ gcc_checking_assert (INTEGRAL_TYPE_P (
+ TREE_TYPE (TREE_TYPE (obj))));
+ obj = fold_build1 (INDIRECT_REF,
+ TREE_TYPE (TREE_TYPE (obj)), obj);
+ }
+ else if (INTEGRAL_TYPE_P (TREE_TYPE (obj))
+ && POINTER_TYPE_P (a2))
+ {
+ gcc_checking_assert (INTEGRAL_TYPE_P (TREE_TYPE (a2)));
+ obj = build_fold_addr_expr (obj);
+ }
+ else if (!INTEGRAL_TYPE_P (a2)
+ || !INTEGRAL_TYPE_P (TREE_TYPE (obj)))
+ {
+ gcc_checking_assert (
+ POINTER_TYPE_P (TREE_TYPE (obj))
+ && POINTER_TYPE_P (a2)
+ && INTEGRAL_TYPE_P (TREE_TYPE (TREE_TYPE (obj)))
+ && INTEGRAL_TYPE_P (TREE_TYPE (a2)));
+ }
+ buffer[i + j] = obj;
+ arg = TREE_CHAIN (arg);
+ }
i += nappend;
- for (j = last_arg; j < last_arg + nvariadic; j++)
+ for (j = nfirst_args; j < nargs; j++)
buffer[i++] = CALL_EXPR_ARG (*expr_p, j);
+ nargs += nappend;
tree call = *expr_p;
*expr_p = build_call_array_loc (loc, TREE_TYPE (call),
CALL_EXPR_FN (call),
@@ -4462,8 +4523,6 @@ gimplify_call_expr (tree *expr_p, gimple_seq *pre_p,
fallback_t fallback)
is_gimple_call_addr, fb_rvalue);
if (ret == GS_ERROR)
return GS_ERROR;
- nargs = call_expr_nargs (*expr_p);
- fndecl = get_callee_fndecl (*expr_p);
/* Mark as already processed. */
if (dispatch_interop)
diff --git a/gcc/testsuite/ChangeLog.omp b/gcc/testsuite/ChangeLog.omp
index 46ed6b38a8da..c6d70fadbb1c 100644
--- a/gcc/testsuite/ChangeLog.omp
+++ b/gcc/testsuite/ChangeLog.omp
@@ -1,3 +1,28 @@
+2025-01-30 Tobias Burnus <tbur...@baylibre.com>
+
+ Backported from master:
+ 2025-01-30 Tobias Burnus <tbur...@baylibre.com>
+
+ * c-c++-common/gomp/append-args-1.c: Update dg-*.
+ * c-c++-common/gomp/append-args-3.c: Likewise.
+ * g++.dg/gomp/append-args-1.C: Likewise.
+ * gfortran.dg/gomp/adjust-args-1.f90: Likewise.
+ * gfortran.dg/gomp/adjust-args-3.f90: Likewise.
+ * gfortran.dg/gomp/declare-variant-2.f90: Likewise.
+ * c-c++-common/gomp/append-args-6.c: New test.
+ * c-c++-common/gomp/append-args-7.c: New test.
+ * c-c++-common/gomp/append-args-8.c: New test.
+ * c-c++-common/gomp/append-args-9.c: New test.
+ * g++.dg/gomp/append-args-4.C: New test.
+ * g++.dg/gomp/append-args-5.C: New test.
+ * g++.dg/gomp/append-args-6.C: New test.
+ * g++.dg/gomp/append-args-7.C: New test.
+ * gcc.dg/gomp/append-args-1.c: New test.
+ * gfortran.dg/gomp/append_args-1.f90: New test.
+ * gfortran.dg/gomp/append_args-2.f90: New test.
+ * gfortran.dg/gomp/append_args-3.f90: New test.
+ * gfortran.dg/gomp/append_args-4.f90: New test.
+
2025-01-28 Tobias Burnus <tbur...@baylibre.com>
Backported from master:
diff --git a/gcc/testsuite/c-c++-common/gomp/append-args-1.c
b/gcc/testsuite/c-c++-common/gomp/append-args-1.c
index e58796e505eb..e3c31c2efc3f 100644
--- a/gcc/testsuite/c-c++-common/gomp/append-args-1.c
+++ b/gcc/testsuite/c-c++-common/gomp/append-args-1.c
@@ -24,34 +24,50 @@ float base0();
float repl1(omp_interop_t, omp_interop_t);
#pragma omp declare variant(repl1) match(construct={dispatch})
append_args(interop(target), interop(targetsync))
float base1();
-/* { dg-message "sorry, unimplemented: 'append_args' clause not yet supported
for 'repl1'" "" { target c } .-2 } */
-/* { dg-message "sorry, unimplemented: 'append_args' clause not yet supported
for 'float repl1\\(omp_interop_t, omp_interop_t\\)'" "" { target c++ } .-3 } */
+/* { dg-message "sorry, unimplemented: 'append_args' clause not yet supported
for 'repl1', except when specifying all 2 objects in the 'interop' clause of
the 'dispatch' directive" "" { target c } .-2 } */
+/* { dg-message "sorry, unimplemented: 'append_args' clause not yet supported
for 'float repl1\\(omp_interop_t, omp_interop_t\\)', except when specifying all
2 objects in the 'interop' clause of the 'dispatch' directive" "" { target c++
} .-3 } */
void repl2(int *, int *, omp_interop_t, omp_interop_t);
#pragma omp declare variant(repl2) match(construct={dispatch})
adjust_args(need_device_ptr : y) \
append_args(interop(target, targetsync, prefer_type(1)), \
interop(prefer_type({fr(3),
attr("ompx_nop")},{fr(2)},{attr("ompx_all")})))
void base2(int *x, int *y);
-/* { dg-message "sorry, unimplemented: 'append_args' clause not yet supported
for 'repl2'" "" { target c } .-3 } */
-/* { dg-message "sorry, unimplemented: 'append_args' clause not yet supported
for 'void repl2\\(int\\*, int\\*, omp_interop_t, omp_interop_t\\)'" "" { target
c++ } .-4 } */
+/* { dg-message "sorry, unimplemented: 'append_args' clause not yet supported
for 'repl2', except when specifying all 2 objects in the 'interop' clause of
the 'dispatch' directive" "" { target c } .-3 } */
+/* { dg-message "sorry, unimplemented: 'append_args' clause not yet supported
for 'void repl2\\(int\\*, int\\*, omp_interop_t, omp_interop_t\\)', except when
specifying all 2 objects in the 'interop' clause of the 'dispatch' directive"
"" { target c++ } .-4 } */
void repl3(int, omp_interop_t, ...);
#pragma omp declare variant(repl3) match(construct={dispatch}) \
append_args(interop(prefer_type("cuda", "hsa")))
void base3(int, ...);
-/* { dg-message "sorry, unimplemented: 'append_args' clause not yet supported
for 'repl3'" "" { target c } .-2 } */
-/* { dg-message "sorry, unimplemented: 'append_args' clause not yet supported
for 'void repl3\\(int, omp_interop_t, \\.\\.\\.\\)'" "" { target c++ } .-3 } */
+/* { dg-message "sorry, unimplemented: 'append_args' clause not yet supported
for 'repl3', except when specifying all 1 objects in the 'interop' clause of
the 'dispatch' directive" "" { target c } .-2 } */
+/* { dg-message "sorry, unimplemented: 'append_args' clause not yet supported
for 'void repl3\\(int, omp_interop_t, \\.\\.\\.\\)', except when specifying all
1 objects in the 'interop' clause of the 'dispatch' directive" "" { target c++
} .-3 } */
/* { dg-note "'declare variant' candidate 'repl3' declared here" "" { target c
} .-4 } */
/* { dg-note "'declare variant' candidate 'void repl3\\(int, omp_interop_t,
\\.\\.\\.\\)' declared here" "" { target c++ } .-5 } */
float repl4(short, short, omp_interop_t, short);
#pragma omp declare variant(repl4) match(construct={dispatch})
append_args(interop(target)) append_args(interop(targetsync)) /* { dg-error
"too many 'append_args' clauses" } */
float base4(short, short);
-/* { dg-error "argument 4 of 'repl4' must be of 'omp_interop_t'" "" { target c
} .-3 } */
-/* { dg-error "argument 4 of 'float repl4\\(short int, short int,
omp_interop_t, short int\\)' must be of 'omp_interop_t'" "" { target c++ } .-4
} */
+/* { dg-error "variant 'repl4' and base 'base4' have incompatible types" "" {
target c } .-2 } */
+/* { dg-error "too few arguments to function 'float repl4\\(short int, short
int, omp_interop_t, short int\\)'" "" { target c++ } .-3 } */
+/* { dg-note "declared here" "" { target c++ } .-5 } */
+
+
+float repl5(short, short, omp_interop_t, short);
+#pragma omp declare variant(repl5) match(construct={dispatch})
append_args(interop(target),interop(targetsync))
+float base5(short, short);
+/* { dg-error "argument 4 of 'repl5' must be of 'omp_interop_t'" "" { target c
} .-3 } */
+/* { dg-error "argument 4 of 'float repl5\\(short int, short int,
omp_interop_t, short int\\)' must be of 'omp_interop_t'" "" { target c++ } .-4
} */
/* { dg-note "'append_args' specified here" "" { target *-*-* } .-4 } */
+float repl6(short, short, omp_interop_t, short);
+#pragma omp declare variant(repl6) match(construct={dispatch})
append_args(interop(target))
+float base6(short, short);
+/* { dg-error "variant 'repl6' and base 'base6' have incompatible types" "" {
target c } .-2 } */
+/* { dg-error "too few arguments to function 'float repl6\\(short int, short
int, omp_interop_t, short int\\)'" "" { target c++ } .-3 } */
+/* { dg-note "declared here" "" { target c++ } .-5 } */
+
+
float
test (int *a, int *b)
{
diff --git a/gcc/testsuite/c-c++-common/gomp/append-args-3.c
b/gcc/testsuite/c-c++-common/gomp/append-args-3.c
index 7e08a2df9bb2..eaa42c4738d9 100644
--- a/gcc/testsuite/c-c++-common/gomp/append-args-3.c
+++ b/gcc/testsuite/c-c++-common/gomp/append-args-3.c
@@ -52,9 +52,9 @@ void varvar1(int, int, omp_interop_t, ...);
#pragma omp declare variant(varvar1) match(construct={dispatch})
append_args(interop(target,targetsync))
void varbase1(int x, int y, ...);
-void varvar2(int, int *, omp_interop_t, ...);
+void varvar2(int, int *, omp_interop_t, ...) { }
#pragma omp declare variant(varvar2) match(construct={dispatch})
append_args(interop(target,targetsync)) adjust_args(need_device_ptr: y)
-void varbase2(int x, int *y, ...);
+void varbase2(int x, int *y, ...) { }
void bar()
diff --git a/gcc/testsuite/c-c++-common/gomp/append-args-6.c
b/gcc/testsuite/c-c++-common/gomp/append-args-6.c
new file mode 100644
index 000000000000..d96e5a1e2684
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/append-args-6.c
@@ -0,0 +1,106 @@
+/* { dg-additional-options "-fdump-tree-gimple" } */
+
+#if __cplusplus >= 201103L
+# define __GOMP_UINTPTR_T_ENUM : __UINTPTR_TYPE__
+#else
+# define __GOMP_UINTPTR_T_ENUM
+#endif
+
+typedef enum omp_interop_t __GOMP_UINTPTR_T_ENUM
+{
+ omp_interop_none = 0,
+ __omp_interop_t_max__ = __UINTPTR_MAX__
+} omp_interop_t;
+
+typedef enum omp_interop_fr_t
+{
+ omp_ifr_cuda = 1,
+ omp_ifr_cuda_driver = 2,
+ omp_ifr_opencl = 3,
+ omp_ifr_sycl = 4,
+ omp_ifr_hip = 5,
+ omp_ifr_level_zero = 6,
+ omp_ifr_hsa = 7,
+ omp_ifr_last = omp_ifr_hsa
+} omp_interop_fr_t;
+
+
+
+void g(int, const char *, int *, int *, omp_interop_t, omp_interop_t) { }
+#pragma omp declare variant(g) match(construct={dispatch}) \
+ append_args(interop(target,prefer_type( {fr("cuda") }, {fr(omp_ifr_hsa)} ,
{attr("ompx_a") } , {fr(omp_ifr_hip) }), targetsync), \
+ interop(targetsync, prefer_type("cuda", "hsa")))
adjust_args(need_device_ptr : y, k)
+void f(int x, const char *y, int *, int *k) { }
+
+
+void gvar(int, const char *, int *, int *, omp_interop_t, omp_interop_t, ...)
{ }
+#pragma omp declare variant(gvar) match(construct={dispatch}) \
+ append_args(interop(target,prefer_type( {fr("cuda") }, {fr(omp_ifr_hsa)} ,
{attr("ompx_a") } , {fr(omp_ifr_hip) }), targetsync), \
+ interop(targetsync, prefer_type("cuda", "hsa")))
adjust_args(need_device_ptr : y, k)
+void fvar(int x, const char *y, int *, int *k, ...) { }
+
+
+
+void foo(const char *cp1, const char *cp2, int *a, int *b, int *c)
+{
+ omp_interop_t obj1, obj2, obj3, obj4;
+ obj1 = obj2 = obj3 = obj4 = omp_interop_none;
+
+ #pragma omp dispatch device(5) interop(obj1,obj2) is_device_ptr(cp1)
+ f(3, cp1, a, b);
+
+ #pragma omp dispatch device(4) interop(obj3,obj4) is_device_ptr(a,b,c)
+ fvar(99, cp2, a, b, c, a, b, c, a, b, c);
+}
+
+
+
+
+int *fi();
+
+struct t {
+ int *a, *b;
+};
+
+void fancy(int *x, int *y, omp_interop_t) { }
+
+#pragma omp declare variant(fancy) match(construct={dispatch})
adjust_args(need_device_ptr: x,y) \
+ append_args( interop (prefer_type(omp_ifr_hip), target) )
+void bar(int *x, int *y);
+
+void sub(struct t *s, void *y, const omp_interop_t obj5, omp_interop_t obj6)
+{
+ bar( fi(), s->b);
+
+ // This is a bit questionable as dereferencing 's' as device pointer might
not work (unspecified behavior);
+ // but if for 's->b' it would still be need even if 's' was a device + host
accessible pointer.
+ #pragma omp dispatch device(3) is_device_ptr(s) interop(obj5)
+ bar( fi(), s->b);
+
+ bar( (int *) y, s->b);
+ #pragma omp dispatch interop(obj6) is_device_ptr(y)
+ bar( (int *) y, s->b);
+}
+
+
+/* { dg-final { scan-tree-dump-times "D\.\[0-9\]+ =
__builtin_omp_get_default_device \\(\\);" 4 "gimple" } } */
+
+/* { dg-final { scan-tree-dump-times "D\.\[0-9\]+ =
__builtin_omp_get_interop_int \\(obj6, -5, 0B\\);" 1 "gimple" } } */
+
+/* { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device
\\(5\\);" 1 "gimple" } } */
+/* { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device
\\(4\\);" 1 "gimple" } } */
+/* { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device
\\(3\\);" 1 "gimple" } } */
+/* { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device
\\(D\.\[0-9\]+\\);" 5 "gimple" } } */
+
+/* { dg-final { scan-tree-dump-times "D\.\[0-9\]+ =
__builtin_omp_get_mapped_ptr \\(b, 5\\);" 1 "gimple" } } */
+/* { dg-final { scan-tree-dump-times "D\.\[0-9\]+ =
__builtin_omp_get_mapped_ptr \\(cp2, 4\\);" 1 "gimple" } } */
+/* { dg-final { scan-tree-dump-times "D\.\[0-9\]+ =
__builtin_omp_get_mapped_ptr \\(cp2, 4\\);" 1 "gimple" } } */
+/* { dg-final { scan-tree-dump-times "D\.\[0-9\]+ =
__builtin_omp_get_mapped_ptr \\(cp2, 4\\);" 1 "gimple" } } */
+/* { dg-final { scan-tree-dump-times "D\.\[0-9\]+ =
__builtin_omp_get_mapped_ptr \\(D\.\[0-9\]+, 3\\);" 2 "gimple" } } */
+/* { dg-final { scan-tree-dump-times "D\.\[0-9\]+ =
__builtin_omp_get_mapped_ptr \\(D\.\[0-9\]+, D\.\[0-9\]+\\);" 1 "gimple" } } */
+
+/* { dg-final { scan-tree-dump-times "g \\(3, cp1, a, D\.\[0-9\]+, obj1,
obj2\\);" 1 "gimple" } } */
+/* { dg-final { scan-tree-dump-times "gvar \\(99, D\.\[0-9\]+, a, b, obj3,
obj4, c, a, b, c, a, b, c\\);" 1 "gimple" } } */
+
+/* { dg-final { scan-tree-dump-times "fancy \\(D\.\[0-9\]+, D\.\[0-9\]+,
obj5\\);" 1 "gimple" } } */
+/* { dg-final { scan-tree-dump-times "fancy \\(y, D\.\[0-9\]+, obj6\\);" 1
"gimple" } } */
diff --git a/gcc/testsuite/c-c++-common/gomp/append-args-7.c
b/gcc/testsuite/c-c++-common/gomp/append-args-7.c
new file mode 100644
index 000000000000..b7dff8a2cb07
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/append-args-7.c
@@ -0,0 +1,47 @@
+/* { dg-additional-options "-fdump-tree-gimple" } */
+
+#if __cplusplus >= 201103L
+# define __GOMP_UINTPTR_T_ENUM : __UINTPTR_TYPE__
+#else
+# define __GOMP_UINTPTR_T_ENUM
+#endif
+
+typedef enum omp_interop_t __GOMP_UINTPTR_T_ENUM
+{
+ omp_interop_none = 0,
+ __omp_interop_t_max__ = __UINTPTR_MAX__
+} omp_interop_t;
+
+void f1(...) { }
+#pragma omp declare variant(f1) match(construct={dispatch})
+void g1(...) { }
+
+
+void f2(...) { }
+/* { dg-error "argument 1 of 'f2' must be of 'omp_interop_t'" "" { target c }
.-1 } */
+/* { dg-error "argument 1 of 'void f2\\(\\.\\.\\.\\)' must be of
'omp_interop_t'" "" { target c++ } .-2 } */
+#pragma omp declare variant(f2) append_args(interop(target),
interop(prefer_type("cuda"))) \
+ match(construct={dispatch})
+void g2(...) { }
+/* { dg-note "'append_args' specified here" "" { target *-*-* } .-3 } */
+
+
+void f3(omp_interop_t, omp_interop_t, ...) { }
+#pragma omp declare variant(f3) append_args(interop(target),
interop(prefer_type("cuda"))) \
+ match(construct={dispatch})
+void g3(...) { }
+
+
+void foo (int *a, char *cp, int d) {
+ omp_interop_t obj1 = omp_interop_none;
+ omp_interop_t obj2 = omp_interop_none;
+ #pragma omp dispatch interop(obj1, obj2) device(22)
+ g3(1, a, cp, d);
+}
+
+/* { dg-final { scan-tree-dump-times "D\.\[0-9\]+ =
__builtin_omp_get_default_device \\(\\);" 1 "gimple" } } */
+
+/* { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device
\\(22\\);" 1 "gimple" } } */
+/* { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device
\\(D\.\[0-9\]+\\);" 1 "gimple" } } */
+
+/* { dg-final { scan-tree-dump-times "f3 \\(obj1, obj2, 1, a, cp, d\\);" 1
"gimple" } } */
diff --git a/gcc/testsuite/c-c++-common/gomp/append-args-8.c
b/gcc/testsuite/c-c++-common/gomp/append-args-8.c
new file mode 100644
index 000000000000..fb442db4ae4a
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/append-args-8.c
@@ -0,0 +1,53 @@
+/* { dg-additional-options "-fdump-tree-gimple" } */
+
+#if __cplusplus >= 201103L
+# define __GOMP_UINTPTR_T_ENUM : __UINTPTR_TYPE__
+#else
+# define __GOMP_UINTPTR_T_ENUM
+#endif
+
+typedef enum omp_interop_t __GOMP_UINTPTR_T_ENUM
+{
+ omp_interop_none = 0,
+ __omp_interop_t_max__ = __UINTPTR_MAX__
+} omp_interop_t;
+
+void f1(omp_interop_t) { }
+#pragma omp declare variant(f1) match(construct={dispatch}) \
+
append_args(interop(prefer_type({attr("ompx_fun")})))
+void g1(void);
+
+
+int f2(omp_interop_t, omp_interop_t);
+#pragma omp declare variant(f2) append_args(interop(prefer_type("cuda")), \
+
interop(prefer_type({fr("hsa")}),target)) \
+ match(construct={dispatch})
+int g2(void) { return 5; }
+
+int foo (omp_interop_t obj1)
+{
+ omp_interop_t obj2 = omp_interop_none;
+ int res;
+
+ #pragma omp dispatch interop(obj1) device(11)
+ g1();
+
+ #pragma omp dispatch interop(obj1, obj2) device(22)
+ g2();
+
+ #pragma omp dispatch interop(obj2, obj1) device(33)
+ res = g2();
+
+ return res;
+}
+
+/* { dg-final { scan-tree-dump-times "D\.\[0-9\]+ =
__builtin_omp_get_default_device \\(\\);" 3 "gimple" } } */
+
+/* { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device
\\(11\\);" 1 "gimple" } } */
+/* { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device
\\(22\\);" 1 "gimple" } } */
+/* { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device
\\(33\\);" 1 "gimple" } } */
+/* { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device
\\(D\.\[0-9\]+\\);" 3 "gimple" } } */
+
+/* { dg-final { scan-tree-dump-times " f1 \\(obj1\\);" 1 "gimple" } } */
+/* { dg-final { scan-tree-dump-times " f2 \\(obj1, obj2\\);" 1 "gimple" } }
*/
+/* { dg-final { scan-tree-dump-times " res = f2 \\(obj2, obj1\\);" 1 "gimple"
} } */
diff --git a/gcc/testsuite/c-c++-common/gomp/append-args-9.c
b/gcc/testsuite/c-c++-common/gomp/append-args-9.c
new file mode 100644
index 000000000000..b8586e0f54a9
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/append-args-9.c
@@ -0,0 +1,34 @@
+#if __cplusplus >= 201103L
+# define __GOMP_UINTPTR_T_ENUM : __UINTPTR_TYPE__
+#else
+# define __GOMP_UINTPTR_T_ENUM
+#endif
+
+typedef enum omp_interop_t __GOMP_UINTPTR_T_ENUM
+{
+ omp_interop_none = 0,
+ __omp_interop_t_max__ = __UINTPTR_MAX__
+} omp_interop_t;
+
+void f1(omp_interop_t *) { }
+/* { dg-error "argument 1 of 'f1' must be of 'omp_interop_t'" "" { target c }
.-1 } */
+/* { dg-note "initializing argument 1 of 'void f1\\(omp_interop_t\\*\\)'" "" {
target c++ } .-2 } */
+#pragma omp declare variant(f1) match(construct={dispatch}) \
+
append_args(interop(prefer_type({attr("ompx_fun")})))
+void g1(void);
+/* { dg-note "'append_args' specified here" "" { target c } .-2 } */
+/* { dg-error "cannot convert 'omp_interop_t' to 'omp_interop_t\\*'" "" {
target c++ } .-4 } */
+
+int f2(omp_interop_t);
+#pragma omp declare variant(f2) append_args(interop(prefer_type("cuda"))) \
+ match(construct={dispatch})
+int g2(void) { return 5; }
+
+int foo (omp_interop_t *obj1)
+{
+ int res;
+
+ #pragma omp dispatch interop(obj1) device(11) /* { dg-error "'obj1' must be
of 'omp_interop_t'" } */
+ res = g2();
+ return res;
+}
diff --git a/gcc/testsuite/g++.dg/gomp/append-args-1.C
b/gcc/testsuite/g++.dg/gomp/append-args-1.C
index 427c64077964..1f0a72447563 100644
--- a/gcc/testsuite/g++.dg/gomp/append-args-1.C
+++ b/gcc/testsuite/g++.dg/gomp/append-args-1.C
@@ -20,8 +20,8 @@ template<typename T>
float base1(T);
-/* { dg-message "sorry, unimplemented: 'append_args' clause not yet supported
for 'float repl1\\(T, T2, T2\\) \\\[with T = omp_interop_t; T2 =
omp_interop_t\\\]'" "" { target *-*-* } .-5 } */
-/* { dg-message "sorry, unimplemented: 'append_args' clause not yet supported
for 'float repl1\\(T, T2, T2\\) \\\[with T = float; T2 = omp_interop_t\\\]'" ""
{ target *-*-* } .-6 } */
+/* { dg-message "sorry, unimplemented: 'append_args' clause not yet supported
for 'float repl1\\(T, T2, T2\\) \\\[with T = omp_interop_t; T2 =
omp_interop_t\\\]', except when specifying all 2 objects in the 'interop'
clause of the 'dispatch' directive" "" { target *-*-* } .-5 } */
+/* { dg-message "sorry, unimplemented: 'append_args' clause not yet supported
for 'float repl1\\(T, T2, T2\\) \\\[with T = float; T2 = omp_interop_t\\\]',
except when specifying all 2 objects in the 'interop' clause of the 'dispatch'
directive" "" { target *-*-* } .-6 } */
@@ -45,7 +45,7 @@ void repl99(T);
append_args(interop(target, targetsync, prefer_type("cuda")))
void base99();
-/* { dg-message "sorry, unimplemented: 'append_args' clause not yet supported
for 'void repl99\\(T\\) \\\[with T = omp_interop_t\\\]'" "" { target *-*-* }
.-3 } */
+/* { dg-message "sorry, unimplemented: 'append_args' clause not yet supported
for 'void repl99\\(T\\) \\\[with T = omp_interop_t\\\]', except when specifying
all 1 objects in the 'interop' clause of the 'dispatch' directive" "" { target
*-*-* } .-3 } */
@@ -57,8 +57,8 @@ void repl2(T, T2, T3, T3);
template<typename T, typename T2>
void base2(T x, T2 y);
-/* { dg-message "sorry, unimplemented: 'append_args' clause not yet supported
for 'void repl2\\(T, T2, T3, T3\\) \\\[with T = int\\*; T2 = int\\*; T3 =
omp_interop_t\\\]'" "" { target *-*-* } .-5 } */
-/* { dg-message "sorry, unimplemented: 'append_args' clause not yet supported
for 'void repl2\\(T, T2, T3, T3\\) \\\[with T = int\\*; T2 = omp_interop_t; T3
= omp_interop_t\\\]'" "" { target *-*-* } .-6 } */
+/* { dg-message "sorry, unimplemented: 'append_args' clause not yet supported
for 'void repl2\\(T, T2, T3, T3\\) \\\[with T = int\\*; T2 = int\\*; T3 =
omp_interop_t\\\]', except when specifying all 2 objects in the 'interop'
clause of the 'dispatch' directive" "" { target *-*-* } .-5 } */
+/* { dg-message "sorry, unimplemented: 'append_args' clause not yet supported
for 'void repl2\\(T, T2, T3, T3\\) \\\[with T = int\\*; T2 = omp_interop_t; T3
= omp_interop_t\\\]', except when specifying all 2 objects in the 'interop'
clause of the 'dispatch' directive" "" { target *-*-* } .-6 } */
template<typename T,typename T3>
@@ -83,7 +83,7 @@ void repl3(T, T2, ...);
template<typename T>
void base3(T, ...);
-/* { dg-message "sorry, unimplemented: 'append_args' clause not yet supported
for 'void repl3\\(T, T2, \.\.\.\\) \\\[with T = int\\*; T2 =
omp_interop_t\\\]'" "" { target *-*-* } .-4 } */
+/* { dg-message "sorry, unimplemented: 'append_args' clause not yet supported
for 'void repl3\\(T, T2, \.\.\.\\) \\\[with T = int\\*; T2 =
omp_interop_t\\\]', except when specifying all 1 objects in the 'interop'
clause of the 'dispatch' directive" "" { target *-*-* } .-4 } */
diff --git a/gcc/testsuite/g++.dg/gomp/append-args-4.C
b/gcc/testsuite/g++.dg/gomp/append-args-4.C
new file mode 100644
index 000000000000..bdae6f18fd31
--- /dev/null
+++ b/gcc/testsuite/g++.dg/gomp/append-args-4.C
@@ -0,0 +1,17 @@
+/* Check the error when 'omp_interop_t' is not defined and the variant function
+ is found via Argument-dependent lookup; in that case, 'g' is not yet
resolved
+ to a decl but is an indentifier node. Hence, the location is suboptimal, but
+ we get at least an error. */
+
+namespace N {
+ class C{
+ public:
+ };
+ void g(C *c);
+}
+
+#pragma omp declare variant (g) match (construct={dispatch}) adjust_args
(need_device_ptr: c) append_args (interop(target))
+void f3(N::C *c);
+
+/* { dg-error "30: argument 2 of 'g' must be of 'omp_interop_t'" "" { target
*-*-* } .-3 } */
+/* { dg-note "108: 'append_args' specified here" "" { target *-*-* } .-4 } */
diff --git a/gcc/testsuite/g++.dg/gomp/append-args-5.C
b/gcc/testsuite/g++.dg/gomp/append-args-5.C
new file mode 100644
index 000000000000..d5a3a78bb758
--- /dev/null
+++ b/gcc/testsuite/g++.dg/gomp/append-args-5.C
@@ -0,0 +1,72 @@
+/* { dg-additional-options "-fdump-tree-gimple" } */
+
+/* Check that adjust_args applies to the right argument,
+ if C++ inserts a 'this' pointer. */
+
+#if __cplusplus >= 201103L
+# define __GOMP_UINTPTR_T_ENUM : __UINTPTR_TYPE__
+#else
+# define __GOMP_UINTPTR_T_ENUM
+#endif
+
+typedef enum omp_interop_t __GOMP_UINTPTR_T_ENUM
+{
+ omp_interop_none = 0,
+ __omp_interop_t_max__ = __UINTPTR_MAX__
+} omp_interop_t;
+
+
+struct t1 {
+ void f1(int *x, int *y, int *z, omp_interop_t);
+ #pragma omp declare variant(f1) match(construct={dispatch}) \
+ adjust_args(need_device_ptr : y) \
+ append_args( interop(target))
+ void g1(int *x, int *y, int *z);
+};
+
+struct t2 {
+ void f2(int *x, int *y, int *z, omp_interop_t, ...);
+ #pragma omp declare variant(f2) match(construct={dispatch}) \
+ adjust_args(need_device_ptr : x, y, z) \
+ append_args(
interop(prefer_type("cuda","hip","hsa"),target, targetsync))
+ void g2(int *x, int *y, int *z, ...);
+};
+
+
+omp_interop_t obj1, obj2;
+
+void test(int *a1, int *b1, int *c1,
+ int *a2, int *b2, int *c2,
+ int *a3, int *b3, int *c3,
+ int *x1, int *x2, int *x3,
+ int *y1, int *y2, int *y3)
+{
+ struct t1 s1;
+ struct t2 s2;
+
+ #pragma omp dispatch interop(obj1)
+ s1.g1 (a1, b1, c1);
+
+ #pragma omp dispatch interop(obj2) device(5)
+ s2.g2 (a2, b2, c2, y1, y2, y3);
+}
+
+
+/* { dg-final { scan-tree-dump-times "D\.\[0-9\]+ =
__builtin_omp_get_default_device \\(\\);" 2 "gimple" } } */
+
+/* { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device
\\(D\.\[0-9\]+\\);" 3 "gimple" } } */
+/* { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device
\\(5\\);" 1 "gimple" } } */
+
+/* { dg-final { scan-tree-dump-times "obj1.\[0-9\] = obj1;" 2 "gimple" } } */
+/* { dg-final { scan-tree-dump-times "obj2.\[0-9\] = obj2;" 1 "gimple" } } */
+
+/* { dg-final { scan-tree-dump-times "D\.\[0-9\]+ =
__builtin_omp_get_interop_int \\(obj1.\[0-9\], -5, 0B\\);" 1 "gimple" } } */
+
+/* { dg-final { scan-tree-dump-times "__builtin_omp_get_mapped_ptr" 4 "gimple"
} } */
+/* { dg-final { scan-tree-dump-times "D\.\[0-9\]+ =
__builtin_omp_get_mapped_ptr \\(b1, D\.\[0-9\]+\\);" 1 "gimple" } } */
+/* { dg-final { scan-tree-dump-times "D\.\[0-9\]+ =
__builtin_omp_get_mapped_ptr \\(c2, 5\\);" 1 "gimple" } } */
+/* { dg-final { scan-tree-dump-times "D\.\[0-9\]+ =
__builtin_omp_get_mapped_ptr \\(b2, 5\\);" 1 "gimple" } } */
+/* { dg-final { scan-tree-dump-times "D\.\[0-9\]+ =
__builtin_omp_get_mapped_ptr \\(a2, 5\\);" 1 "gimple" } } */
+
+/* { dg-final { scan-tree-dump-times "t1::f1 \\(&s1, a1, D\.\[0-9\]+, c1,
obj1.\[0-9\]\\);" 1 "gimple" } } */
+/* { dg-final { scan-tree-dump-times "t2::f2 \\(&s2, D\.\[0-9\]+, D\.\[0-9\]+,
D\.\[0-9\]+, obj2.\[0-9\], y1, y2, y3\\);" 1 "gimple" } } */
diff --git a/gcc/testsuite/g++.dg/gomp/append-args-6.C
b/gcc/testsuite/g++.dg/gomp/append-args-6.C
new file mode 100644
index 000000000000..039d9faaf04d
--- /dev/null
+++ b/gcc/testsuite/g++.dg/gomp/append-args-6.C
@@ -0,0 +1,34 @@
+#if __cplusplus >= 201103L
+# define __GOMP_UINTPTR_T_ENUM : __UINTPTR_TYPE__
+#else
+# define __GOMP_UINTPTR_T_ENUM
+#endif
+
+typedef enum omp_interop_t __GOMP_UINTPTR_T_ENUM
+{
+ omp_interop_none = 0,
+ __omp_interop_t_max__ = __UINTPTR_MAX__
+} omp_interop_t;
+
+void f1(omp_interop_t &) { }
+/* { dg-error "argument 1 of 'f1' must be of 'omp_interop_t'" "" { target c }
.-1 } */
+/* { dg-note "initializing argument 1 of 'void f1\\(omp_interop_t&\\)'" "" {
target c++ } .-2 } */
+#pragma omp declare variant(f1) match(construct={dispatch}) \
+
append_args(interop(prefer_type({attr("ompx_fun")})))
+void g1(void);
+/* { dg-note "'append_args' specified here" "" { target c } .-2 } */
+/* { dg-error "cannot bind non-const lvalue reference of type 'omp_interop_t&'
to an rvalue of type 'omp_interop_t'" "" { target c++ } .-4 } */
+
+int f2(omp_interop_t);
+#pragma omp declare variant(f2) append_args(interop(prefer_type("cuda"))) \
+ match(construct={dispatch})
+int g2(void) { return 5; }
+
+int foo (omp_interop_t &obj1)
+{
+ int res;
+
+ #pragma omp dispatch interop(obj1) device(11) /* { dg-error "'obj1' must be
of 'omp_interop_t'" } */
+ res = g2();
+ return res;
+}
diff --git a/gcc/testsuite/g++.dg/gomp/append-args-7.C
b/gcc/testsuite/g++.dg/gomp/append-args-7.C
new file mode 100644
index 000000000000..97df32ea2475
--- /dev/null
+++ b/gcc/testsuite/g++.dg/gomp/append-args-7.C
@@ -0,0 +1,113 @@
+/* { dg-do compile { target c++11 } } */
+/* { dg-additional-options "-fdump-tree-gimple" } */
+
+
+#if __cplusplus >= 201103L
+# define __GOMP_UINTPTR_T_ENUM : __UINTPTR_TYPE__
+#else
+# define __GOMP_UINTPTR_T_ENUM
+#endif
+
+typedef enum omp_interop_t __GOMP_UINTPTR_T_ENUM
+{
+ omp_interop_none = 0,
+ __omp_interop_t_max__ = __UINTPTR_MAX__
+} omp_interop_t;
+
+typedef enum omp_interop_fr_t
+{
+ omp_ifr_cuda = 1,
+ omp_ifr_cuda_driver = 2,
+ omp_ifr_opencl = 3,
+ omp_ifr_sycl = 4,
+ omp_ifr_hip = 5,
+ omp_ifr_level_zero = 6,
+ omp_ifr_hsa = 7,
+ omp_ifr_last = omp_ifr_hsa
+} omp_interop_fr_t;
+
+
+template<typename T2>
+float repl0(T2, T2);
+#pragma omp declare variant(repl0) match(construct={dispatch})
append_args(interop(target,prefer_type(1,5,4)), interop(targetsync))
+float base0();
+
+
+
+template<typename T, typename T2>
+float repl1(T x, T2 y, T2 z) { return sizeof(x) + y == z; }
+#pragma omp declare variant(repl1) match(construct={dispatch})
append_args(interop(target,prefer_type(1,5,4,sizeof(T))), interop(targetsync))
+template<typename T>
+float base1(T x) { return x + 42; }
+
+
+
+template<typename T, typename T2, typename T3>
+void repl3inval(T, T2, T3);
+#pragma omp declare variant(repl3inval) match(construct={dispatch})
adjust_args(nothing : y) \
+ append_args(interop(prefer_type({fr(3),
attr("ompx_nop")},{fr(2)},{attr("ompx_all")}),target,targetsync))
+template<typename T, typename T2>
+void base2inval(T x, T2 y);
+
+
+
+template<typename T>
+void repl99(T);
+#pragma omp declare variant(repl99) match(construct={dispatch}) \
+ append_args(interop(target, targetsync, prefer_type("cuda")))
+template<typename T>
+void base99();
+
+
+
+template<typename T, typename T2, typename T3>
+void repl2(T, T2, T3, T3);
+#pragma omp declare variant(repl2) match(construct={dispatch})
adjust_args(need_device_ptr : y) \
+ append_args(interop(target, targetsync, prefer_type(1)), \
+ interop(prefer_type({fr(3),
attr("ompx_nop")},{fr(2)},{attr("ompx_all")})))
+template<typename T, typename T2>
+void base2(T x, T2 y);
+
+
+omp_interop_t obj2, obj3;
+
+void
+test_it (char *str, int i, int *ip, float *fp, omp_interop_t obj1)
+{
+ #pragma omp dispatch interop(obj2, obj1) device(99)
+ base0 ();
+
+ float f2;
+ #pragma omp dispatch interop(obj1, obj2) device(14)
+ f2 = base1 (*fp);
+ fp[0] = f2;
+
+ #pragma omp dispatch interop(obj1)
+ base2inval (str, i);
+
+ #pragma omp dispatch interop(obj2) device(21)
+ base99<double>();
+
+ #pragma omp dispatch interop(obj3, obj1) device(31)
+ base2(fp, ip);
+}
+
+
+
+/* { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ =
__builtin_omp_get_default_device \\(\\);" 5 "gimple" } } */
+
+/* { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device
\\(99\\);" 1 "gimple" } } */
+/* { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device
\\(14\\);" 1 "gimple" } } */
+/* { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device
\\(21\\);" 1 "gimple" } } */
+/* { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device
\\(31\\);" 1 "gimple" } } */
+
+/* { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device
\\(D\\.\[0-9\]+\\);" 6 "gimple" } } */
+
+/* { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ =
__builtin_omp_get_interop_int \\(obj1, -5, 0B\\);" 1 "gimple" } } */
+/* { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ =
__builtin_omp_get_mapped_ptr \\(ip, 31\\);" 1 "gimple" } } */
+
+/* { dg-final { scan-tree-dump-times "repl0<omp_interop_t> \\(obj2\\.\[0-9\],
obj1\\);" 1 "gimple" } } */
+/* { dg-final { scan-tree-dump-times "f2 = repl1<float, omp_interop_t>
\\(D\\.\[0-9\]+, obj1, obj2\\.\[0-9\]\\);" 1 "gimple" } } */
+/* { dg-final { scan-tree-dump-times "repl3inval<char\\*, int, omp_interop_t>
\\(str, i, obj1\\);" 1 "gimple" } } */
+/* { dg-final { scan-tree-dump-times "repl99<omp_interop_t>
\\(obj2\\.\[0-9\]\\);" 1 "gimple" } } */
+/* { dg-final { scan-tree-dump-times "repl2<float\\*, int\\*, omp_interop_t>
\\(fp, D\\.\[0-9\]+, obj3\\.\[0-9\], obj1\\);" 1 "gimple" } } */
diff --git a/gcc/testsuite/gcc.dg/gomp/append-args-1.c
b/gcc/testsuite/gcc.dg/gomp/append-args-1.c
new file mode 100644
index 000000000000..81dd1061aa15
--- /dev/null
+++ b/gcc/testsuite/gcc.dg/gomp/append-args-1.c
@@ -0,0 +1,70 @@
+/* { dg-do compile } */
+/* { dg-additional-options "-std=gnu17" } */
+
+/* The errors might be a bit questionable, but still a resonable solution
+ for questionable code ... */
+
+/* For all empty args, assume C < C23; in C++/C23 it becomes the same as
'…(void)'. */
+
+/* This uses append_args, once with adjust_args and once without. */
+
+typedef enum omp_interop_t
+{
+ omp_interop_none = 0,
+ __omp_interop_t_max__ = __UINTPTR_MAX__
+} omp_interop_t;
+
+
+/* (A) No prototype for the variant but for the base function. */
+
+void variant_fn1();
+#pragma omp declare variant(variant_fn1) match(construct={dispatch})
append_args(interop(target)) \
+ adjust_args(need_device_ptr: x,y)
+void bar1(int *x, int *y);
+/* { dg-error "variant 'variant_fn1' and base 'bar1' have incompatible types"
"" { target *-*-* } .-3 } */
+
+
+void variant_fn2();
+#pragma omp declare variant(variant_fn2) match(construct={dispatch})
append_args(interop(target))
+void bar2(int *x, int *y);
+/* { dg-error "variant 'variant_fn2' and base 'bar2' have incompatible types"
"" { target *-*-* } .-2 } */
+
+
+
+/* (B) No prototype for the variant nor for the base function. */
+
+void variant_fn3(); /* { dg-error "argument 1 of 'variant_fn3' must be of
'omp_interop_t'" } */
+#pragma omp declare variant(variant_fn3) match(construct={dispatch})
append_args(interop(target)) \
+ adjust_args(need_device_ptr: x,y)
+void bar3();
+/* { dg-error "'x' undeclared here \\(not in a function\\)" "" { target *-*-*
} .-2 } */
+/* { dg-error "'y' undeclared here \\(not in a function\\)" "" { target *-*-*
} .-3 } */
+/* { dg-note "'append_args' specified here" "" { target *-*-* } .-5 } */
+
+
+void variant_fn4(); /* { dg-error "argument 1 of 'variant_fn4' must be of
'omp_interop_t'" } */
+#pragma omp declare variant(variant_fn4) match(construct={dispatch})
append_args(interop(target))
+void bar4();
+/* { dg-note "'append_args' specified here" "" { target *-*-* } .-2 } */
+
+
+
+/* (C) Only a prototype on the variant-function side. */
+
+void variant_fn5(omp_interop_t, omp_interop_t);
+#pragma omp declare variant(variant_fn5) match(construct={dispatch})
append_args(interop(target)) \
+ adjust_args(need_device_ptr: x,y)
+void bar5();
+/* { dg-error "variant 'variant_fn5' and base 'bar5' have incompatible types"
"" { target *-*-* } .-3 } */
+
+
+void variant_fn6(omp_interop_t, omp_interop_t);
+#pragma omp declare variant(variant_fn6) match(construct={dispatch})
append_args(interop(target))
+void bar6();
+/* { dg-error "variant 'variant_fn6' and base 'bar6' have incompatible types"
"" { target *-*-* } .-2 } */
+
+
+void variant_fn7(int *, int, omp_interop_t, omp_interop_t);
+#pragma omp declare variant(variant_fn7) match(construct={dispatch})
append_args(interop(target))
+void bar7();
+/* { dg-error "variant 'variant_fn7' and base 'bar7' have incompatible types"
"" { target *-*-* } .-2 } */
diff --git a/gcc/testsuite/gfortran.dg/gomp/adjust-args-1.f90
b/gcc/testsuite/gfortran.dg/gomp/adjust-args-1.f90
index d9f2a670a683..c0c06e7f8fdf 100644
--- a/gcc/testsuite/gfortran.dg/gomp/adjust-args-1.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/adjust-args-1.f90
@@ -26,7 +26,7 @@ module main
integer function f4 (a)
import c_ptr
type(c_ptr), intent(inout) :: a
- !$omp declare variant (f0) adjust_args (nothing: a) ! { dg-error "an
'adjust_args' clause at .1. can only be specified if the 'dispatch' selector of
the construct selector set appears in the 'match' clause" }
+ !$omp declare variant (f0) adjust_args (nothing: a) ! { dg-error "the
'adjust_args' clause at .1. can only be specified if the 'dispatch' selector of
the construct selector set appears in the 'match' clause" }
end function
integer function f5 (i)
integer, intent(inout) :: i
diff --git a/gcc/testsuite/gfortran.dg/gomp/adjust-args-3.f90
b/gcc/testsuite/gfortran.dg/gomp/adjust-args-3.f90
index 291bb47aaa25..9033221cc5c2 100644
--- a/gcc/testsuite/gfortran.dg/gomp/adjust-args-3.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/adjust-args-3.f90
@@ -9,7 +9,7 @@ module main
contains
subroutine base2 (a)
type(c_ptr), intent(inout) :: a
- !$omp declare variant (variant2) match (construct={parallel}) adjust_args
(need_device_ptr: a) ! { dg-error "an 'adjust_args' clause can only be
specified if the 'dispatch' selector of the construct selector set appears in
the 'match' clause at .1." }
+ !$omp declare variant (variant2) match (construct={parallel}) adjust_args
(need_device_ptr: a) ! { dg-error "the 'adjust_args' clause can only be
specified if the 'dispatch' selector of the construct selector set appears in
the 'match' clause at .1." }
end subroutine
subroutine base3 (a)
type(c_ptr), intent(inout) :: a
diff --git a/gcc/testsuite/gfortran.dg/gomp/append_args-1.f90
b/gcc/testsuite/gfortran.dg/gomp/append_args-1.f90
new file mode 100644
index 000000000000..c994b555c97f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/append_args-1.f90
@@ -0,0 +1,76 @@
+module my_omp_lib
+ 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 my_omp_lib
+
+module m
+ use my_omp_lib
+ implicit none
+ logical, parameter :: flag = .true.
+contains
+ subroutine f1a ()
+ end
+
+ subroutine f1b ()
+ end
+
+ subroutine f1c ()
+ end
+
+ subroutine f1d ()
+ end
+
+ subroutine f1e ()
+ end
+
+ subroutine f1po (q,r, obj)
+ type(c_ptr) :: q, r
+ value :: r
+ integer(omp_interop_kind),value :: obj
+ end
+
+ subroutine f2 ()
+ !$omp declare variant (f1a) match(user={condition(flag)}) &
+ !$omp& append_args ( interop ( target , targetsync) )
match(construct={dispatch}) ! { dg-error "'match' clause at .1. specified
more than once" }
+ end subroutine
+
+ subroutine f2a ()
+ !$omp declare variant (f1b) append_args ( interop ( prefer_type ( "cuda",
"hip" ) ) , interop(target)) &
+ !$omp& append_args ( interop ( target , targetsync) )
match(construct={dispatch}) ! { dg-error "'append_args' clause at .1.
specified more than once" }
+ end subroutine
+
+
+ subroutine f2b ()
+ !$omp declare variant (f1c) &
+ !$omp& append_args ( interop ( target , targetsync) ) ! { dg-error
"the 'append_args' clause at .1. can only be specified if the 'dispatch'
selector of the construct selector set appears in the 'match' clause" }
+ end subroutine
+
+ subroutine f2c (x,y)
+ !$omp declare variant (fop) , append_args ( interop ( prefer_type (
"cuda", "hip" ) ) , interop(target)) , &
+ !$omp& adjust_args (need_device_ptr : x, y ) ! { dg-error "the
'adjust_args' clause at .1. can only be specified if the 'dispatch' selector of
the construct selector set appears in the 'match' clause" }
+ type(c_ptr) :: x, y
+ value :: y
+ end subroutine
+
+ subroutine f2d ()
+ !$omp declare variant (f1d) append_args ( interop ( prefer_type ( "cuda",
"hip" ) ) , interop(target)) , ! { dg-error "111: expected 'match',
'adjust_args' or 'append_args' at .1." }
+ end subroutine
+
+ subroutine f2e ()
+ !$omp declare variant (f1e) append_args ( interop ( prefer_type ( "cuda",
"hip" ) ) , interop(target) interop(targetsync)) ! { dg-error "Expected ',' or
'\\)' at .1." }
+ end subroutine
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/append_args-2.f90
b/gcc/testsuite/gfortran.dg/gomp/append_args-2.f90
new file mode 100644
index 000000000000..a20f610a03dc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/append_args-2.f90
@@ -0,0 +1,199 @@
+! { dg-do compile }
+! { dg-additional-options "-fcoarray=single" }
+
+module my_omp_lib
+ 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 my_omp_lib
+
+module m
+ use my_omp_lib
+ implicit none
+ logical, parameter :: flag = .true.
+contains
+ subroutine f1o (obj)
+ integer(omp_interop_kind),value :: obj
+ end
+
+ subroutine f1ox (q,r, obj)
+ ! { dg-error "'q' at .1. must be a nonpointer, nonallocatable scalar integer
dummy argument of 'omp_interop_kind' kind as it utilized with the 'append_args'
clause at .2." "" { target *-*-* } .-1 }
+ type(c_ptr) :: q, r
+ value :: r
+ integer(omp_interop_kind),value :: obj
+ end
+
+
+ subroutine f5 ()
+ !$omp declare variant (f1ox) match(user={condition(flag)}) & ! { dg-error
"the 'append_args' clause can only be specified if the 'dispatch' selector of
the construct selector set appears in the 'match' clause at .1." }
+ !$omp& append_args ( interop ( target , targetsync) )
+ ! { dg-error "'q' at .1. must be a nonpointer, nonallocatable scalar
integer dummy argument of 'omp_interop_kind' kind as it utilized with the
'append_args' clause at .2." "" { target *-*-* } .-2 }
+ end subroutine
+
+ subroutine f6 (x, y)
+ !$omp declare variant (f1ox) match(user={condition(flag)}) & ! { dg-error
"the 'adjust_args' clause can only be specified if the 'dispatch' selector of
the construct selector set appears in the 'match' clause at .1." }
+ !$omp& append_args ( interop ( target , targetsync) ) &
+ !$omp& adjust_args ( need_device_ptr : x , y)
+ type(c_ptr) :: x, y
+ value :: y
+ end subroutine
+
+ subroutine g1 (obj, obj2, obj3)
+ integer(omp_interop_kind),value :: obj,obj3
+ integer(omp_interop_kind),value :: obj2
+ end
+ subroutine g1a (obj)
+ !$omp declare variant (g1 ) match(construct={dispatch}) append_args (
interop ( target , targetsync), interop( prefer_type ( {fr("cuda"),
attr("ompx_xx")}, {attr("ompx_yy")} )))
+ integer(omp_interop_kind),value :: obj
+ end
+
+ subroutine g2 (obj, obj2, obj3)
+ ! { dg-error "'g2' at .1. has 2 but requires 1 'omp_interop_kind' kind
dummy arguments as it is utilized with the 'append_args' clause at .2." "" {
target *-*-* } .-1 }
+ integer(omp_interop_kind),value :: obj,obj2,obj3
+ end
+ subroutine g2a (obj)
+ !$omp declare variant (g2 ) match(construct={dispatch}) append_args (
interop( target, prefer_type ( {fr("cuda"), attr("ompx_xx")},
{attr("ompx_yy")}), targetsync))
+ ! { dg-error "'g2' at .1. has 2 but requires 1 'omp_interop_kind' kind
dummy arguments as it is utilized with the 'append_args' clause at .2." "" {
target *-*-* } .-1 }
+ integer(omp_interop_kind),value :: obj
+ end
+
+ subroutine g3 (obj, obj2, obj3)
+ integer(omp_interop_kind),value :: obj,obj3
+ integer(omp_interop_kind) :: obj2
+ end
+ subroutine g3a (obj)
+ !$omp declare variant (g3 ) match(construct={dispatch}) append_args (
interop ( target , targetsync), interop( prefer_type ( {fr("cuda"),
attr("ompx_xx")}, {attr("ompx_yy")} )))
+ integer(omp_interop_kind),value :: obj
+ end
+
+ subroutine g4 (obj, obj2, obj3)
+ integer(omp_interop_kind),value :: obj,obj3
+ integer(omp_interop_kind) :: obj2
+ end
+ subroutine g4a (obj)
+ !$omp declare variant (g4 ) match(construct={dispatch}) append_args (
interop ( target , targetsync), interop( prefer_type ( {fr("cuda"),
attr("ompx_xx")}, {attr("ompx_yy")} )))
+ integer(omp_interop_kind),value :: obj
+ end
+
+ subroutine g5 (obj, obj2, obj3)
+ ! { dg-error "'obj3' at .1. with OPTIONAL attribute not support when
utilized with the 'append_args' clause at .2." "" { target *-*-* } .-1 }
+ integer(omp_interop_kind),value :: obj,obj3
+ integer(omp_interop_kind) :: obj2
+ optional :: obj3
+ end
+ subroutine g5a (obj)
+ !$omp declare variant (g5 ) match(construct={dispatch}) append_args (
interop ( target , targetsync), interop( prefer_type ( {fr("cuda"),
attr("ompx_xx")}, {attr("ompx_yy")} )))
+ ! { dg-error "'obj3' at .1. with OPTIONAL attribute not support when
utilized with the 'append_args' clause at .2." "" { target *-*-* } .-1 }
+ integer(omp_interop_kind),value :: obj
+ end
+
+ subroutine g5var (obj, obj2, obj3)
+ ! { dg-error "'obj3' at .1. with OPTIONAL attribute not support when
utilized with the 'append_args' clause at .2." "" { target *-*-* } .-1 }
+ integer(omp_interop_kind) :: obj,obj3
+ integer(omp_interop_kind) :: obj2
+ value :: obj
+ optional :: obj3
+ end
+ subroutine g5avar (obj)
+ !$omp declare variant (g5var ) match(construct={dispatch}) append_args (
interop ( target , targetsync), interop( prefer_type ( {fr("cuda"),
attr("ompx_xx")}, {attr("ompx_yy")} )))
+ ! { dg-error "'obj3' at .1. with OPTIONAL attribute not support when
utilized with the 'append_args' clause at .2." "" { target *-*-* } .-1 }
+ integer(omp_interop_kind),value :: obj
+ end
+
+ subroutine g6 (obj, obj2, obj3)
+ ! { dg-error "'obj3' at .1. must be a nonpointer, nonallocatable scalar
integer dummy argument of 'omp_interop_kind' kind as it utilized with the
'append_args' clause at .2." "" { target *-*-* } .-1 }
+ integer(omp_interop_kind),value :: obj
+ integer(omp_interop_kind),pointer :: obj3
+ integer(omp_interop_kind) :: obj2
+ end
+ subroutine g6a (obj)
+ !$omp declare variant (g6 ) match(construct={dispatch}) append_args (
interop ( target , targetsync), interop( prefer_type ( {fr("cuda"),
attr("ompx_xx")}, {attr("ompx_yy")} )))
+ ! { dg-error "'obj3' at .1. must be a nonpointer, nonallocatable scalar
integer dummy argument of 'omp_interop_kind' kind as it utilized with the
'append_args' clause at .2." "" { target *-*-* } .-1 }
+ integer(omp_interop_kind),value :: obj
+ end
+
+ subroutine g7 (obj, obj2, obj3)
+ ! { dg-error "'obj2' at .1. must be a nonpointer, nonallocatable scalar
integer dummy argument of 'omp_interop_kind' kind as it utilized with the
'append_args' clause at .2." "" { target *-*-* } .-1 }
+ integer(omp_interop_kind),value :: obj
+ integer(omp_interop_kind) :: obj3
+ integer(omp_interop_kind),allocatable :: obj2
+ end
+ subroutine g7a (obj)
+ !$omp declare variant (g7 ) match(construct={dispatch}) append_args (
interop ( target , targetsync), interop( prefer_type ( {fr("cuda"),
attr("ompx_xx")}, {attr("ompx_yy")} )))
+ ! { dg-error "'obj2' at .1. must be a nonpointer, nonallocatable scalar
integer dummy argument of 'omp_interop_kind' kind as it utilized with the
'append_args' clause at .2." "" { target *-*-* } .-1 }
+ integer(omp_interop_kind),value :: obj
+ end
+
+ subroutine g8 (obj, obj2, obj3)
+ ! { dg-error "'obj2' at .1. must be a nonpointer, nonallocatable scalar
integer dummy argument of 'omp_interop_kind' kind as it utilized with the
'append_args' clause at .2." "" { target *-*-* } .-1 }
+ integer(omp_interop_kind),value :: obj
+ integer(omp_interop_kind) :: obj3
+ integer(omp_interop_kind) :: obj2(:)
+ end
+ subroutine g8a (obj)
+ !$omp declare variant (g8 ) match(construct={dispatch}) append_args (
interop ( target , targetsync), interop( prefer_type ( {fr("cuda"),
attr("ompx_xx")}, {attr("ompx_yy")} )))
+ ! { dg-error "'obj2' at .1. must be a nonpointer, nonallocatable scalar
integer dummy argument of 'omp_interop_kind' kind as it utilized with the
'append_args' clause at .2." "" { target *-*-* } .-1 }
+ integer(omp_interop_kind),value :: obj
+ end
+
+ subroutine g9 (obj, obj2, obj3)
+ ! { dg-error "'obj2' at .1. must be a nonpointer, nonallocatable scalar
integer dummy argument of 'omp_interop_kind' kind as it utilized with the
'append_args' clause at .2." "" { target *-*-* } .-1 }
+ integer(omp_interop_kind),value :: obj
+ integer(omp_interop_kind) :: obj3
+ integer(omp_interop_kind) :: obj2(2)
+ end
+ subroutine g9a (obj)
+ !$omp declare variant (g9 ) match(construct={dispatch}) append_args (
interop ( target , targetsync), interop( prefer_type ( {fr("cuda"),
attr("ompx_xx")}, {attr("ompx_yy")} )))
+ ! { dg-error "'obj2' at .1. must be a nonpointer, nonallocatable scalar
integer dummy argument of 'omp_interop_kind' kind as it utilized with the
'append_args' clause at .2." "" { target *-*-* } .-1 }
+ integer(omp_interop_kind),value :: obj
+ end
+
+ subroutine g10 (obj, obj2, obj3)
+ ! { dg-error "'obj2' at .1. must be a nonpointer, nonallocatable scalar
integer dummy argument of 'omp_interop_kind' kind as it utilized with the
'append_args' clause at .2." "" { target *-*-* } .-1 }
+ integer(omp_interop_kind),value :: obj
+ integer(omp_interop_kind) :: obj3
+ integer(1) :: obj2
+ end
+ subroutine g10a (obj)
+ !$omp declare variant (g10 ) match(construct={dispatch}) append_args (
interop ( target , targetsync), interop( prefer_type ( {fr("cuda"),
attr("ompx_xx")}, {attr("ompx_yy")} )))
+ ! { dg-error "'obj2' at .1. must be a nonpointer, nonallocatable scalar
integer dummy argument of 'omp_interop_kind' kind as it utilized with the
'append_args' clause at .2." "" { target *-*-* } .-1 }
+ integer(omp_interop_kind),value :: obj
+ end
+
+ subroutine g11 (obj, obj2, obj3)
+ ! { dg-error "'obj2' at .1. must be a nonpointer, nonallocatable scalar
integer dummy argument of 'omp_interop_kind' kind as it utilized with the
'append_args' clause at .2." "" { target *-*-* } .-1 }
+ integer(omp_interop_kind),value :: obj
+ integer(omp_interop_kind) :: obj3
+ real(omp_interop_kind) :: obj2 ! { dg-warning "C kind type parameter is
for type INTEGER but type at .1. is REAL" }
+ end
+ subroutine g11a (obj)
+ !$omp declare variant (g11 ) match(construct={dispatch}) append_args (
interop ( target , targetsync), interop( prefer_type ( {fr("cuda"),
attr("ompx_xx")}, {attr("ompx_yy")} )))
+ ! { dg-error "'obj2' at .1. must be a nonpointer, nonallocatable scalar
integer dummy argument of 'omp_interop_kind' kind as it utilized with the
'append_args' clause at .2." "" { target *-*-* } .-1 }
+ integer(omp_interop_kind),value :: obj
+ end
+
+ subroutine g12 (obj, obj2, obj3)
+ ! { dg-error "'obj2' at .1. must be a nonpointer, nonallocatable scalar
integer dummy argument of 'omp_interop_kind' kind as it utilized with the
'append_args' clause at .2." "" { target *-*-* } .-1 }
+ integer(omp_interop_kind),value :: obj
+ integer(omp_interop_kind) :: obj3
+ integer(omp_interop_kind) :: obj2[*]
+ end
+ subroutine g12a (obj)
+ !$omp declare variant (g12 ) match(construct={dispatch}) append_args (
interop ( target , targetsync), interop( prefer_type ( {fr("cuda"),
attr("ompx_xx")}, {attr("ompx_yy")} )))
+ ! { dg-error "'obj2' at .1. must be a nonpointer, nonallocatable scalar
integer dummy argument of 'omp_interop_kind' kind as it utilized with the
'append_args' clause at .2." "" { target *-*-* } .-1 }
+ integer(omp_interop_kind),value :: obj
+ end
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/append_args-3.f90
b/gcc/testsuite/gfortran.dg/gomp/append_args-3.f90
new file mode 100644
index 000000000000..5dbc246fc537
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/append_args-3.f90
@@ -0,0 +1,293 @@
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-gimple -cpp" }
+
+module my_omp_lib
+ 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 my_omp_lib
+
+module m
+ use my_omp_lib
+ implicit none (type, external)
+
+ integer(omp_interop_kind) :: myobj_mod, myobj2_mod
+ integer(omp_interop_kind), allocatable :: myobj_mod_alloc, myobj2_mod_alloc
+contains
+
+ subroutine vsub_no_arg (o_dummy, o_value)
+ integer(omp_interop_kind) :: o_dummy
+ integer(omp_interop_kind), value :: o_value
+ end
+ subroutine sub_no_arg ()
+ !$omp declare variant (vsub_no_arg ) match(construct={dispatch})
append_args (interop(targetsync), interop( prefer_type ( {fr("cuda"),
attr("ompx_xx")}, {attr("ompx_yy")} )))
+ end
+
+ integer(c_int) function vfun_cbind(arg2_int, arg2_str, o2_dummy, o2_value)
bind(C)
+ integer(c_int), value :: arg2_int
+ character(len=1, kind=c_char) :: arg2_str(*)
+ integer(omp_interop_kind) :: o2_dummy
+ integer(omp_interop_kind), value :: o2_value
+ vfun_cbind = arg2_int
+ end
+ integer(c_int) function fun_cbind(arg2_int, arg2_str) bind(C)
+ !$omp declare variant(vfun_cbind) ,
match(construct={dispatch}),append_args (interop(target), interop(target))
+ integer(c_int), value :: arg2_int
+ character(len=1, kind=c_char) :: arg2_str(*)
+ fun_cbind = arg2_int
+ end
+end
+
+subroutine test_sub_no_arg(obj_dummy_val, obj_dummy, obj_dummy_opt,
obj_dummy_alloc, obj_dummy_alloc_opt, obj_dummy_ptr, obj_dummy_ptr_opt)
+ use m
+ implicit none (type, external)
+
+ integer(omp_interop_kind), value :: obj_dummy_val
+ integer(omp_interop_kind) :: obj_dummy
+ integer(omp_interop_kind), optional :: obj_dummy_opt
+
+ integer(omp_interop_kind), allocatable :: obj_dummy_alloc
+ integer(omp_interop_kind), allocatable, optional :: obj_dummy_alloc_opt
+
+ integer(omp_interop_kind), pointer :: obj_dummy_ptr
+ integer(omp_interop_kind), pointer, optional :: obj_dummy_ptr_opt
+
+ integer(omp_interop_kind), target :: obj_loc
+ integer(omp_interop_kind), pointer :: obj_loc_ptr
+ integer(omp_interop_kind), allocatable :: obj_loc_alloc
+
+ obj_loc = omp_interop_none
+ obj_loc_ptr => obj_loc
+
+ !$omp dispatch device(10) interop(obj_dummy_val, obj_dummy)
+ call sub_no_arg
+ ! subroutine vsub_no_arg (o_dummy, o_value)
+ ! { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device
\\(10\\);" 1 "gimple" } }
+ ! { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ = \\*obj_dummy;" 1
"gimple" } }
+ ! { dg-final { scan-tree-dump-times "obj_dummy_val\\.\[0-9\]+ =
obj_dummy_val;" 1 "gimple" } }
+ ! { dg-final { scan-tree-dump-times "vsub_no_arg
\\(&obj_dummy_val\\.\[0-9\]+, D\\.\[0-9\]+\\);" 1 "gimple" } }
+
+ !$omp dispatch device(11) interop(obj_dummy, obj_dummy_val)
+ call sub_no_arg
+ ! subroutine vsub_no_arg (o_dummy, o_value)
+ ! { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device
\\(11\\);" 1 "gimple" } }
+ ! { dg-final { scan-tree-dump-times "vsub_no_arg \\(obj_dummy,
obj_dummy_val\\);" 1 "gimple" } }
+
+ !$omp dispatch device(12) interop(obj_dummy_opt, obj_dummy_alloc)
+ call sub_no_arg
+ ! subroutine vsub_no_arg (o_dummy, o_value)
+ ! { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device
\\(12\\);" 1 "gimple" } }
+ ! { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ = \\*obj_dummy_alloc;" 2
"gimple" } }
+ ! The follow inline shows up 4x sub_no_arg and 4x vfun_cbind
+ ! { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ = \\*D\\.\[0-9\]+;" 8
"gimple" } }
+ ! { dg-final { scan-tree-dump-times "vsub_no_arg \\(obj_dummy_opt,
D\\.\[0-9\]+\\);" 1 "gimple" } }
+
+ !$omp dispatch device(13) interop(obj_dummy_alloc, obj_dummy_opt)
+ call sub_no_arg
+ ! subroutine vsub_no_arg (o_dummy, o_value)
+ ! { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device
\\(13\\);" 1 "gimple" } }
+ ! { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ = \\*obj_dummy_opt;" 1
"gimple" } }
+ ! See above D\\.\[0-9\]+ = \\*obj_dummy_alloc;
+ ! { dg-final { scan-tree-dump-times "vsub_no_arg \\(D\\.\[0-9\]+,
D\\.\[0-9\]+\\);" 3 "gimple" } }
+
+ !$omp dispatch device(14) interop(obj_dummy_alloc_opt, obj_dummy_ptr)
+ call sub_no_arg
+ ! subroutine vsub_no_arg (o_dummy, o_value)
+ ! { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device
\\(14\\);" 1 "gimple" } }
+ ! { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ = \\*obj_dummy_ptr;" 2
"gimple" } }
+ ! See above D\\.\[0-9\]+ = \\*D\\.\[0-9\]+;
+ ! { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ = \\*obj_dummy_alloc_opt;"
2 "gimple" } }
+ ! See above vsub_no_arg \\(D\\.\[0-9\]+,
D\\.\[0-9\]+\\);
+
+ !$omp dispatch device(15) interop(obj_dummy_ptr, obj_dummy_alloc_opt)
+ call sub_no_arg
+ ! subroutine vsub_no_arg (o_dummy, o_value)
+ ! { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device
\\(15\\);" 1 "gimple" } }
+ ! See above D\\.\[0-9\]+ = \\*obj_dummy_alloc_opt;
+ ! See above D\\.\[0-9\]+ = \\*D\\.\[0-9\]+;
+ ! See above D\\.\[0-9\]+ = \\*obj_dummy_ptr;
+ ! See above vsub_no_arg \\(D\\.\[0-9\]+,
D\\.\[0-9\]+\\);
+
+ !$omp dispatch device(16) interop(obj_dummy_ptr_opt, myobj_mod)
+ call sub_no_arg
+ ! subroutine vsub_no_arg (o_dummy, o_value)
+ ! { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device
\\(16\\);" 1 "gimple" } }
+ ! { dg-final { scan-tree-dump-times "myobj_mod\\.\[0-9\]+ = myobj_mod;" 1
"gimple" } }
+ ! { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ = \\*obj_dummy_ptr_opt;" 2
"gimple" } }
+ ! { dg-final { scan-tree-dump-times "vsub_no_arg \\(D\\.\[0-9\]+,
myobj_mod\\.\[0-9\]+\\);" 1 "gimple" } }
+
+ !$omp dispatch device(17) interop(myobj_mod, obj_dummy_ptr_opt)
+ call sub_no_arg
+ ! subroutine vsub_no_arg (o_dummy, o_value)
+ ! { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device
\\(17\\);" 1 "gimple" } }
+ ! See above D\\.\[0-9\]+ = \\*obj_dummy_ptr_opt;
+ ! See above D\\.\[0-9\]+ = \\*D\\.\[0-9\]+;
+ ! { dg-final { scan-tree-dump-times "vsub_no_arg \\(&myobj_mod,
D\\.\[0-9\]+\\);" 1 "gimple" } }
+
+ !$omp dispatch device(18) interop(obj_loc, obj_loc_ptr)
+ call sub_no_arg
+ ! subroutine vsub_no_arg (o_dummy, o_value)
+ ! { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device
\\(18\\);" 1 "gimple" } }
+ ! { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ = \\*obj_loc_ptr;" 1
"gimple" } }
+ ! { dg-final { scan-tree-dump-times "vsub_no_arg \\(&obj_loc,
D\\.\[0-9\]+\\);" 1 "gimple" } }
+
+ !$omp dispatch device(19) interop(obj_loc_ptr, obj_loc)
+ call sub_no_arg
+ ! subroutine vsub_no_arg (o_dummy, o_value)
+ ! { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device
\\(19\\);" 1 "gimple" } }
+ ! { dg-final { scan-tree-dump-times "obj_loc\\.\[0-9\]+ = obj_loc;" 1
"gimple" } }
+ ! { dg-final { scan-tree-dump-times "vsub_no_arg \\(obj_loc_ptr,
obj_loc\\.\[0-9\]+\\);" 1 "gimple" } }
+
+ !$omp dispatch device(20) interop(obj_loc_alloc, myobj_mod_alloc)
+ call sub_no_arg
+ ! subroutine vsub_no_arg (o_dummy, o_value)
+ ! { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device
\\(20\\);" 1 "gimple" } }
+ ! { dg-final { scan-tree-dump-times "myobj_mod_alloc\\.\[0-9\]+ =
myobj_mod_alloc;" 2 "gimple" } }
+ ! { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ =
\\*myobj_mod_alloc\\.\[0-9\]+;" 1 "gimple" } }
+ ! { dg-final { scan-tree-dump-times "vsub_no_arg \\(obj_loc_alloc,
D\\.\[0-9\]+\\);" 1 "gimple" } }
+
+ !$omp dispatch device(21) interop(myobj_mod_alloc, obj_loc_alloc)
+ call sub_no_arg
+ ! subroutine vsub_no_arg (o_dummy, o_value)
+ ! { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device
\\(21\\);" 1 "gimple" } }
+ ! { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ = \\*obj_loc_alloc;" 1
"gimple" } }
+ ! See above myobj_mod_alloc\\.\[0-9\]+ =
myobj_mod_alloc;
+ ! { dg-final { scan-tree-dump-times "vsub_no_arg
\\(myobj_mod_alloc\\.\[0-9\]+, D\\.\[0-9\]+\\);" 1 "gimple" } }
+end
+
+
+integer(c_int) function test_fun_cbind (obj2_dummy_val, obj2_dummy,
obj2_dummy_opt, obj2_dummy_alloc, obj2_dummy_alloc_opt, obj2_dummy_ptr,
obj2_dummy_ptr_opt)
+ use m
+ implicit none (type, external)
+
+ integer(omp_interop_kind), value :: obj2_dummy_val
+ integer(omp_interop_kind) :: obj2_dummy
+ integer(omp_interop_kind), optional :: obj2_dummy_opt
+
+ integer(omp_interop_kind), allocatable :: obj2_dummy_alloc
+ integer(omp_interop_kind), allocatable, optional :: obj2_dummy_alloc_opt
+
+ integer(omp_interop_kind), pointer :: obj2_dummy_ptr
+ integer(omp_interop_kind), pointer, optional :: obj2_dummy_ptr_opt
+
+ integer(omp_interop_kind), target :: obj2_loc
+ integer(omp_interop_kind), pointer :: obj2_loc_ptr
+ integer(omp_interop_kind), allocatable :: obj2_loc_alloc
+
+ integer :: i30, i31, i32, i33, i34, i35, i36, i37, i38, i39, i40, i41
+
+ obj2_loc = omp_interop_none
+ obj2_loc_ptr => obj2_loc
+
+ !$omp dispatch device(30) interop(obj2_dummy, obj2_dummy_val)
+ i30 = fun_cbind (300, "abc30" // c_null_char)
+ ! vfun_cbind(arg2_int, arg2_str, o2_dummy, o2_value)
+ ! { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device
\\(30\\);" 1 "gimple" } }
+ ! { dg-final { scan-tree-dump-times "i30 = vfun_cbind \\(300,
&\"abc30\"\\\[1\\\]\{lb: 1 sz: 1\}, obj2_dummy, obj2_dummy_val\\);" 1 "gimple"
} }
+
+ !$omp dispatch device(31) interop(obj2_dummy_val, obj2_dummy)
+ i31 = fun_cbind (301, "abc31" // c_null_char)
+ ! vfun_cbind(arg2_int, arg2_str, o2_dummy, o2_value)
+ ! { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device
\\(31\\);" 1 "gimple" } }
+ ! { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ = \\*obj2_dummy;" 1
"gimple" } }
+ ! { dg-final { scan-tree-dump-times "obj2_dummy_val\\.\[0-9\]+ =
obj2_dummy_val;" 1 "gimple" } }
+ ! { dg-final { scan-tree-dump-times "i31 = vfun_cbind \\(301,
&\"abc31\"\\\[1\\\]\{lb: 1 sz: 1\}, &obj2_dummy_val\\.\[0-9\]+,
D\\.\[0-9\]+\\);" 1 "gimple" } }
+
+ !$omp dispatch device(32) interop(obj2_dummy_opt, obj2_dummy_alloc)
+ i32 = fun_cbind (302, "abc32" // c_null_char)
+ ! vfun_cbind(arg2_int, arg2_str, o2_dummy, o2_value)
+ ! { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device
\\(32\\);" 1 "gimple" } }
+ ! { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ = \\*obj2_dummy_alloc;" 2
"gimple" } }
+ ! See above D\\.\[0-9\]+ = \\*D\\.\[0-9\]+;" 1
"gimple" } }
+ ! { dg-final { scan-tree-dump-times "i32 = vfun_cbind \\(302,
&\"abc32\"\\\[1\\\]\{lb: 1 sz: 1\}, obj2_dummy_opt, D\\.\[0-9\]+\\);" 1
"gimple" } }
+
+ !$omp dispatch device(33) interop(obj2_dummy_alloc, obj2_dummy_opt)
+ i33 = fun_cbind (303, "abc33" // c_null_char)
+ ! vfun_cbind(arg2_int, arg2_str, o2_dummy, o2_value)
+ ! { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device
\\(33\\);" 1 "gimple" } }
+ ! { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ = \\*obj2_dummy_opt;" 1
"gimple" } }
+ ! See above D\\.\[0-9\]+ = \\*obj2_dummy_alloc;
+ ! { dg-final { scan-tree-dump-times "i33 = vfun_cbind \\(303,
&\"abc33\"\\\[1\\\]\{lb: 1 sz: 1\}, D\\.\[0-9\]+, D\\.\[0-9\]+\\);" 1 "gimple"
} }
+
+ !$omp dispatch device(34) interop(obj2_dummy_alloc_opt, obj2_dummy_ptr)
+ i34 = fun_cbind (304, "abc34" // c_null_char)
+ ! vfun_cbind(arg2_int, arg2_str, o2_dummy, o2_value)
+ ! { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device
\\(34\\);" 1 "gimple" } }
+ ! { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ = \\*obj2_dummy_ptr;" 2
"gimple" } }
+ ! See above D\\.\[0-9\]+ = \\*D\\.\[0-9\]+;" 1
"gimple" } }
+ ! { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ =
\\*obj2_dummy_alloc_opt;" 2 "gimple" } }
+ ! { dg-final { scan-tree-dump-times "i34 = vfun_cbind \\(304,
&\"abc34\"\\\[1\\\]\{lb: 1 sz: 1\}, D\\.\[0-9\]+, D\\.\[0-9\]+\\);" 1 "gimple"
} }
+
+ !$omp dispatch device(35) interop(obj2_dummy_ptr, obj2_dummy_alloc_opt)
+ i35 = fun_cbind (305, "abc35" // c_null_char)
+ ! vfun_cbind(arg2_int, arg2_str, o2_dummy, o2_value)
+ ! { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device
\\(35\\);" 1 "gimple" } }
+ ! See above D\\.\[0-9\]+ = \\*obj2_dummy_alloc_opt;
+ ! See above D\\.\[0-9\]+ = \\*D\\.\[0-9\]+;" 1
"gimple" } }
+ ! See above D\\.\[0-9\]+ = \\*obj2_dummy_ptr;" 1
"gimple" } }
+ ! { dg-final { scan-tree-dump-times "i35 = vfun_cbind \\(305,
&\"abc35\"\\\[1\\\]\{lb: 1 sz: 1\}, D\\.\[0-9\]+, D\\.\[0-9\]+\\);" 1 "gimple"
} }
+
+ !$omp dispatch device(36) interop(obj2_dummy_ptr_opt, myobj2_mod)
+ i36 = fun_cbind (306, "abc36" // c_null_char)
+ ! vfun_cbind(arg2_int, arg2_str, o2_dummy, o2_value)
+ ! { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device
\\(36\\);" 1 "gimple" } }
+ ! { dg-final { scan-tree-dump-times "myobj2_mod\\.\[0-9\]+ = myobj2_mod;" 1
"gimple" } }
+ ! { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ = \\*obj2_dummy_ptr_opt;"
2 "gimple" } }
+ ! { dg-final { scan-tree-dump-times "i36 = vfun_cbind \\(306,
&\"abc36\"\\\[1\\\]\{lb: 1 sz: 1\}, D\\.\[0-9\]+, myobj2_mod\\.\[0-9\]+\\);" 1
"gimple" } }
+
+ !$omp dispatch device(37) interop(myobj2_mod, obj2_dummy_ptr_opt)
+ i37 = fun_cbind (307, "abc37" // c_null_char)
+ ! vfun_cbind(arg2_int, arg2_str, o2_dummy, o2_value)
+ ! { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device
\\(37\\);" 1 "gimple" } }
+ ! See above D\\.\[0-9\]+ = \\*obj2_dummy_ptr_opt;
+ ! See above D\\.\[0-9\]+ = \\*D\\.\[0-9\]+;" 1
"gimple" } }
+ ! { dg-final { scan-tree-dump-times "i37 = vfun_cbind \\(307,
&\"abc37\"\\\[1\\\]\{lb: 1 sz: 1\}, &myobj2_mod, D\\.\[0-9\]+\\);" 1 "gimple" }
}
+
+ !$omp dispatch device(38) interop(obj2_loc, obj2_loc_ptr)
+ i38 = fun_cbind (308, "abc38" // c_null_char)
+ ! vfun_cbind(arg2_int, arg2_str, o2_dummy, o2_value)
+ ! { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device
\\(38\\);" 1 "gimple" } }
+ ! { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ = \\*obj2_loc_ptr;" 1
"gimple" } }
+ ! { dg-final { scan-tree-dump-times "i38 = vfun_cbind \\(308,
&\"abc38\"\\\[1\\\]\{lb: 1 sz: 1\}, &obj2_loc, D\\.\[0-9\]+\\);" 1 "gimple" } }
+
+ !$omp dispatch device(39) interop(obj2_loc_ptr, obj2_loc)
+ i39 = fun_cbind (309, "abc39" // c_null_char)
+ ! vfun_cbind(arg2_int, arg2_str, o2_dummy, o2_value)
+ ! { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device
\\(39\\);" 1 "gimple" } }
+ ! { dg-final { scan-tree-dump-times "obj2_loc\\.\[0-9\]+ = obj2_loc;" 1
"gimple" } }
+ ! { dg-final { scan-tree-dump-times "i39 = vfun_cbind \\(309,
&\"abc39\"\\\[1\\\]\{lb: 1 sz: 1\}, obj2_loc_ptr, obj2_loc\\.\[0-9\]+\\);" 1
"gimple" } }
+
+ !$omp dispatch device(40) interop(obj2_loc_alloc, myobj2_mod_alloc)
+ i40 = fun_cbind (400, "abc40" // c_null_char)
+ ! vfun_cbind(arg2_int, arg2_str, o2_dummy, o2_value)
+ ! { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device
\\(40\\);" 1 "gimple" } }
+ ! { dg-final { scan-tree-dump-times "myobj2_mod_alloc\\.\[0-9\]+ =
myobj2_mod_alloc;" 2 "gimple" } }
+ ! { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ =
\\*myobj2_mod_alloc\\.\[0-9\]+;" 1 "gimple" } }
+ ! { dg-final { scan-tree-dump-times "i40 = vfun_cbind \\(400,
&\"abc40\"\\\[1\\\]\{lb: 1 sz: 1\}, obj2_loc_alloc, D\\.\[0-9\]+\\);" 1
"gimple" } }
+
+ !$omp dispatch device(41) interop(myobj2_mod_alloc, obj2_loc_alloc)
+ i41 = fun_cbind (401, "abc41" // c_null_char)
+ ! vfun_cbind(arg2_int, arg2_str, o2_dummy, o2_value)
+ ! { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device
\\(41\\);" 1 "gimple" } }
+ ! { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ = \\*obj2_loc_alloc;" 1
"gimple" } }
+ ! See above myobj2_mod_alloc\\.\[0-9\]+ =
myobj2_mod_alloc;
+ ! { dg-final { scan-tree-dump-times "i41 = vfun_cbind \\(401,
&\"abc41\"\\\[1\\\]\{lb: 1 sz: 1\}, myobj2_mod_alloc\\.\[0-9\]+,
D\\.\[0-9\]+\\);" 1 "gimple" } }
+
+ test_fun_cbind = i30 + i31 + i32 + i33 + i34 + i35 + i36 + i37 + i38 + i39 +
i40 + i41
+end
+
+! { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ =
__builtin_omp_get_default_device \\(\\);" 24 "gimple" } }
+! { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device
\\(D\\.\[0-9\]+\\);" 24 "gimple" } }
diff --git a/gcc/testsuite/gfortran.dg/gomp/append_args-4.f90
b/gcc/testsuite/gfortran.dg/gomp/append_args-4.f90
new file mode 100644
index 000000000000..6f550842ca97
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/append_args-4.f90
@@ -0,0 +1,264 @@
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-gimple -cpp" }
+
+module my_omp_lib
+ 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 my_omp_lib
+
+module m
+ use my_omp_lib
+ implicit none (type, external)
+
+ integer(omp_interop_kind) :: myobj_mod, myobj2_mod
+ integer(omp_interop_kind), allocatable :: myobj_mod_alloc, myobj2_mod_alloc
+contains
+
+ integer function vifun (str, int_opt, alloc_str, o_dummy, o_value)
+ character(len=*) :: str
+ integer, optional, value :: int_opt
+ character(len=:), allocatable :: alloc_str
+ integer(omp_interop_kind) :: o_dummy
+ integer(omp_interop_kind), value :: o_value
+ vifun = 0
+ end
+ integer function ifun (str, int_opt, alloc_str)
+ character(len=*) :: str
+ integer, optional, value :: int_opt
+ character(len=:), allocatable :: alloc_str
+ !$omp declare variant (vifun ) match(construct={dispatch}) append_args
(interop(targetsync), interop( prefer_type ( {fr("cuda"), attr("ompx_xx")},
{attr("ompx_yy")} )))
+ ifun = 0
+ end
+
+ character(len=len(str)) function vfun (str, int_var, int_opt, alloc_str,
o2_dummy, o2_value)
+ character(len=*) :: str
+ integer, value :: int_var
+ integer, optional, value :: int_opt
+ character(len=:), allocatable :: alloc_str
+ integer(omp_interop_kind) :: o2_dummy
+ integer(omp_interop_kind), value :: o2_value
+ vfun = ""
+ end
+ character(len=len(str)) function fun (str, int_var, int_opt, alloc_str)
+ !$omp declare variant(vfun), match(construct={dispatch}),append_args
(interop(target), interop(target))
+ character(len=*) :: str
+ integer, value :: int_var
+ integer, optional, value :: int_opt
+ character(len=:), allocatable :: alloc_str
+ fun = ""
+ end
+end
+
+integer function test_ifun(obj_dummy_val, obj_dummy, obj_dummy_opt,
obj_dummy_alloc, obj_dummy_alloc_opt, obj_dummy_ptr, obj_dummy_ptr_opt)
+ use m
+ implicit none (type, external)
+
+ integer(omp_interop_kind), value :: obj_dummy_val
+ integer(omp_interop_kind) :: obj_dummy
+ integer(omp_interop_kind), optional :: obj_dummy_opt
+
+ integer(omp_interop_kind), allocatable :: obj_dummy_alloc
+ integer(omp_interop_kind), allocatable, optional :: obj_dummy_alloc_opt
+
+ integer(omp_interop_kind), pointer :: obj_dummy_ptr
+ integer(omp_interop_kind), pointer, optional :: obj_dummy_ptr_opt
+
+ integer(omp_interop_kind), target :: obj_loc
+ integer(omp_interop_kind), pointer :: obj_loc_ptr
+ integer(omp_interop_kind), allocatable :: obj_loc_alloc
+
+ character(len=:), allocatable :: str_alloc
+ integer :: i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, i21
+
+ obj_loc = omp_interop_none
+ obj_loc_ptr => obj_loc
+
+ !$omp dispatch device(10) interop(obj_dummy_val, obj_dummy)
+ i10 = ifun ("abc10", i10, str_alloc)
+ ! integer function ifun (str, int_opt, alloc_str, o_dummy, o_value)
+ ! -> int vifun (str, int_opt, alloc_str, o_dummy, o_value, .int_opt, _str,
_alloc_str)
+ ! { dg-final { scan-tree-dump-times "i10 = vifun \\(&\"abc10\"\\\[1\\\]\{lb:
1 sz: 1\}, i10, &str_alloc, &obj_dummy_val\\.\[0-9\]+, D\.\[0-9\]+, 1, 5,
&.str_alloc\\);" 1 "gimple" } }
+
+ !$omp dispatch device(11) interop(obj_dummy, obj_dummy_val)
+ i11 = ifun ("abc11", i11, str_alloc)
+ ! integer function ifun (str, int_opt, alloc_str, o_dummy, o_value)
+ ! -> int vifun (str, int_opt, alloc_str, o_dummy, o_value, .int_opt, _str,
_alloc_str)
+ ! { dg-final { scan-tree-dump-times "i11 = vifun \\(&\"abc11\"\\\[1\\\]\{lb:
1 sz: 1\}, i11, &str_alloc, obj_dummy, obj_dummy_val, 1, 5, &.str_alloc\\);" 1
"gimple" } }
+
+ !$omp dispatch device(12) interop(obj_dummy_opt, obj_dummy_alloc)
+ i12 = ifun ("abc12", i12, str_alloc)
+ ! integer function ifun (str, int_opt, alloc_str, o_dummy, o_value)
+ ! -> int vifun (str, int_opt, alloc_str, o_dummy, o_value, .int_opt, _str,
_alloc_str)
+ ! { dg-final { scan-tree-dump-times "i12 = vifun \\(&\"abc12\"\\\[1\\\]\{lb:
1 sz: 1\}, i12, &str_alloc, obj_dummy_opt, D\.\[0-9\]+, 1, 5, &.str_alloc\\);"
1 "gimple" } }
+
+ !$omp dispatch device(13) interop(obj_dummy_alloc, obj_dummy_opt)
+ i13 = ifun ("abc13", i13, str_alloc)
+ ! integer function ifun (str, int_opt, alloc_str, o_dummy, o_value)
+ ! -> int vifun (str, int_opt, alloc_str, o_dummy, o_value, .int_opt, _str,
_alloc_str)
+ ! { dg-final { scan-tree-dump-times "i13 = vifun \\(&\"abc13\"\\\[1\\\]\{lb:
1 sz: 1\}, i13, &str_alloc, D\.\[0-9\]+, D\.\[0-9\]+, 1, 5, &.str_alloc\\);" 1
"gimple" } }
+
+ !$omp dispatch device(14) interop(obj_dummy_alloc_opt, obj_dummy_ptr)
+ i14 = ifun ("abc14", i14, str_alloc)
+ ! integer function ifun (str, int_opt, alloc_str, o_dummy, o_value)
+ ! -> int vifun (str, int_opt, alloc_str, o_dummy, o_value, .int_opt, _str,
_alloc_str)
+ ! { dg-final { scan-tree-dump-times "i14 = vifun \\(&\"abc14\"\\\[1\\\]\{lb:
1 sz: 1\}, i14, &str_alloc, D\.\[0-9\]+, D\.\[0-9\]+, 1, 5, &.str_alloc\\);" 1
"gimple" } }
+
+ !$omp dispatch device(15) interop(obj_dummy_ptr, obj_dummy_alloc_opt)
+ i15 = ifun ("abc15", i15, str_alloc)
+ ! integer function ifun (str, int_opt, alloc_str, o_dummy, o_value)
+ ! -> int vifun (str, int_opt, alloc_str, o_dummy, o_value, .int_opt, _str,
_alloc_str)
+ ! { dg-final { scan-tree-dump-times "i15 = vifun \\(&\"abc15\"\\\[1\\\]\{lb:
1 sz: 1\}, i15, &str_alloc, D\.\[0-9\]+, D\.\[0-9\]+, 1, 5, &.str_alloc\\);" 1
"gimple" } }
+
+ !$omp dispatch device(16) interop(obj_dummy_ptr_opt, myobj_mod)
+ i16 = ifun ("abc16", i16, str_alloc)
+ ! integer function ifun (str, int_opt, alloc_str, o_dummy, o_value)
+ ! -> int vifun (str, int_opt, alloc_str, o_dummy, o_value, .int_opt, _str,
_alloc_str)
+ ! { dg-final { scan-tree-dump-times "i16 = vifun \\(&\"abc16\"\\\[1\\\]\{lb:
1 sz: 1\}, i16, &str_alloc, D\.\[0-9\]+, myobj_mod\\.\[0-9\]+, 1, 5,
&.str_alloc\\);" 1 "gimple" } }
+
+ !$omp dispatch device(17) interop(myobj_mod, obj_dummy_ptr_opt)
+ i17 = ifun ("abc17", i17, str_alloc)
+ ! integer function ifun (str, int_opt, alloc_str, o_dummy, o_value)
+ ! -> int vifun (str, int_opt, alloc_str, o_dummy, o_value, .int_opt, _str,
_alloc_str)
+ ! { dg-final { scan-tree-dump-times "i17 = vifun \\(&\"abc17\"\\\[1\\\]\{lb:
1 sz: 1\}, i17, &str_alloc, &myobj_mod, D\.\[0-9\]+, 1, 5, &.str_alloc\\);" 1
"gimple" } }
+
+ !$omp dispatch device(18) interop(obj_loc, obj_loc_ptr)
+ i18 = ifun ("abc18", i18, str_alloc)
+ ! integer function ifun (str, int_opt, alloc_str, o_dummy, o_value)
+ ! -> int vifun (str, int_opt, alloc_str, o_dummy, o_value, .int_opt, _str,
_alloc_str)
+ ! { dg-final { scan-tree-dump-times "i18 = vifun \\(&\"abc18\"\\\[1\\\]\{lb:
1 sz: 1\}, i18, &str_alloc, &obj_loc, D\.\[0-9\]+, 1, 5, &.str_alloc\\);" 1
"gimple" } }
+
+ !$omp dispatch device(19) interop(obj_loc_ptr, obj_loc)
+ i19 = ifun ("abc19", i19, str_alloc)
+ ! integer function ifun (str, int_opt, alloc_str, o_dummy, o_value)
+ ! -> int vifun (str, int_opt, alloc_str, o_dummy, o_value, .int_opt, _str,
_alloc_str)
+ ! { dg-final { scan-tree-dump-times "i19 = vifun \\(&\"abc19\"\\\[1\\\]\{lb:
1 sz: 1\}, i19, &str_alloc, obj_loc_ptr, obj_loc\\.\[0-9\]+, 1, 5,
&.str_alloc\\);" 1 "gimple" } }
+
+ !$omp dispatch device(20) interop(obj_loc_alloc, myobj_mod_alloc)
+ i20 = ifun ("abc20", i20, str_alloc)
+ ! integer function ifun (str, int_opt, alloc_str, o_dummy, o_value)
+ ! -> int vifun (str, int_opt, alloc_str, o_dummy, o_value, .int_opt, _str,
_alloc_str)
+ ! { dg-final { scan-tree-dump-times "i20 = vifun \\(&\"abc20\"\\\[1\\\]\{lb:
1 sz: 1\}, i20, &str_alloc, obj_loc_alloc, D\.\[0-9\]+, 1, 5, &.str_alloc\\);"
1 "gimple" } }
+
+ !$omp dispatch device(21) interop(myobj_mod_alloc, obj_loc_alloc)
+ i21 = ifun ("abc21", i21, str_alloc)
+ ! integer function ifun (str, int_opt, alloc_str, o_dummy, o_value)
+ ! -> int vifun (str, int_opt, alloc_str, o_dummy, o_value, .int_opt, _str,
_alloc_str)
+ ! { dg-final { scan-tree-dump-times "i21 = vifun \\(&\"abc21\"\\\[1\\\]\{lb:
1 sz: 1\}, i21, &str_alloc, myobj_mod_alloc\\.\[0-9\]+, D\.\[0-9\]+, 1, 5,
&.str_alloc\\);" 1 "gimple" } }
+
+ test_ifun = i10 + i11 + i12 + i13 + i14 + i15 + i16 + i17 + i18 + i19 + i20
+ i21
+end
+
+
+integer(c_int) function test_fun (obj2_dummy_val, obj2_dummy, obj2_dummy_opt,
obj2_dummy_alloc, obj2_dummy_alloc_opt, obj2_dummy_ptr, obj2_dummy_ptr_opt)
+ use m
+ implicit none (type, external)
+
+ integer(omp_interop_kind), value :: obj2_dummy_val
+ integer(omp_interop_kind) :: obj2_dummy
+ integer(omp_interop_kind), optional :: obj2_dummy_opt
+
+ integer(omp_interop_kind), allocatable :: obj2_dummy_alloc
+ integer(omp_interop_kind), allocatable, optional :: obj2_dummy_alloc_opt
+
+ integer(omp_interop_kind), pointer :: obj2_dummy_ptr
+ integer(omp_interop_kind), pointer, optional :: obj2_dummy_ptr_opt
+
+ integer(omp_interop_kind), target :: obj2_loc
+ integer(omp_interop_kind), pointer :: obj2_loc_ptr
+ integer(omp_interop_kind), allocatable :: obj2_loc_alloc
+
+ character(len=:), allocatable :: str_alloc
+ character(1) :: res_str
+ integer :: i30, i31, i32, i33, i34, i35, i36, i37, i38, i39, i40, i41
+ i30 = 0; i31 = 0; i32 = 0; i33 = 0; i34 = 0; i35 = 0; i36 = 0; i37 = 0; i38
= 0; i39 = 0; i40 = 0; i41 = 0
+
+ obj2_loc = omp_interop_none
+ obj2_loc_ptr => obj2_loc
+
+ !$omp dispatch device(30) interop(obj2_dummy, obj2_dummy_val)
+ res_str = fun ("klm30", 300, i30, str_alloc)
+ ! character(len=len(str)) function vfun (str, int_var, int_opt, alloc_str,
o2_dummy, o2_value)
+ ! -> void vfun (__result, .__result, str, int_var, int_opt, alloc_str,
o2_dummy, o2_value, .int_opt, _str, _alloc_str)
+
+ !$omp dispatch device(31) interop(obj2_dummy_val, obj2_dummy)
+ res_str = fun ("klm31", 301, i31, str_alloc)
+ ! character(len=len(str)) function vfun (str, int_var, int_opt, alloc_str,
o2_dummy, o2_value)
+ ! -> void vfun (__result, .__result, str, int_var, int_opt, alloc_str,
o2_dummy, o2_value, .int_opt, _str, _alloc_str)
+
+ !$omp dispatch device(32) interop(obj2_dummy_opt, obj2_dummy_alloc)
+ res_str = fun ("klm32", 302, i32, str_alloc)
+ ! character(len=len(str)) function vfun (str, int_var, int_opt, alloc_str,
o2_dummy, o2_value)
+ ! -> void vfun (__result, .__result, str, int_var, int_opt, alloc_str,
o2_dummy, o2_value, .int_opt, _str, _alloc_str)
+
+ !$omp dispatch device(33) interop(obj2_dummy_alloc, obj2_dummy_opt)
+ res_str = fun ("klm33", 303, i33, str_alloc)
+ ! character(len=len(str)) function vfun (str, int_var, int_opt, alloc_str,
o2_dummy, o2_value)
+ ! -> void vfun (__result, .__result, str, int_var, int_opt, alloc_str,
o2_dummy, o2_value, .int_opt, _str, _alloc_str)
+
+ !$omp dispatch device(34) interop(obj2_dummy_alloc_opt, obj2_dummy_ptr)
+ res_str = fun ("klm34", 304, i34, str_alloc)
+ ! character(len=len(str)) function vfun (str, int_var, int_opt, alloc_str,
o2_dummy, o2_value)
+ ! -> void vfun (__result, .__result, str, int_var, int_opt, alloc_str,
o2_dummy, o2_value, .int_opt, _str, _alloc_str)
+
+ !$omp dispatch device(35) interop(obj2_dummy_ptr, obj2_dummy_alloc_opt)
+ res_str = fun ("klm35", 305, i35, str_alloc)
+ ! character(len=len(str)) function vfun (str, int_var, int_opt, alloc_str,
o2_dummy, o2_value)
+ ! -> void vfun (__result, .__result, str, int_var, int_opt, alloc_str,
o2_dummy, o2_value, .int_opt, _str, _alloc_str)
+
+ !$omp dispatch device(36) interop(obj2_dummy_ptr_opt, myobj2_mod)
+ res_str = fun ("klm36", 306, i36, str_alloc)
+ ! character(len=len(str)) function vfun (str, int_var, int_opt, alloc_str,
o2_dummy, o2_value)
+ ! -> void vfun (__result, .__result, str, int_var, int_opt, alloc_str,
o2_dummy, o2_value, .int_opt, _str, _alloc_str)
+
+ !$omp dispatch device(37) interop(myobj2_mod, obj2_dummy_ptr_opt)
+ res_str = fun ("klm37", 307, i37, str_alloc)
+ ! character(len=len(str)) function vfun (str, int_var, int_opt, alloc_str,
o2_dummy, o2_value)
+ ! -> void vfun (__result, .__result, str, int_var, int_opt, alloc_str,
o2_dummy, o2_value, .int_opt, _str, _alloc_str)
+
+ !$omp dispatch device(38) interop(obj2_loc, obj2_loc_ptr)
+ res_str = fun ("klm30", 308, i38, str_alloc)
+ ! character(len=len(str)) function vfun (str, int_var, int_opt, alloc_str,
o2_dummy, o2_value)
+ ! -> void vfun (__result, .__result, str, int_var, int_opt, alloc_str,
o2_dummy, o2_value, .int_opt, _str, _alloc_str)
+
+ !$omp dispatch device(39) interop(obj2_loc_ptr, obj2_loc)
+ res_str = fun ("klm39", 309, i39, str_alloc)
+ ! character(len=len(str)) function vfun (str, int_var, int_opt, alloc_str,
o2_dummy, o2_value)
+ ! -> void vfun (__result, .__result, str, int_var, int_opt, alloc_str,
o2_dummy, o2_value, .int_opt, _str, _alloc_str)
+
+ !$omp dispatch device(40) interop(obj2_loc_alloc, myobj2_mod_alloc)
+ res_str = fun ("klm40", 400, i40, str_alloc)
+ ! character(len=len(str)) function vfun (str, int_var, int_opt, alloc_str,
o2_dummy, o2_value)
+
+ !$omp dispatch device(41) interop(myobj2_mod_alloc, obj2_loc_alloc)
+ res_str = fun ("klm41", 401, i41, str_alloc)
+ ! character(len=len(str)) function vfun (str, int_var, int_opt, alloc_str,
o2_dummy, o2_value)
+ ! -> void vfun (__result, .__result, str, int_var, int_opt, alloc_str,
o2_dummy, o2_value, .int_opt, _str, _alloc_str)
+
+ test_fun = i30 + i31 + i32 + i33 + i34 + i35 + i36 + i37 + i38 + i39 + i40 +
i41
+end
+ ! { dg-final { scan-tree-dump-times "vfun \\(&str\\.\[0-9\]+, 5,
D\\.\[0-9\]+, 300, D\\.\[0-9\]+, D\\.\[0-9\]+, obj2_dummy, obj2_dummy_val, 1,
5, &.str_alloc\\.\[0-9\]+\\);" 1 "gimple" } }
+ ! { dg-final { scan-tree-dump-times "vfun \\(&str\\.\[0-9\]+, 5,
D\\.\[0-9\]+, 301, D\\.\[0-9\]+, D\\.\[0-9\]+, &obj2_dummy_val\\.\[0-9\]+,
D\\.\[0-9\]+, 1, 5, &.str_alloc\\.\[0-9\]+\\);" 1 "gimple" } }
+ ! { dg-final { scan-tree-dump-times "vfun \\(&str\\.\[0-9\]+, 5,
D\\.\[0-9\]+, 302, D\\.\[0-9\]+, D\\.\[0-9\]+, obj2_dummy_opt, D\\.\[0-9\]+, 1,
5, &.str_alloc\\.\[0-9\]+\\);" 1 "gimple" } }
+ ! { dg-final { scan-tree-dump-times "vfun \\(&str\\.\[0-9\]+, 5,
D\\.\[0-9\]+, 303, D\\.\[0-9\]+, D\\.\[0-9\]+, D\\.\[0-9\]+, D\\.\[0-9\]+, 1,
5, &.str_alloc\\.\[0-9\]+\\);" 1 "gimple" } }
+ ! { dg-final { scan-tree-dump-times "vfun \\(&str\\.\[0-9\]+, 5,
D\\.\[0-9\]+, 304, D\\.\[0-9\]+, D\\.\[0-9\]+, D\\.\[0-9\]+, D\\.\[0-9\]+, 1,
5, &.str_alloc\\.\[0-9\]+\\);" 1 "gimple" } }
+ ! { dg-final { scan-tree-dump-times "vfun \\(&str\\.\[0-9\]+, 5,
D\\.\[0-9\]+, 305, D\\.\[0-9\]+, D\\.\[0-9\]+, D\\.\[0-9\]+, D\\.\[0-9\]+, 1,
5, &.str_alloc\\.\[0-9\]+\\);" 1 "gimple" } }
+ ! { dg-final { scan-tree-dump-times "vfun \\(&str\\.\[0-9\]+, 5,
D\\.\[0-9\]+, 306, D\\.\[0-9\]+, D\\.\[0-9\]+, D\\.\[0-9\]+,
myobj2_mod\\.\[0-9\]+, 1, 5, &.str_alloc\\.\[0-9\]+\\);" 1 "gimple" } }
+ ! { dg-final { scan-tree-dump-times "vfun \\(&str\\.\[0-9\]+, 5,
D\\.\[0-9\]+, 307, D\\.\[0-9\]+, D\\.\[0-9\]+, &myobj2_mod, D\\.\[0-9\]+, 1, 5,
&.str_alloc\\.\[0-9\]+\\);" 1 "gimple" } }
+ ! { dg-final { scan-tree-dump-times "vfun \\(&str\\.\[0-9\]+, 5,
D\\.\[0-9\]+, 308, D\\.\[0-9\]+, D\\.\[0-9\]+, &obj2_loc, D\\.\[0-9\]+, 1, 5,
&.str_alloc\\.\[0-9\]+\\);" 1 "gimple" } }
+ ! { dg-final { scan-tree-dump-times "vfun \\(&str\\.\[0-9\]+, 5,
D\\.\[0-9\]+, 309, D\\.\[0-9\]+, D\\.\[0-9\]+, obj2_loc_ptr,
obj2_loc\\.\[0-9\]+, 1, 5, &.str_alloc\\.\[0-9\]+\\);" 1 "gimple" } }
+ ! { dg-final { scan-tree-dump-times "vfun \\(&str\\.\[0-9\]+, 5,
D\\.\[0-9\]+, 400, D\\.\[0-9\]+, D\\.\[0-9\]+, obj2_loc_alloc, D\\.\[0-9\]+, 1,
5, &.str_alloc\\.\[0-9\]+\\);" 1 "gimple" } }
+ ! { dg-final { scan-tree-dump-times "vfun \\(&str\\.\[0-9\]+, 5,
D\\.\[0-9\]+, 401, D\\.\[0-9\]+, D\\.\[0-9\]+, myobj2_mod_alloc\\.\[0-9\]+,
D\\.\[0-9\]+, 1, 5, &.str_alloc\\.\[0-9\]+\\);" 1 "gimple" } }
diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-variant-2.f90
b/gcc/testsuite/gfortran.dg/gomp/declare-variant-2.f90
index 17b112f065bf..11be76e84ffc 100644
--- a/gcc/testsuite/gfortran.dg/gomp/declare-variant-2.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/declare-variant-2.f90
@@ -18,10 +18,10 @@ contains
!$omp declare variant match(user={condition(.false.)}) ! { dg-error
"expected '\\(' at .1." }
end subroutine
subroutine f6 ()
- !$omp declare variant (f1) ! { dg-error "expected 'match' or 'adjust_args'
at .1." }
+ !$omp declare variant (f1) ! { dg-error "expected 'match', 'adjust_args'
or 'append_args' at .1." }
end subroutine
subroutine f7 ()
- !$omp declare variant (f1) simd ! { dg-error "expected 'match' or
'adjust_args' at .1." }
+ !$omp declare variant (f1) simd ! { dg-error "expected 'match',
'adjust_args' or 'append_args' at .1." }
end subroutine
subroutine f8 ()
!$omp declare variant (f1) match ! { dg-error "expected '\\(' at .1." }
@@ -183,13 +183,13 @@ contains
!$omp declare variant (f1) match(construct={requires}) ! { dg-warning
"unknown selector 'requires' for context selector set 'construct' at .1." }
end subroutine
subroutine f75a ()
- !$omp declare variant(f1) ,,match(construct={dispatch})
adjust_args(need_device_ptr : c) ! { dg-error "expected 'match' or
'adjust_args' at .1." }
+ !$omp declare variant(f1) ,,match(construct={dispatch})
adjust_args(need_device_ptr : c) ! { dg-error "expected 'match',
'adjust_args' or 'append_args' at .1." }
end subroutine
subroutine f75b ()
- !$omp declare variant(f1)
match(construct={dispatch}),,adjust_args(need_device_ptr : c) ! {
dg-error "expected 'match' or 'adjust_args' at .1." }
+ !$omp declare variant(f1)
match(construct={dispatch}),,adjust_args(need_device_ptr : c) ! {
dg-error "expected 'match', 'adjust_args' or 'append_args' at .1." }
end subroutine
subroutine f75c ()
- !$omp declare variant(f1) match(construct={dispatch}),nowait(a) ! {
dg-error "expected 'match' or 'adjust_args' at .1." }
+ !$omp declare variant(f1) match(construct={dispatch}),nowait(a) ! {
dg-error "expected 'match', 'adjust_args' or 'append_args' at .1." }
end subroutine
subroutine f76 ()
!$omp declare variant (f1)
match(implementation={atomic_default_mem_order("relaxed")}) ! { dg-error
"expected identifier at .1." }
diff --git a/libgomp/ChangeLog.omp b/libgomp/ChangeLog.omp
index bc07dc1f8979..2b4d34806dee 100644
--- a/libgomp/ChangeLog.omp
+++ b/libgomp/ChangeLog.omp
@@ -1,3 +1,11 @@
+2025-01-30 Tobias Burnus <tbur...@baylibre.com>
+
+ Backported from master:
+ 2025-01-30 Tobias Burnus <tbur...@baylibre.com>
+
+ * libgomp.texi (Impl. Status): Update for accumpulated changes
+ related to 'dispatch' and interop.
+
2025-01-27 Tobias Burnus <tbur...@baylibre.com>
Backported from master:
diff --git a/libgomp/libgomp.texi b/libgomp/libgomp.texi
index 55f8a8c56e25..a6d03852f456 100644
--- a/libgomp/libgomp.texi
+++ b/libgomp/libgomp.texi
@@ -293,7 +293,8 @@ The OpenMP 4.5 specification is fully supported.
@item C/C++'s @code{declare variant} directive: elision support of
preprocessed code @tab N @tab
@item @code{declare variant}: new clauses @code{adjust_args} and
- @code{append_args} @tab P @tab Only @code{adjust_args}
+ @code{append_args} @tab P @tab For @code{append_args}, all interop
objects
+ must be specified in the @code{interop} clause of @code{dispatch}
@item @code{dispatch} construct @tab Y @tab
@item device-specific ICV settings with environment variables @tab Y @tab
@item @code{assume} and @code{assumes} directives @tab Y @tab
@@ -314,7 +315,7 @@ The OpenMP 4.5 specification is fully supported.
@item Indirect calls to the device version of a procedure or function in
@code{target} regions @tab Y @tab
@item @code{interop} directive @tab N @tab
-@item @code{omp_interop_t} object support in runtime routines @tab N @tab
+@item @code{omp_interop_t} object support in runtime routines @tab Y @tab
@item @code{nowait} clause in @code{taskwait} directive @tab Y @tab
@item Extensions to the @code{atomic} directive @tab Y @tab
@item @code{seq_cst} clause on a @code{flush} construct @tab Y @tab
@@ -412,7 +413,7 @@ to address of matching mapped list item per 5.1, Sect.
2.21.7.2 @tab N @tab
@item New @code{allocators} directive for Fortran @tab Y @tab
@item Deprecation of @code{allocate} directive for Fortran
allocatables/pointers @tab N @tab
-@item Optional paired @code{end} directive with @code{dispatch} @tab N @tab
+@item Optional paired @code{end} directive with @code{dispatch} @tab Y @tab
@item New @code{memspace} and @code{traits} modifiers for
@code{uses_allocators}
@tab N @tab
@item Deprecation of traits array following the allocator_handle expression in
@@ -447,7 +448,7 @@ to address of matching mapped list item per 5.1, Sect.
2.21.7.2 @tab N @tab
@code{OMP_TARGET_OFFLOAD=mandatory} @tab Y @tab
@item @code{all} as @emph{implicit-behavior} for @code{defaultmap} @tab Y @tab
@item @emph{interop_types} in any position of the modifier list for the
@code{init} clause
- of the @code{interop} construct @tab N @tab
+ of the @code{interop} construct @tab Y @tab
@item Invoke virtual member functions of C++ objects created on the host device
on other devices @tab N @tab
@item @code{mapper} as map-type modifier in @code{declare mapper} @tab N @tab
@@ -482,6 +483,12 @@ Technical Report (TR) 12 is the second preview for OpenMP
6.0.
@item Concept of @emph{assumed-size arrays} in C and C++
@tab N @tab
@item @emph{directive-name-modifier} accepted in all clauses @tab N @tab
+@item Extension of @code{interop} operation of @code{append_args}, allowing
+ all modifiers of the @code{init} clause @tab Y @tab
+@item New argument-free version of @code{depobj} with repeatable clauses and
+ the @code{init} clause @tab N @tab
+@item Undeprecate omitting the argument to the @code{depend} clause of
+ the argument version of the @code{depend} construct @tab Y @tab
@item For Fortran, atomic with BLOCK construct and, for C/C++, with
unlimited curly braces supported @tab N @tab
@item For Fortran, atomic compare with storing the comparison result
@@ -530,6 +537,7 @@ Technical Report (TR) 12 is the second preview for OpenMP
6.0.
@item @code{threadset} clause in task-generating constructs @tab N @tab
@item @code{nowait} clause with reverse-offload @code{target} directives
@tab N @tab
+@item Extended @emph{prefer-type} modifier to @code{init} clause @tab Y @tab
@item Boolean argument to @code{nowait} and @code{nogroup} may be non constant
@tab N @tab
@item @code{memscope} clause to @code{atomic} and @code{flush} @tab N @tab
@@ -542,6 +550,7 @@ Technical Report (TR) 12 is the second preview for OpenMP
6.0.
@code{omp_set_device_teams_thread_limit} routines @tab N @tab
@item @code{omp_target_memset} and @code{omp_target_memset_rect_async} routines
@tab N @tab
+@item Fortran version of the interop runtime routines @tab Y @tab
@item Routines for obtaining memory spaces/allocators for shared/device memory
@tab N @tab
@item @code{omp_get_memspace_num_resources} routine @tab N @tab
