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.
This commit is contained in:
Tobias Burnus 2025-01-30 11:28:50 +01:00
parent 6b56e645a7
commit bea86e8214
28 changed files with 1895 additions and 131 deletions

View file

@ -27090,7 +27090,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;
@ -27115,17 +27118,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 %<,%>"))
@ -27143,9 +27148,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;
@ -27155,6 +27158,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))
@ -27162,7 +27170,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;
@ -27171,13 +27179,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))

View file

@ -8473,27 +8473,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++)
@ -8598,7 +8604,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;
}
@ -8641,6 +8647,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));

View file

@ -50529,17 +50529,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 %<,%>");
@ -50559,6 +50561,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));

View file

@ -12160,13 +12160,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))
{
@ -18015,7 +18029,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

View file

@ -1749,6 +1749,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. */

View file

@ -2112,33 +2112,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)
gfc_parser_omp_clause_init_modifiers (bool &target, bool &targetsync,
char **type_str, int &type_str_len,
bool is_init_clause)
{
bool target = false, targetsync = false;
char *type_str = NULL;
int type_str_len = 0;
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)
@ -2153,11 +2171,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;
@ -2175,11 +2200,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;
@ -2187,7 +2219,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;
@ -2196,6 +2228,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)
@ -6616,32 +6663,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;
}
@ -6653,6 +6707,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)
!= MATCH_YES)
@ -6688,20 +6748,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;
}

View file

@ -8777,6 +8777,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))
@ -8785,18 +8813,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;
}
@ -8812,15 +8895,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))
{
@ -8828,6 +8909,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)
{
@ -8865,12 +8996,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));
}
}
}
}

View file

@ -4310,9 +4310,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
@ -4320,6 +4331,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",
@ -4332,6 +4346,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)
@ -4369,7 +4388,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);
@ -4384,34 +4403,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),
@ -4429,8 +4490,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)

View file

@ -23,34 +23,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)
{

View file

@ -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()

View file

@ -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" } } */

View file

@ -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" } } */

View file

@ -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" } } */

View file

@ -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;
}

View file

@ -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 } */

View file

@ -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 } */

View file

@ -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" } } */

View file

@ -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;
}

View file

@ -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" } } */

View file

@ -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 } */

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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" } }

View file

@ -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" } }

View file

@ -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." }

View file

@ -294,7 +294,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
@ -315,7 +316,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
@ -407,7 +408,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
@ -440,7 +441,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
@ -483,7 +484,7 @@ to address of matching mapped list item per 5.1, Sect. 2.21.7.2 @tab N @tab
@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 N @tab
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
@ -575,7 +576,7 @@ to address of matching mapped list item per 5.1, Sect. 2.21.7.2 @tab N @tab
@item @code{target_data} as composite construct @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 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
@ -596,7 +597,7 @@ to address of matching mapped list item per 5.1, Sect. 2.21.7.2 @tab N @tab
@code{omp_set_device_teams_thread_limit} routines @tab N @tab
@item @code{omp_target_memset} and @code{omp_target_memset_async} routines
@tab N @tab
@item Fortran version of the interop runtime 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