diff options
| author | Tobias Burnus <tburnus@baylibre.com> | 2025-01-30 11:28:50 +0100 |
|---|---|---|
| committer | Tobias Burnus <tburnus@baylibre.com> | 2025-01-30 11:28:50 +0100 |
| commit | bea86e82146b9b3655e8073eef37723832862ed4 (patch) | |
| tree | 9ef41200a7a22c6feb58a818ac91b4ddb33dd52d | |
| parent | 6b56e645a7b481693fe6982f8f09ba2e07768bf8 (diff) | |
| download | gcc-bea86e82146b9b3655e8073eef37723832862ed4.zip gcc-bea86e82146b9b3655e8073eef37723832862ed4.tar.gz gcc-bea86e82146b9b3655e8073eef37723832862ed4.tar.bz2 | |
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.
28 files changed, 1896 insertions, 132 deletions
diff --git a/gcc/c/c-parser.cc b/gcc/c/c-parser.cc index 4f40dfc..aa68ee2 100644 --- a/gcc/c/c-parser.cc +++ b/gcc/c/c-parser.cc @@ -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)) diff --git a/gcc/cp/decl.cc b/gcc/cp/decl.cc index a0e3c9f..cf5e055 100644 --- a/gcc/cp/decl.cc +++ b/gcc/cp/decl.cc @@ -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)); diff --git a/gcc/cp/parser.cc b/gcc/cp/parser.cc index 7ddb7f1..44515bb 100644 --- a/gcc/cp/parser.cc +++ b/gcc/cp/parser.cc @@ -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)); diff --git a/gcc/cp/pt.cc b/gcc/cp/pt.cc index 2811afe..77583dd 100644 --- a/gcc/cp/pt.cc +++ b/gcc/cp/pt.cc @@ -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 diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 825dc2a..83e4f3f 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -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. */ diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc index 35661d8..5eef5eb 100644 --- a/gcc/fortran/openmp.cc +++ b/gcc/fortran/openmp.cc @@ -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) -{ - bool target = false, targetsync = false; - char *type_str = NULL; - int type_str_len = 0; +gfc_parser_omp_clause_init_modifiers (bool &target, bool &targetsync, + char **type_str, int &type_str_len, + bool is_init_clause) +{ + target = false; + targetsync = false; + *type_str = NULL; + type_str_len = 0; match m; locus old_loc = gfc_current_locus; do { if (gfc_match ("prefer_type ( ") == MATCH_YES) { - if (type_str) + if (*type_str) { gfc_error ("Duplicate %<prefer_type%> modifier at %C"); return MATCH_ERROR; } - m = gfc_match_omp_prefer_type (&type_str, &type_str_len); + m = gfc_match_omp_prefer_type (type_str, &type_str_len); if (m != MATCH_YES) return m; if (gfc_match (", ") == MATCH_YES) continue; - if (gfc_match (": ") == MATCH_YES) - break; - gfc_error ("Expected %<,%> or %<:%> at %C"); + if (is_init_clause) + { + if (gfc_match (": ") == MATCH_YES) + break; + gfc_error ("Expected %<,%> or %<:%> at %C"); + } + else + { + if (gfc_match (") ") == MATCH_YES) + break; + gfc_error ("Expected %<,%> or %<)%> at %C"); + } return MATCH_ERROR; } if (gfc_match ("targetsync ") == MATCH_YES) @@ -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; } diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc index d3ebc9b..160dc84 100644 --- a/gcc/fortran/trans-openmp.cc +++ b/gcc/fortran/trans-openmp.cc @@ -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)); + } } } } diff --git a/gcc/gimplify.cc b/gcc/gimplify.cc index 02b4329..cc0172c 100644 --- a/gcc/gimplify.cc +++ b/gcc/gimplify.cc @@ -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) diff --git a/gcc/testsuite/c-c++-common/gomp/append-args-1.c b/gcc/testsuite/c-c++-common/gomp/append-args-1.c index 5bfd50d..2a47063 100644 --- a/gcc/testsuite/c-c++-common/gomp/append-args-1.c +++ b/gcc/testsuite/c-c++-common/gomp/append-args-1.c @@ -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) { diff --git a/gcc/testsuite/c-c++-common/gomp/append-args-3.c b/gcc/testsuite/c-c++-common/gomp/append-args-3.c index 7e08a2d..eaa42c4 100644 --- a/gcc/testsuite/c-c++-common/gomp/append-args-3.c +++ b/gcc/testsuite/c-c++-common/gomp/append-args-3.c @@ -52,9 +52,9 @@ void varvar1(int, int, omp_interop_t, ...); #pragma omp declare variant(varvar1) match(construct={dispatch}) append_args(interop(target,targetsync)) void varbase1(int x, int y, ...); -void varvar2(int, int *, omp_interop_t, ...); +void varvar2(int, int *, omp_interop_t, ...) { } #pragma omp declare variant(varvar2) match(construct={dispatch}) append_args(interop(target,targetsync)) adjust_args(need_device_ptr: y) -void varbase2(int x, int *y, ...); +void varbase2(int x, int *y, ...) { } void bar() diff --git a/gcc/testsuite/c-c++-common/gomp/append-args-6.c b/gcc/testsuite/c-c++-common/gomp/append-args-6.c new file mode 100644 index 0000000..d96e5a1 --- /dev/null +++ b/gcc/testsuite/c-c++-common/gomp/append-args-6.c @@ -0,0 +1,106 @@ +/* { dg-additional-options "-fdump-tree-gimple" } */ + +#if __cplusplus >= 201103L +# define __GOMP_UINTPTR_T_ENUM : __UINTPTR_TYPE__ +#else +# define __GOMP_UINTPTR_T_ENUM +#endif + +typedef enum omp_interop_t __GOMP_UINTPTR_T_ENUM +{ + omp_interop_none = 0, + __omp_interop_t_max__ = __UINTPTR_MAX__ +} omp_interop_t; + +typedef enum omp_interop_fr_t +{ + omp_ifr_cuda = 1, + omp_ifr_cuda_driver = 2, + omp_ifr_opencl = 3, + omp_ifr_sycl = 4, + omp_ifr_hip = 5, + omp_ifr_level_zero = 6, + omp_ifr_hsa = 7, + omp_ifr_last = omp_ifr_hsa +} omp_interop_fr_t; + + + +void g(int, const char *, int *, int *, omp_interop_t, omp_interop_t) { } +#pragma omp declare variant(g) match(construct={dispatch}) \ + append_args(interop(target,prefer_type( {fr("cuda") }, {fr(omp_ifr_hsa)} , {attr("ompx_a") } , {fr(omp_ifr_hip) }), targetsync), \ + interop(targetsync, prefer_type("cuda", "hsa"))) adjust_args(need_device_ptr : y, k) +void f(int x, const char *y, int *, int *k) { } + + +void gvar(int, const char *, int *, int *, omp_interop_t, omp_interop_t, ...) { } +#pragma omp declare variant(gvar) match(construct={dispatch}) \ + append_args(interop(target,prefer_type( {fr("cuda") }, {fr(omp_ifr_hsa)} , {attr("ompx_a") } , {fr(omp_ifr_hip) }), targetsync), \ + interop(targetsync, prefer_type("cuda", "hsa"))) adjust_args(need_device_ptr : y, k) +void fvar(int x, const char *y, int *, int *k, ...) { } + + + +void foo(const char *cp1, const char *cp2, int *a, int *b, int *c) +{ + omp_interop_t obj1, obj2, obj3, obj4; + obj1 = obj2 = obj3 = obj4 = omp_interop_none; + + #pragma omp dispatch device(5) interop(obj1,obj2) is_device_ptr(cp1) + f(3, cp1, a, b); + + #pragma omp dispatch device(4) interop(obj3,obj4) is_device_ptr(a,b,c) + fvar(99, cp2, a, b, c, a, b, c, a, b, c); +} + + + + +int *fi(); + +struct t { + int *a, *b; +}; + +void fancy(int *x, int *y, omp_interop_t) { } + +#pragma omp declare variant(fancy) match(construct={dispatch}) adjust_args(need_device_ptr: x,y) \ + append_args( interop (prefer_type(omp_ifr_hip), target) ) +void bar(int *x, int *y); + +void sub(struct t *s, void *y, const omp_interop_t obj5, omp_interop_t obj6) +{ + bar( fi(), s->b); + + // This is a bit questionable as dereferencing 's' as device pointer might not work (unspecified behavior); + // but if for 's->b' it would still be need even if 's' was a device + host accessible pointer. + #pragma omp dispatch device(3) is_device_ptr(s) interop(obj5) + bar( fi(), s->b); + + bar( (int *) y, s->b); + #pragma omp dispatch interop(obj6) is_device_ptr(y) + bar( (int *) y, s->b); +} + + +/* { dg-final { scan-tree-dump-times "D\.\[0-9\]+ = __builtin_omp_get_default_device \\(\\);" 4 "gimple" } } */ + +/* { dg-final { scan-tree-dump-times "D\.\[0-9\]+ = __builtin_omp_get_interop_int \\(obj6, -5, 0B\\);" 1 "gimple" } } */ + +/* { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device \\(5\\);" 1 "gimple" } } */ +/* { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device \\(4\\);" 1 "gimple" } } */ +/* { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device \\(3\\);" 1 "gimple" } } */ +/* { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device \\(D\.\[0-9\]+\\);" 5 "gimple" } } */ + +/* { dg-final { scan-tree-dump-times "D\.\[0-9\]+ = __builtin_omp_get_mapped_ptr \\(b, 5\\);" 1 "gimple" } } */ +/* { dg-final { scan-tree-dump-times "D\.\[0-9\]+ = __builtin_omp_get_mapped_ptr \\(cp2, 4\\);" 1 "gimple" } } */ +/* { dg-final { scan-tree-dump-times "D\.\[0-9\]+ = __builtin_omp_get_mapped_ptr \\(cp2, 4\\);" 1 "gimple" } } */ +/* { dg-final { scan-tree-dump-times "D\.\[0-9\]+ = __builtin_omp_get_mapped_ptr \\(cp2, 4\\);" 1 "gimple" } } */ +/* { dg-final { scan-tree-dump-times "D\.\[0-9\]+ = __builtin_omp_get_mapped_ptr \\(D\.\[0-9\]+, 3\\);" 2 "gimple" } } */ +/* { dg-final { scan-tree-dump-times "D\.\[0-9\]+ = __builtin_omp_get_mapped_ptr \\(D\.\[0-9\]+, D\.\[0-9\]+\\);" 1 "gimple" } } */ + +/* { dg-final { scan-tree-dump-times "g \\(3, cp1, a, D\.\[0-9\]+, obj1, obj2\\);" 1 "gimple" } } */ +/* { dg-final { scan-tree-dump-times "gvar \\(99, D\.\[0-9\]+, a, b, obj3, obj4, c, a, b, c, a, b, c\\);" 1 "gimple" } } */ + +/* { dg-final { scan-tree-dump-times "fancy \\(D\.\[0-9\]+, D\.\[0-9\]+, obj5\\);" 1 "gimple" } } */ +/* { dg-final { scan-tree-dump-times "fancy \\(y, D\.\[0-9\]+, obj6\\);" 1 "gimple" } } */ diff --git a/gcc/testsuite/c-c++-common/gomp/append-args-7.c b/gcc/testsuite/c-c++-common/gomp/append-args-7.c new file mode 100644 index 0000000..b7dff8a --- /dev/null +++ b/gcc/testsuite/c-c++-common/gomp/append-args-7.c @@ -0,0 +1,47 @@ +/* { dg-additional-options "-fdump-tree-gimple" } */ + +#if __cplusplus >= 201103L +# define __GOMP_UINTPTR_T_ENUM : __UINTPTR_TYPE__ +#else +# define __GOMP_UINTPTR_T_ENUM +#endif + +typedef enum omp_interop_t __GOMP_UINTPTR_T_ENUM +{ + omp_interop_none = 0, + __omp_interop_t_max__ = __UINTPTR_MAX__ +} omp_interop_t; + +void f1(...) { } +#pragma omp declare variant(f1) match(construct={dispatch}) +void g1(...) { } + + +void f2(...) { } +/* { dg-error "argument 1 of 'f2' must be of 'omp_interop_t'" "" { target c } .-1 } */ +/* { dg-error "argument 1 of 'void f2\\(\\.\\.\\.\\)' must be of 'omp_interop_t'" "" { target c++ } .-2 } */ +#pragma omp declare variant(f2) append_args(interop(target), interop(prefer_type("cuda"))) \ + match(construct={dispatch}) +void g2(...) { } +/* { dg-note "'append_args' specified here" "" { target *-*-* } .-3 } */ + + +void f3(omp_interop_t, omp_interop_t, ...) { } +#pragma omp declare variant(f3) append_args(interop(target), interop(prefer_type("cuda"))) \ + match(construct={dispatch}) +void g3(...) { } + + +void foo (int *a, char *cp, int d) { + omp_interop_t obj1 = omp_interop_none; + omp_interop_t obj2 = omp_interop_none; + #pragma omp dispatch interop(obj1, obj2) device(22) + g3(1, a, cp, d); +} + +/* { dg-final { scan-tree-dump-times "D\.\[0-9\]+ = __builtin_omp_get_default_device \\(\\);" 1 "gimple" } } */ + +/* { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device \\(22\\);" 1 "gimple" } } */ +/* { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device \\(D\.\[0-9\]+\\);" 1 "gimple" } } */ + +/* { dg-final { scan-tree-dump-times "f3 \\(obj1, obj2, 1, a, cp, d\\);" 1 "gimple" } } */ diff --git a/gcc/testsuite/c-c++-common/gomp/append-args-8.c b/gcc/testsuite/c-c++-common/gomp/append-args-8.c new file mode 100644 index 0000000..fb442db --- /dev/null +++ b/gcc/testsuite/c-c++-common/gomp/append-args-8.c @@ -0,0 +1,53 @@ +/* { dg-additional-options "-fdump-tree-gimple" } */ + +#if __cplusplus >= 201103L +# define __GOMP_UINTPTR_T_ENUM : __UINTPTR_TYPE__ +#else +# define __GOMP_UINTPTR_T_ENUM +#endif + +typedef enum omp_interop_t __GOMP_UINTPTR_T_ENUM +{ + omp_interop_none = 0, + __omp_interop_t_max__ = __UINTPTR_MAX__ +} omp_interop_t; + +void f1(omp_interop_t) { } +#pragma omp declare variant(f1) match(construct={dispatch}) \ + append_args(interop(prefer_type({attr("ompx_fun")}))) +void g1(void); + + +int f2(omp_interop_t, omp_interop_t); +#pragma omp declare variant(f2) append_args(interop(prefer_type("cuda")), \ + interop(prefer_type({fr("hsa")}),target)) \ + match(construct={dispatch}) +int g2(void) { return 5; } + +int foo (omp_interop_t obj1) +{ + omp_interop_t obj2 = omp_interop_none; + int res; + + #pragma omp dispatch interop(obj1) device(11) + g1(); + + #pragma omp dispatch interop(obj1, obj2) device(22) + g2(); + + #pragma omp dispatch interop(obj2, obj1) device(33) + res = g2(); + + return res; +} + +/* { dg-final { scan-tree-dump-times "D\.\[0-9\]+ = __builtin_omp_get_default_device \\(\\);" 3 "gimple" } } */ + +/* { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device \\(11\\);" 1 "gimple" } } */ +/* { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device \\(22\\);" 1 "gimple" } } */ +/* { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device \\(33\\);" 1 "gimple" } } */ +/* { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device \\(D\.\[0-9\]+\\);" 3 "gimple" } } */ + +/* { dg-final { scan-tree-dump-times " f1 \\(obj1\\);" 1 "gimple" } } */ +/* { dg-final { scan-tree-dump-times " f2 \\(obj1, obj2\\);" 1 "gimple" } } */ +/* { dg-final { scan-tree-dump-times " res = f2 \\(obj2, obj1\\);" 1 "gimple" } } */ diff --git a/gcc/testsuite/c-c++-common/gomp/append-args-9.c b/gcc/testsuite/c-c++-common/gomp/append-args-9.c new file mode 100644 index 0000000..b8586e0 --- /dev/null +++ b/gcc/testsuite/c-c++-common/gomp/append-args-9.c @@ -0,0 +1,34 @@ +#if __cplusplus >= 201103L +# define __GOMP_UINTPTR_T_ENUM : __UINTPTR_TYPE__ +#else +# define __GOMP_UINTPTR_T_ENUM +#endif + +typedef enum omp_interop_t __GOMP_UINTPTR_T_ENUM +{ + omp_interop_none = 0, + __omp_interop_t_max__ = __UINTPTR_MAX__ +} omp_interop_t; + +void f1(omp_interop_t *) { } +/* { dg-error "argument 1 of 'f1' must be of 'omp_interop_t'" "" { target c } .-1 } */ +/* { dg-note "initializing argument 1 of 'void f1\\(omp_interop_t\\*\\)'" "" { target c++ } .-2 } */ +#pragma omp declare variant(f1) match(construct={dispatch}) \ + append_args(interop(prefer_type({attr("ompx_fun")}))) +void g1(void); +/* { dg-note "'append_args' specified here" "" { target c } .-2 } */ +/* { dg-error "cannot convert 'omp_interop_t' to 'omp_interop_t\\*'" "" { target c++ } .-4 } */ + +int f2(omp_interop_t); +#pragma omp declare variant(f2) append_args(interop(prefer_type("cuda"))) \ + match(construct={dispatch}) +int g2(void) { return 5; } + +int foo (omp_interop_t *obj1) +{ + int res; + + #pragma omp dispatch interop(obj1) device(11) /* { dg-error "'obj1' must be of 'omp_interop_t'" } */ + res = g2(); + return res; +} diff --git a/gcc/testsuite/g++.dg/gomp/append-args-1.C b/gcc/testsuite/g++.dg/gomp/append-args-1.C index 2fbb21a..7ff4023 100644 --- a/gcc/testsuite/g++.dg/gomp/append-args-1.C +++ b/gcc/testsuite/g++.dg/gomp/append-args-1.C @@ -20,8 +20,8 @@ template<typename T> float base1(T); -/* { dg-message "sorry, unimplemented: 'append_args' clause not yet supported for 'float repl1\\(T, T2, T2\\) \\\[with T = omp_interop_t; T2 = omp_interop_t\\\]'" "" { target *-*-* } .-5 } */ -/* { dg-message "sorry, unimplemented: 'append_args' clause not yet supported for 'float repl1\\(T, T2, T2\\) \\\[with T = float; T2 = omp_interop_t\\\]'" "" { target *-*-* } .-6 } */ +/* { dg-message "sorry, unimplemented: 'append_args' clause not yet supported for 'float repl1\\(T, T2, T2\\) \\\[with T = omp_interop_t; T2 = omp_interop_t\\\]', except when specifying all 2 objects in the 'interop' clause of the 'dispatch' directive" "" { target *-*-* } .-5 } */ +/* { dg-message "sorry, unimplemented: 'append_args' clause not yet supported for 'float repl1\\(T, T2, T2\\) \\\[with T = float; T2 = omp_interop_t\\\]', except when specifying all 2 objects in the 'interop' clause of the 'dispatch' directive" "" { target *-*-* } .-6 } */ @@ -45,7 +45,7 @@ void repl99(T); append_args(interop(target, targetsync, prefer_type("cuda"))) void base99(); -/* { dg-message "sorry, unimplemented: 'append_args' clause not yet supported for 'void repl99\\(T\\) \\\[with T = omp_interop_t\\\]'" "" { target *-*-* } .-3 } */ +/* { dg-message "sorry, unimplemented: 'append_args' clause not yet supported for 'void repl99\\(T\\) \\\[with T = omp_interop_t\\\]', except when specifying all 1 objects in the 'interop' clause of the 'dispatch' directive" "" { target *-*-* } .-3 } */ @@ -57,8 +57,8 @@ void repl2(T, T2, T3, T3); template<typename T, typename T2> void base2(T x, T2 y); -/* { dg-message "sorry, unimplemented: 'append_args' clause not yet supported for 'void repl2\\(T, T2, T3, T3\\) \\\[with T = int\\*; T2 = int\\*; T3 = omp_interop_t\\\]'" "" { target *-*-* } .-5 } */ -/* { dg-message "sorry, unimplemented: 'append_args' clause not yet supported for 'void repl2\\(T, T2, T3, T3\\) \\\[with T = int\\*; T2 = omp_interop_t; T3 = omp_interop_t\\\]'" "" { target *-*-* } .-6 } */ +/* { dg-message "sorry, unimplemented: 'append_args' clause not yet supported for 'void repl2\\(T, T2, T3, T3\\) \\\[with T = int\\*; T2 = int\\*; T3 = omp_interop_t\\\]', except when specifying all 2 objects in the 'interop' clause of the 'dispatch' directive" "" { target *-*-* } .-5 } */ +/* { dg-message "sorry, unimplemented: 'append_args' clause not yet supported for 'void repl2\\(T, T2, T3, T3\\) \\\[with T = int\\*; T2 = omp_interop_t; T3 = omp_interop_t\\\]', except when specifying all 2 objects in the 'interop' clause of the 'dispatch' directive" "" { target *-*-* } .-6 } */ template<typename T,typename T3> @@ -83,7 +83,7 @@ void repl3(T, T2, ...); template<typename T> void base3(T, ...); -/* { dg-message "sorry, unimplemented: 'append_args' clause not yet supported for 'void repl3\\(T, T2, \.\.\.\\) \\\[with T = int\\*; T2 = omp_interop_t\\\]'" "" { target *-*-* } .-4 } */ +/* { dg-message "sorry, unimplemented: 'append_args' clause not yet supported for 'void repl3\\(T, T2, \.\.\.\\) \\\[with T = int\\*; T2 = omp_interop_t\\\]', except when specifying all 1 objects in the 'interop' clause of the 'dispatch' directive" "" { target *-*-* } .-4 } */ diff --git a/gcc/testsuite/g++.dg/gomp/append-args-4.C b/gcc/testsuite/g++.dg/gomp/append-args-4.C new file mode 100644 index 0000000..bdae6f1 --- /dev/null +++ b/gcc/testsuite/g++.dg/gomp/append-args-4.C @@ -0,0 +1,17 @@ +/* Check the error when 'omp_interop_t' is not defined and the variant function + is found via Argument-dependent lookup; in that case, 'g' is not yet resolved + to a decl but is an indentifier node. Hence, the location is suboptimal, but + we get at least an error. */ + +namespace N { + class C{ + public: + }; + void g(C *c); +} + +#pragma omp declare variant (g) match (construct={dispatch}) adjust_args (need_device_ptr: c) append_args (interop(target)) +void f3(N::C *c); + +/* { dg-error "30: argument 2 of 'g' must be of 'omp_interop_t'" "" { target *-*-* } .-3 } */ +/* { dg-note "108: 'append_args' specified here" "" { target *-*-* } .-4 } */ diff --git a/gcc/testsuite/g++.dg/gomp/append-args-5.C b/gcc/testsuite/g++.dg/gomp/append-args-5.C new file mode 100644 index 0000000..d5a3a78 --- /dev/null +++ b/gcc/testsuite/g++.dg/gomp/append-args-5.C @@ -0,0 +1,72 @@ +/* { dg-additional-options "-fdump-tree-gimple" } */ + +/* Check that adjust_args applies to the right argument, + if C++ inserts a 'this' pointer. */ + +#if __cplusplus >= 201103L +# define __GOMP_UINTPTR_T_ENUM : __UINTPTR_TYPE__ +#else +# define __GOMP_UINTPTR_T_ENUM +#endif + +typedef enum omp_interop_t __GOMP_UINTPTR_T_ENUM +{ + omp_interop_none = 0, + __omp_interop_t_max__ = __UINTPTR_MAX__ +} omp_interop_t; + + +struct t1 { + void f1(int *x, int *y, int *z, omp_interop_t); + #pragma omp declare variant(f1) match(construct={dispatch}) \ + adjust_args(need_device_ptr : y) \ + append_args( interop(target)) + void g1(int *x, int *y, int *z); +}; + +struct t2 { + void f2(int *x, int *y, int *z, omp_interop_t, ...); + #pragma omp declare variant(f2) match(construct={dispatch}) \ + adjust_args(need_device_ptr : x, y, z) \ + append_args( interop(prefer_type("cuda","hip","hsa"),target, targetsync)) + void g2(int *x, int *y, int *z, ...); +}; + + +omp_interop_t obj1, obj2; + +void test(int *a1, int *b1, int *c1, + int *a2, int *b2, int *c2, + int *a3, int *b3, int *c3, + int *x1, int *x2, int *x3, + int *y1, int *y2, int *y3) +{ + struct t1 s1; + struct t2 s2; + + #pragma omp dispatch interop(obj1) + s1.g1 (a1, b1, c1); + + #pragma omp dispatch interop(obj2) device(5) + s2.g2 (a2, b2, c2, y1, y2, y3); +} + + +/* { dg-final { scan-tree-dump-times "D\.\[0-9\]+ = __builtin_omp_get_default_device \\(\\);" 2 "gimple" } } */ + +/* { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device \\(D\.\[0-9\]+\\);" 3 "gimple" } } */ +/* { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device \\(5\\);" 1 "gimple" } } */ + +/* { dg-final { scan-tree-dump-times "obj1.\[0-9\] = obj1;" 2 "gimple" } } */ +/* { dg-final { scan-tree-dump-times "obj2.\[0-9\] = obj2;" 1 "gimple" } } */ + +/* { dg-final { scan-tree-dump-times "D\.\[0-9\]+ = __builtin_omp_get_interop_int \\(obj1.\[0-9\], -5, 0B\\);" 1 "gimple" } } */ + +/* { dg-final { scan-tree-dump-times "__builtin_omp_get_mapped_ptr" 4 "gimple" } } */ +/* { dg-final { scan-tree-dump-times "D\.\[0-9\]+ = __builtin_omp_get_mapped_ptr \\(b1, D\.\[0-9\]+\\);" 1 "gimple" } } */ +/* { dg-final { scan-tree-dump-times "D\.\[0-9\]+ = __builtin_omp_get_mapped_ptr \\(c2, 5\\);" 1 "gimple" } } */ +/* { dg-final { scan-tree-dump-times "D\.\[0-9\]+ = __builtin_omp_get_mapped_ptr \\(b2, 5\\);" 1 "gimple" } } */ +/* { dg-final { scan-tree-dump-times "D\.\[0-9\]+ = __builtin_omp_get_mapped_ptr \\(a2, 5\\);" 1 "gimple" } } */ + +/* { dg-final { scan-tree-dump-times "t1::f1 \\(&s1, a1, D\.\[0-9\]+, c1, obj1.\[0-9\]\\);" 1 "gimple" } } */ +/* { dg-final { scan-tree-dump-times "t2::f2 \\(&s2, D\.\[0-9\]+, D\.\[0-9\]+, D\.\[0-9\]+, obj2.\[0-9\], y1, y2, y3\\);" 1 "gimple" } } */ diff --git a/gcc/testsuite/g++.dg/gomp/append-args-6.C b/gcc/testsuite/g++.dg/gomp/append-args-6.C new file mode 100644 index 0000000..039d9fa --- /dev/null +++ b/gcc/testsuite/g++.dg/gomp/append-args-6.C @@ -0,0 +1,34 @@ +#if __cplusplus >= 201103L +# define __GOMP_UINTPTR_T_ENUM : __UINTPTR_TYPE__ +#else +# define __GOMP_UINTPTR_T_ENUM +#endif + +typedef enum omp_interop_t __GOMP_UINTPTR_T_ENUM +{ + omp_interop_none = 0, + __omp_interop_t_max__ = __UINTPTR_MAX__ +} omp_interop_t; + +void f1(omp_interop_t &) { } +/* { dg-error "argument 1 of 'f1' must be of 'omp_interop_t'" "" { target c } .-1 } */ +/* { dg-note "initializing argument 1 of 'void f1\\(omp_interop_t&\\)'" "" { target c++ } .-2 } */ +#pragma omp declare variant(f1) match(construct={dispatch}) \ + append_args(interop(prefer_type({attr("ompx_fun")}))) +void g1(void); +/* { dg-note "'append_args' specified here" "" { target c } .-2 } */ +/* { dg-error "cannot bind non-const lvalue reference of type 'omp_interop_t&' to an rvalue of type 'omp_interop_t'" "" { target c++ } .-4 } */ + +int f2(omp_interop_t); +#pragma omp declare variant(f2) append_args(interop(prefer_type("cuda"))) \ + match(construct={dispatch}) +int g2(void) { return 5; } + +int foo (omp_interop_t &obj1) +{ + int res; + + #pragma omp dispatch interop(obj1) device(11) /* { dg-error "'obj1' must be of 'omp_interop_t'" } */ + res = g2(); + return res; +} diff --git a/gcc/testsuite/g++.dg/gomp/append-args-7.C b/gcc/testsuite/g++.dg/gomp/append-args-7.C new file mode 100644 index 0000000..97df32e --- /dev/null +++ b/gcc/testsuite/g++.dg/gomp/append-args-7.C @@ -0,0 +1,113 @@ +/* { dg-do compile { target c++11 } } */ +/* { dg-additional-options "-fdump-tree-gimple" } */ + + +#if __cplusplus >= 201103L +# define __GOMP_UINTPTR_T_ENUM : __UINTPTR_TYPE__ +#else +# define __GOMP_UINTPTR_T_ENUM +#endif + +typedef enum omp_interop_t __GOMP_UINTPTR_T_ENUM +{ + omp_interop_none = 0, + __omp_interop_t_max__ = __UINTPTR_MAX__ +} omp_interop_t; + +typedef enum omp_interop_fr_t +{ + omp_ifr_cuda = 1, + omp_ifr_cuda_driver = 2, + omp_ifr_opencl = 3, + omp_ifr_sycl = 4, + omp_ifr_hip = 5, + omp_ifr_level_zero = 6, + omp_ifr_hsa = 7, + omp_ifr_last = omp_ifr_hsa +} omp_interop_fr_t; + + +template<typename T2> +float repl0(T2, T2); +#pragma omp declare variant(repl0) match(construct={dispatch}) append_args(interop(target,prefer_type(1,5,4)), interop(targetsync)) +float base0(); + + + +template<typename T, typename T2> +float repl1(T x, T2 y, T2 z) { return sizeof(x) + y == z; } +#pragma omp declare variant(repl1) match(construct={dispatch}) append_args(interop(target,prefer_type(1,5,4,sizeof(T))), interop(targetsync)) +template<typename T> +float base1(T x) { return x + 42; } + + + +template<typename T, typename T2, typename T3> +void repl3inval(T, T2, T3); +#pragma omp declare variant(repl3inval) match(construct={dispatch}) adjust_args(nothing : y) \ + append_args(interop(prefer_type({fr(3), attr("ompx_nop")},{fr(2)},{attr("ompx_all")}),target,targetsync)) +template<typename T, typename T2> +void base2inval(T x, T2 y); + + + +template<typename T> +void repl99(T); +#pragma omp declare variant(repl99) match(construct={dispatch}) \ + append_args(interop(target, targetsync, prefer_type("cuda"))) +template<typename T> +void base99(); + + + +template<typename T, typename T2, typename T3> +void repl2(T, T2, T3, T3); +#pragma omp declare variant(repl2) match(construct={dispatch}) adjust_args(need_device_ptr : y) \ + append_args(interop(target, targetsync, prefer_type(1)), \ + interop(prefer_type({fr(3), attr("ompx_nop")},{fr(2)},{attr("ompx_all")}))) +template<typename T, typename T2> +void base2(T x, T2 y); + + +omp_interop_t obj2, obj3; + +void +test_it (char *str, int i, int *ip, float *fp, omp_interop_t obj1) +{ + #pragma omp dispatch interop(obj2, obj1) device(99) + base0 (); + + float f2; + #pragma omp dispatch interop(obj1, obj2) device(14) + f2 = base1 (*fp); + fp[0] = f2; + + #pragma omp dispatch interop(obj1) + base2inval (str, i); + + #pragma omp dispatch interop(obj2) device(21) + base99<double>(); + + #pragma omp dispatch interop(obj3, obj1) device(31) + base2(fp, ip); +} + + + +/* { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ = __builtin_omp_get_default_device \\(\\);" 5 "gimple" } } */ + +/* { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device \\(99\\);" 1 "gimple" } } */ +/* { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device \\(14\\);" 1 "gimple" } } */ +/* { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device \\(21\\);" 1 "gimple" } } */ +/* { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device \\(31\\);" 1 "gimple" } } */ + +/* { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device \\(D\\.\[0-9\]+\\);" 6 "gimple" } } */ + +/* { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ = __builtin_omp_get_interop_int \\(obj1, -5, 0B\\);" 1 "gimple" } } */ +/* { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ = __builtin_omp_get_mapped_ptr \\(ip, 31\\);" 1 "gimple" } } */ + +/* { dg-final { scan-tree-dump-times "repl0<omp_interop_t> \\(obj2\\.\[0-9\], obj1\\);" 1 "gimple" } } */ +/* { dg-final { scan-tree-dump-times "f2 = repl1<float, omp_interop_t> \\(D\\.\[0-9\]+, obj1, obj2\\.\[0-9\]\\);" 1 "gimple" } } */ +/* { dg-final { scan-tree-dump-times "repl3inval<char\\*, int, omp_interop_t> \\(str, i, obj1\\);" 1 "gimple" } } */ +/* { dg-final { scan-tree-dump-times "repl99<omp_interop_t> \\(obj2\\.\[0-9\]\\);" 1 "gimple" } } */ +/* { dg-final { scan-tree-dump-times "repl2<float\\*, int\\*, omp_interop_t> \\(fp, D\\.\[0-9\]+, obj3\\.\[0-9\], obj1\\);" 1 "gimple" } } */ diff --git a/gcc/testsuite/gcc.dg/gomp/append-args-1.c b/gcc/testsuite/gcc.dg/gomp/append-args-1.c new file mode 100644 index 0000000..81dd106 --- /dev/null +++ b/gcc/testsuite/gcc.dg/gomp/append-args-1.c @@ -0,0 +1,70 @@ +/* { dg-do compile } */ +/* { dg-additional-options "-std=gnu17" } */ + +/* The errors might be a bit questionable, but still a resonable solution + for questionable code ... */ + +/* For all empty args, assume C < C23; in C++/C23 it becomes the same as '…(void)'. */ + +/* This uses append_args, once with adjust_args and once without. */ + +typedef enum omp_interop_t +{ + omp_interop_none = 0, + __omp_interop_t_max__ = __UINTPTR_MAX__ +} omp_interop_t; + + +/* (A) No prototype for the variant but for the base function. */ + +void variant_fn1(); +#pragma omp declare variant(variant_fn1) match(construct={dispatch}) append_args(interop(target)) \ + adjust_args(need_device_ptr: x,y) +void bar1(int *x, int *y); +/* { dg-error "variant 'variant_fn1' and base 'bar1' have incompatible types" "" { target *-*-* } .-3 } */ + + +void variant_fn2(); +#pragma omp declare variant(variant_fn2) match(construct={dispatch}) append_args(interop(target)) +void bar2(int *x, int *y); +/* { dg-error "variant 'variant_fn2' and base 'bar2' have incompatible types" "" { target *-*-* } .-2 } */ + + + +/* (B) No prototype for the variant nor for the base function. */ + +void variant_fn3(); /* { dg-error "argument 1 of 'variant_fn3' must be of 'omp_interop_t'" } */ +#pragma omp declare variant(variant_fn3) match(construct={dispatch}) append_args(interop(target)) \ + adjust_args(need_device_ptr: x,y) +void bar3(); +/* { dg-error "'x' undeclared here \\(not in a function\\)" "" { target *-*-* } .-2 } */ +/* { dg-error "'y' undeclared here \\(not in a function\\)" "" { target *-*-* } .-3 } */ +/* { dg-note "'append_args' specified here" "" { target *-*-* } .-5 } */ + + +void variant_fn4(); /* { dg-error "argument 1 of 'variant_fn4' must be of 'omp_interop_t'" } */ +#pragma omp declare variant(variant_fn4) match(construct={dispatch}) append_args(interop(target)) +void bar4(); +/* { dg-note "'append_args' specified here" "" { target *-*-* } .-2 } */ + + + +/* (C) Only a prototype on the variant-function side. */ + +void variant_fn5(omp_interop_t, omp_interop_t); +#pragma omp declare variant(variant_fn5) match(construct={dispatch}) append_args(interop(target)) \ + adjust_args(need_device_ptr: x,y) +void bar5(); +/* { dg-error "variant 'variant_fn5' and base 'bar5' have incompatible types" "" { target *-*-* } .-3 } */ + + +void variant_fn6(omp_interop_t, omp_interop_t); +#pragma omp declare variant(variant_fn6) match(construct={dispatch}) append_args(interop(target)) +void bar6(); +/* { dg-error "variant 'variant_fn6' and base 'bar6' have incompatible types" "" { target *-*-* } .-2 } */ + + +void variant_fn7(int *, int, omp_interop_t, omp_interop_t); +#pragma omp declare variant(variant_fn7) match(construct={dispatch}) append_args(interop(target)) +void bar7(); +/* { dg-error "variant 'variant_fn7' and base 'bar7' have incompatible types" "" { target *-*-* } .-2 } */ diff --git a/gcc/testsuite/gfortran.dg/gomp/adjust-args-1.f90 b/gcc/testsuite/gfortran.dg/gomp/adjust-args-1.f90 index d9f2a67..c0c06e7 100644 --- a/gcc/testsuite/gfortran.dg/gomp/adjust-args-1.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/adjust-args-1.f90 @@ -26,7 +26,7 @@ module main integer function f4 (a) import c_ptr type(c_ptr), intent(inout) :: a - !$omp declare variant (f0) adjust_args (nothing: a) ! { dg-error "an 'adjust_args' clause at .1. can only be specified if the 'dispatch' selector of the construct selector set appears in the 'match' clause" } + !$omp declare variant (f0) adjust_args (nothing: a) ! { dg-error "the 'adjust_args' clause at .1. can only be specified if the 'dispatch' selector of the construct selector set appears in the 'match' clause" } end function integer function f5 (i) integer, intent(inout) :: i diff --git a/gcc/testsuite/gfortran.dg/gomp/adjust-args-3.f90 b/gcc/testsuite/gfortran.dg/gomp/adjust-args-3.f90 index 291bb47..9033221 100644 --- a/gcc/testsuite/gfortran.dg/gomp/adjust-args-3.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/adjust-args-3.f90 @@ -9,7 +9,7 @@ module main contains subroutine base2 (a) type(c_ptr), intent(inout) :: a - !$omp declare variant (variant2) match (construct={parallel}) adjust_args (need_device_ptr: a) ! { dg-error "an 'adjust_args' clause can only be specified if the 'dispatch' selector of the construct selector set appears in the 'match' clause at .1." } + !$omp declare variant (variant2) match (construct={parallel}) adjust_args (need_device_ptr: a) ! { dg-error "the 'adjust_args' clause can only be specified if the 'dispatch' selector of the construct selector set appears in the 'match' clause at .1." } end subroutine subroutine base3 (a) type(c_ptr), intent(inout) :: a diff --git a/gcc/testsuite/gfortran.dg/gomp/append_args-1.f90 b/gcc/testsuite/gfortran.dg/gomp/append_args-1.f90 new file mode 100644 index 0000000..c994b55 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/append_args-1.f90 @@ -0,0 +1,76 @@ +module my_omp_lib + use iso_c_binding + implicit none + + ! The following definitions are in omp_lib, which cannot be included + ! in gcc/testsuite/ + integer, parameter :: omp_interop_kind = c_intptr_t + integer, parameter :: omp_interop_fr_kind = c_int + + integer (omp_interop_kind), parameter :: omp_interop_none = 0_omp_interop_kind + integer (omp_interop_fr_kind), parameter :: omp_ifr_cuda = 1 + integer (omp_interop_fr_kind), parameter :: omp_ifr_cuda_driver = 2 + integer (omp_interop_fr_kind), parameter :: omp_ifr_opencl = 3 + integer (omp_interop_fr_kind), parameter :: omp_ifr_sycl = 4 + integer (omp_interop_fr_kind), parameter :: omp_ifr_hip = 5 + integer (omp_interop_fr_kind), parameter :: omp_ifr_level_zero = 6 + integer (omp_interop_fr_kind), parameter :: omp_ifr_hsa = 7 +end module my_omp_lib + +module m + use my_omp_lib + implicit none + logical, parameter :: flag = .true. +contains + subroutine f1a () + end + + subroutine f1b () + end + + subroutine f1c () + end + + subroutine f1d () + end + + subroutine f1e () + end + + subroutine f1po (q,r, obj) + type(c_ptr) :: q, r + value :: r + integer(omp_interop_kind),value :: obj + end + + subroutine f2 () + !$omp declare variant (f1a) match(user={condition(flag)}) & + !$omp& append_args ( interop ( target , targetsync) ) match(construct={dispatch}) ! { dg-error "'match' clause at .1. specified more than once" } + end subroutine + + subroutine f2a () + !$omp declare variant (f1b) append_args ( interop ( prefer_type ( "cuda", "hip" ) ) , interop(target)) & + !$omp& append_args ( interop ( target , targetsync) ) match(construct={dispatch}) ! { dg-error "'append_args' clause at .1. specified more than once" } + end subroutine + + + subroutine f2b () + !$omp declare variant (f1c) & + !$omp& append_args ( interop ( target , targetsync) ) ! { dg-error "the 'append_args' clause at .1. can only be specified if the 'dispatch' selector of the construct selector set appears in the 'match' clause" } + end subroutine + + subroutine f2c (x,y) + !$omp declare variant (fop) , append_args ( interop ( prefer_type ( "cuda", "hip" ) ) , interop(target)) , & + !$omp& adjust_args (need_device_ptr : x, y ) ! { dg-error "the 'adjust_args' clause at .1. can only be specified if the 'dispatch' selector of the construct selector set appears in the 'match' clause" } + type(c_ptr) :: x, y + value :: y + end subroutine + + subroutine f2d () + !$omp declare variant (f1d) append_args ( interop ( prefer_type ( "cuda", "hip" ) ) , interop(target)) , ! { dg-error "111: expected 'match', 'adjust_args' or 'append_args' at .1." } + end subroutine + + subroutine f2e () + !$omp declare variant (f1e) append_args ( interop ( prefer_type ( "cuda", "hip" ) ) , interop(target) interop(targetsync)) ! { dg-error "Expected ',' or '\\)' at .1." } + end subroutine +end diff --git a/gcc/testsuite/gfortran.dg/gomp/append_args-2.f90 b/gcc/testsuite/gfortran.dg/gomp/append_args-2.f90 new file mode 100644 index 0000000..a20f610 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/append_args-2.f90 @@ -0,0 +1,199 @@ +! { dg-do compile } +! { dg-additional-options "-fcoarray=single" } + +module my_omp_lib + use iso_c_binding + implicit none + + ! The following definitions are in omp_lib, which cannot be included + ! in gcc/testsuite/ + integer, parameter :: omp_interop_kind = c_intptr_t + integer, parameter :: omp_interop_fr_kind = c_int + + integer (omp_interop_kind), parameter :: omp_interop_none = 0_omp_interop_kind + integer (omp_interop_fr_kind), parameter :: omp_ifr_cuda = 1 + integer (omp_interop_fr_kind), parameter :: omp_ifr_cuda_driver = 2 + integer (omp_interop_fr_kind), parameter :: omp_ifr_opencl = 3 + integer (omp_interop_fr_kind), parameter :: omp_ifr_sycl = 4 + integer (omp_interop_fr_kind), parameter :: omp_ifr_hip = 5 + integer (omp_interop_fr_kind), parameter :: omp_ifr_level_zero = 6 + integer (omp_interop_fr_kind), parameter :: omp_ifr_hsa = 7 +end module my_omp_lib + +module m + use my_omp_lib + implicit none + logical, parameter :: flag = .true. +contains + subroutine f1o (obj) + integer(omp_interop_kind),value :: obj + end + + subroutine f1ox (q,r, obj) + ! { dg-error "'q' at .1. must be a nonpointer, nonallocatable scalar integer dummy argument of 'omp_interop_kind' kind as it utilized with the 'append_args' clause at .2." "" { target *-*-* } .-1 } + type(c_ptr) :: q, r + value :: r + integer(omp_interop_kind),value :: obj + end + + + subroutine f5 () + !$omp declare variant (f1ox) match(user={condition(flag)}) & ! { dg-error "the 'append_args' clause can only be specified if the 'dispatch' selector of the construct selector set appears in the 'match' clause at .1." } + !$omp& append_args ( interop ( target , targetsync) ) + ! { dg-error "'q' at .1. must be a nonpointer, nonallocatable scalar integer dummy argument of 'omp_interop_kind' kind as it utilized with the 'append_args' clause at .2." "" { target *-*-* } .-2 } + end subroutine + + subroutine f6 (x, y) + !$omp declare variant (f1ox) match(user={condition(flag)}) & ! { dg-error "the 'adjust_args' clause can only be specified if the 'dispatch' selector of the construct selector set appears in the 'match' clause at .1." } + !$omp& append_args ( interop ( target , targetsync) ) & + !$omp& adjust_args ( need_device_ptr : x , y) + type(c_ptr) :: x, y + value :: y + end subroutine + + subroutine g1 (obj, obj2, obj3) + integer(omp_interop_kind),value :: obj,obj3 + integer(omp_interop_kind),value :: obj2 + end + subroutine g1a (obj) + !$omp declare variant (g1 ) match(construct={dispatch}) append_args ( interop ( target , targetsync), interop( prefer_type ( {fr("cuda"), attr("ompx_xx")}, {attr("ompx_yy")} ))) + integer(omp_interop_kind),value :: obj + end + + subroutine g2 (obj, obj2, obj3) + ! { dg-error "'g2' at .1. has 2 but requires 1 'omp_interop_kind' kind dummy arguments as it is utilized with the 'append_args' clause at .2." "" { target *-*-* } .-1 } + integer(omp_interop_kind),value :: obj,obj2,obj3 + end + subroutine g2a (obj) + !$omp declare variant (g2 ) match(construct={dispatch}) append_args ( interop( target, prefer_type ( {fr("cuda"), attr("ompx_xx")}, {attr("ompx_yy")}), targetsync)) + ! { dg-error "'g2' at .1. has 2 but requires 1 'omp_interop_kind' kind dummy arguments as it is utilized with the 'append_args' clause at .2." "" { target *-*-* } .-1 } + integer(omp_interop_kind),value :: obj + end + + subroutine g3 (obj, obj2, obj3) + integer(omp_interop_kind),value :: obj,obj3 + integer(omp_interop_kind) :: obj2 + end + subroutine g3a (obj) + !$omp declare variant (g3 ) match(construct={dispatch}) append_args ( interop ( target , targetsync), interop( prefer_type ( {fr("cuda"), attr("ompx_xx")}, {attr("ompx_yy")} ))) + integer(omp_interop_kind),value :: obj + end + + subroutine g4 (obj, obj2, obj3) + integer(omp_interop_kind),value :: obj,obj3 + integer(omp_interop_kind) :: obj2 + end + subroutine g4a (obj) + !$omp declare variant (g4 ) match(construct={dispatch}) append_args ( interop ( target , targetsync), interop( prefer_type ( {fr("cuda"), attr("ompx_xx")}, {attr("ompx_yy")} ))) + integer(omp_interop_kind),value :: obj + end + + subroutine g5 (obj, obj2, obj3) + ! { dg-error "'obj3' at .1. with OPTIONAL attribute not support when utilized with the 'append_args' clause at .2." "" { target *-*-* } .-1 } + integer(omp_interop_kind),value :: obj,obj3 + integer(omp_interop_kind) :: obj2 + optional :: obj3 + end + subroutine g5a (obj) + !$omp declare variant (g5 ) match(construct={dispatch}) append_args ( interop ( target , targetsync), interop( prefer_type ( {fr("cuda"), attr("ompx_xx")}, {attr("ompx_yy")} ))) + ! { dg-error "'obj3' at .1. with OPTIONAL attribute not support when utilized with the 'append_args' clause at .2." "" { target *-*-* } .-1 } + integer(omp_interop_kind),value :: obj + end + + subroutine g5var (obj, obj2, obj3) + ! { dg-error "'obj3' at .1. with OPTIONAL attribute not support when utilized with the 'append_args' clause at .2." "" { target *-*-* } .-1 } + integer(omp_interop_kind) :: obj,obj3 + integer(omp_interop_kind) :: obj2 + value :: obj + optional :: obj3 + end + subroutine g5avar (obj) + !$omp declare variant (g5var ) match(construct={dispatch}) append_args ( interop ( target , targetsync), interop( prefer_type ( {fr("cuda"), attr("ompx_xx")}, {attr("ompx_yy")} ))) + ! { dg-error "'obj3' at .1. with OPTIONAL attribute not support when utilized with the 'append_args' clause at .2." "" { target *-*-* } .-1 } + integer(omp_interop_kind),value :: obj + end + + subroutine g6 (obj, obj2, obj3) + ! { dg-error "'obj3' at .1. must be a nonpointer, nonallocatable scalar integer dummy argument of 'omp_interop_kind' kind as it utilized with the 'append_args' clause at .2." "" { target *-*-* } .-1 } + integer(omp_interop_kind),value :: obj + integer(omp_interop_kind),pointer :: obj3 + integer(omp_interop_kind) :: obj2 + end + subroutine g6a (obj) + !$omp declare variant (g6 ) match(construct={dispatch}) append_args ( interop ( target , targetsync), interop( prefer_type ( {fr("cuda"), attr("ompx_xx")}, {attr("ompx_yy")} ))) + ! { dg-error "'obj3' at .1. must be a nonpointer, nonallocatable scalar integer dummy argument of 'omp_interop_kind' kind as it utilized with the 'append_args' clause at .2." "" { target *-*-* } .-1 } + integer(omp_interop_kind),value :: obj + end + + subroutine g7 (obj, obj2, obj3) + ! { dg-error "'obj2' at .1. must be a nonpointer, nonallocatable scalar integer dummy argument of 'omp_interop_kind' kind as it utilized with the 'append_args' clause at .2." "" { target *-*-* } .-1 } + integer(omp_interop_kind),value :: obj + integer(omp_interop_kind) :: obj3 + integer(omp_interop_kind),allocatable :: obj2 + end + subroutine g7a (obj) + !$omp declare variant (g7 ) match(construct={dispatch}) append_args ( interop ( target , targetsync), interop( prefer_type ( {fr("cuda"), attr("ompx_xx")}, {attr("ompx_yy")} ))) + ! { dg-error "'obj2' at .1. must be a nonpointer, nonallocatable scalar integer dummy argument of 'omp_interop_kind' kind as it utilized with the 'append_args' clause at .2." "" { target *-*-* } .-1 } + integer(omp_interop_kind),value :: obj + end + + subroutine g8 (obj, obj2, obj3) + ! { dg-error "'obj2' at .1. must be a nonpointer, nonallocatable scalar integer dummy argument of 'omp_interop_kind' kind as it utilized with the 'append_args' clause at .2." "" { target *-*-* } .-1 } + integer(omp_interop_kind),value :: obj + integer(omp_interop_kind) :: obj3 + integer(omp_interop_kind) :: obj2(:) + end + subroutine g8a (obj) + !$omp declare variant (g8 ) match(construct={dispatch}) append_args ( interop ( target , targetsync), interop( prefer_type ( {fr("cuda"), attr("ompx_xx")}, {attr("ompx_yy")} ))) + ! { dg-error "'obj2' at .1. must be a nonpointer, nonallocatable scalar integer dummy argument of 'omp_interop_kind' kind as it utilized with the 'append_args' clause at .2." "" { target *-*-* } .-1 } + integer(omp_interop_kind),value :: obj + end + + subroutine g9 (obj, obj2, obj3) + ! { dg-error "'obj2' at .1. must be a nonpointer, nonallocatable scalar integer dummy argument of 'omp_interop_kind' kind as it utilized with the 'append_args' clause at .2." "" { target *-*-* } .-1 } + integer(omp_interop_kind),value :: obj + integer(omp_interop_kind) :: obj3 + integer(omp_interop_kind) :: obj2(2) + end + subroutine g9a (obj) + !$omp declare variant (g9 ) match(construct={dispatch}) append_args ( interop ( target , targetsync), interop( prefer_type ( {fr("cuda"), attr("ompx_xx")}, {attr("ompx_yy")} ))) + ! { dg-error "'obj2' at .1. must be a nonpointer, nonallocatable scalar integer dummy argument of 'omp_interop_kind' kind as it utilized with the 'append_args' clause at .2." "" { target *-*-* } .-1 } + integer(omp_interop_kind),value :: obj + end + + subroutine g10 (obj, obj2, obj3) + ! { dg-error "'obj2' at .1. must be a nonpointer, nonallocatable scalar integer dummy argument of 'omp_interop_kind' kind as it utilized with the 'append_args' clause at .2." "" { target *-*-* } .-1 } + integer(omp_interop_kind),value :: obj + integer(omp_interop_kind) :: obj3 + integer(1) :: obj2 + end + subroutine g10a (obj) + !$omp declare variant (g10 ) match(construct={dispatch}) append_args ( interop ( target , targetsync), interop( prefer_type ( {fr("cuda"), attr("ompx_xx")}, {attr("ompx_yy")} ))) + ! { dg-error "'obj2' at .1. must be a nonpointer, nonallocatable scalar integer dummy argument of 'omp_interop_kind' kind as it utilized with the 'append_args' clause at .2." "" { target *-*-* } .-1 } + integer(omp_interop_kind),value :: obj + end + + subroutine g11 (obj, obj2, obj3) + ! { dg-error "'obj2' at .1. must be a nonpointer, nonallocatable scalar integer dummy argument of 'omp_interop_kind' kind as it utilized with the 'append_args' clause at .2." "" { target *-*-* } .-1 } + integer(omp_interop_kind),value :: obj + integer(omp_interop_kind) :: obj3 + real(omp_interop_kind) :: obj2 ! { dg-warning "C kind type parameter is for type INTEGER but type at .1. is REAL" } + end + subroutine g11a (obj) + !$omp declare variant (g11 ) match(construct={dispatch}) append_args ( interop ( target , targetsync), interop( prefer_type ( {fr("cuda"), attr("ompx_xx")}, {attr("ompx_yy")} ))) + ! { dg-error "'obj2' at .1. must be a nonpointer, nonallocatable scalar integer dummy argument of 'omp_interop_kind' kind as it utilized with the 'append_args' clause at .2." "" { target *-*-* } .-1 } + integer(omp_interop_kind),value :: obj + end + + subroutine g12 (obj, obj2, obj3) + ! { dg-error "'obj2' at .1. must be a nonpointer, nonallocatable scalar integer dummy argument of 'omp_interop_kind' kind as it utilized with the 'append_args' clause at .2." "" { target *-*-* } .-1 } + integer(omp_interop_kind),value :: obj + integer(omp_interop_kind) :: obj3 + integer(omp_interop_kind) :: obj2[*] + end + subroutine g12a (obj) + !$omp declare variant (g12 ) match(construct={dispatch}) append_args ( interop ( target , targetsync), interop( prefer_type ( {fr("cuda"), attr("ompx_xx")}, {attr("ompx_yy")} ))) + ! { dg-error "'obj2' at .1. must be a nonpointer, nonallocatable scalar integer dummy argument of 'omp_interop_kind' kind as it utilized with the 'append_args' clause at .2." "" { target *-*-* } .-1 } + integer(omp_interop_kind),value :: obj + end +end diff --git a/gcc/testsuite/gfortran.dg/gomp/append_args-3.f90 b/gcc/testsuite/gfortran.dg/gomp/append_args-3.f90 new file mode 100644 index 0000000..5dbc246 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/append_args-3.f90 @@ -0,0 +1,293 @@ +! { dg-do compile } +! { dg-additional-options "-fdump-tree-gimple -cpp" } + +module my_omp_lib + use iso_c_binding + implicit none + + ! The following definitions are in omp_lib, which cannot be included + ! in gcc/testsuite/ + integer, parameter :: omp_interop_kind = c_intptr_t + integer, parameter :: omp_interop_fr_kind = c_int + + integer (omp_interop_kind), parameter :: omp_interop_none = 0_omp_interop_kind + integer (omp_interop_fr_kind), parameter :: omp_ifr_cuda = 1 + integer (omp_interop_fr_kind), parameter :: omp_ifr_cuda_driver = 2 + integer (omp_interop_fr_kind), parameter :: omp_ifr_opencl = 3 + integer (omp_interop_fr_kind), parameter :: omp_ifr_sycl = 4 + integer (omp_interop_fr_kind), parameter :: omp_ifr_hip = 5 + integer (omp_interop_fr_kind), parameter :: omp_ifr_level_zero = 6 + integer (omp_interop_fr_kind), parameter :: omp_ifr_hsa = 7 +end module my_omp_lib + +module m + use my_omp_lib + implicit none (type, external) + + integer(omp_interop_kind) :: myobj_mod, myobj2_mod + integer(omp_interop_kind), allocatable :: myobj_mod_alloc, myobj2_mod_alloc +contains + + subroutine vsub_no_arg (o_dummy, o_value) + integer(omp_interop_kind) :: o_dummy + integer(omp_interop_kind), value :: o_value + end + subroutine sub_no_arg () + !$omp declare variant (vsub_no_arg ) match(construct={dispatch}) append_args (interop(targetsync), interop( prefer_type ( {fr("cuda"), attr("ompx_xx")}, {attr("ompx_yy")} ))) + end + + integer(c_int) function vfun_cbind(arg2_int, arg2_str, o2_dummy, o2_value) bind(C) + integer(c_int), value :: arg2_int + character(len=1, kind=c_char) :: arg2_str(*) + integer(omp_interop_kind) :: o2_dummy + integer(omp_interop_kind), value :: o2_value + vfun_cbind = arg2_int + end + integer(c_int) function fun_cbind(arg2_int, arg2_str) bind(C) + !$omp declare variant(vfun_cbind) , match(construct={dispatch}),append_args (interop(target), interop(target)) + integer(c_int), value :: arg2_int + character(len=1, kind=c_char) :: arg2_str(*) + fun_cbind = arg2_int + end +end + +subroutine test_sub_no_arg(obj_dummy_val, obj_dummy, obj_dummy_opt, obj_dummy_alloc, obj_dummy_alloc_opt, obj_dummy_ptr, obj_dummy_ptr_opt) + use m + implicit none (type, external) + + integer(omp_interop_kind), value :: obj_dummy_val + integer(omp_interop_kind) :: obj_dummy + integer(omp_interop_kind), optional :: obj_dummy_opt + + integer(omp_interop_kind), allocatable :: obj_dummy_alloc + integer(omp_interop_kind), allocatable, optional :: obj_dummy_alloc_opt + + integer(omp_interop_kind), pointer :: obj_dummy_ptr + integer(omp_interop_kind), pointer, optional :: obj_dummy_ptr_opt + + integer(omp_interop_kind), target :: obj_loc + integer(omp_interop_kind), pointer :: obj_loc_ptr + integer(omp_interop_kind), allocatable :: obj_loc_alloc + + obj_loc = omp_interop_none + obj_loc_ptr => obj_loc + + !$omp dispatch device(10) interop(obj_dummy_val, obj_dummy) + call sub_no_arg + ! subroutine vsub_no_arg (o_dummy, o_value) + ! { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device \\(10\\);" 1 "gimple" } } + ! { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ = \\*obj_dummy;" 1 "gimple" } } + ! { dg-final { scan-tree-dump-times "obj_dummy_val\\.\[0-9\]+ = obj_dummy_val;" 1 "gimple" } } + ! { dg-final { scan-tree-dump-times "vsub_no_arg \\(&obj_dummy_val\\.\[0-9\]+, D\\.\[0-9\]+\\);" 1 "gimple" } } + + !$omp dispatch device(11) interop(obj_dummy, obj_dummy_val) + call sub_no_arg + ! subroutine vsub_no_arg (o_dummy, o_value) + ! { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device \\(11\\);" 1 "gimple" } } + ! { dg-final { scan-tree-dump-times "vsub_no_arg \\(obj_dummy, obj_dummy_val\\);" 1 "gimple" } } + + !$omp dispatch device(12) interop(obj_dummy_opt, obj_dummy_alloc) + call sub_no_arg + ! subroutine vsub_no_arg (o_dummy, o_value) + ! { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device \\(12\\);" 1 "gimple" } } + ! { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ = \\*obj_dummy_alloc;" 2 "gimple" } } + ! The follow inline shows up 4x sub_no_arg and 4x vfun_cbind + ! { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ = \\*D\\.\[0-9\]+;" 8 "gimple" } } + ! { dg-final { scan-tree-dump-times "vsub_no_arg \\(obj_dummy_opt, D\\.\[0-9\]+\\);" 1 "gimple" } } + + !$omp dispatch device(13) interop(obj_dummy_alloc, obj_dummy_opt) + call sub_no_arg + ! subroutine vsub_no_arg (o_dummy, o_value) + ! { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device \\(13\\);" 1 "gimple" } } + ! { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ = \\*obj_dummy_opt;" 1 "gimple" } } + ! See above D\\.\[0-9\]+ = \\*obj_dummy_alloc; + ! { dg-final { scan-tree-dump-times "vsub_no_arg \\(D\\.\[0-9\]+, D\\.\[0-9\]+\\);" 3 "gimple" } } + + !$omp dispatch device(14) interop(obj_dummy_alloc_opt, obj_dummy_ptr) + call sub_no_arg + ! subroutine vsub_no_arg (o_dummy, o_value) + ! { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device \\(14\\);" 1 "gimple" } } + ! { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ = \\*obj_dummy_ptr;" 2 "gimple" } } + ! See above D\\.\[0-9\]+ = \\*D\\.\[0-9\]+; + ! { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ = \\*obj_dummy_alloc_opt;" 2 "gimple" } } + ! See above vsub_no_arg \\(D\\.\[0-9\]+, D\\.\[0-9\]+\\); + + !$omp dispatch device(15) interop(obj_dummy_ptr, obj_dummy_alloc_opt) + call sub_no_arg + ! subroutine vsub_no_arg (o_dummy, o_value) + ! { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device \\(15\\);" 1 "gimple" } } + ! See above D\\.\[0-9\]+ = \\*obj_dummy_alloc_opt; + ! See above D\\.\[0-9\]+ = \\*D\\.\[0-9\]+; + ! See above D\\.\[0-9\]+ = \\*obj_dummy_ptr; + ! See above vsub_no_arg \\(D\\.\[0-9\]+, D\\.\[0-9\]+\\); + + !$omp dispatch device(16) interop(obj_dummy_ptr_opt, myobj_mod) + call sub_no_arg + ! subroutine vsub_no_arg (o_dummy, o_value) + ! { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device \\(16\\);" 1 "gimple" } } + ! { dg-final { scan-tree-dump-times "myobj_mod\\.\[0-9\]+ = myobj_mod;" 1 "gimple" } } + ! { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ = \\*obj_dummy_ptr_opt;" 2 "gimple" } } + ! { dg-final { scan-tree-dump-times "vsub_no_arg \\(D\\.\[0-9\]+, myobj_mod\\.\[0-9\]+\\);" 1 "gimple" } } + + !$omp dispatch device(17) interop(myobj_mod, obj_dummy_ptr_opt) + call sub_no_arg + ! subroutine vsub_no_arg (o_dummy, o_value) + ! { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device \\(17\\);" 1 "gimple" } } + ! See above D\\.\[0-9\]+ = \\*obj_dummy_ptr_opt; + ! See above D\\.\[0-9\]+ = \\*D\\.\[0-9\]+; + ! { dg-final { scan-tree-dump-times "vsub_no_arg \\(&myobj_mod, D\\.\[0-9\]+\\);" 1 "gimple" } } + + !$omp dispatch device(18) interop(obj_loc, obj_loc_ptr) + call sub_no_arg + ! subroutine vsub_no_arg (o_dummy, o_value) + ! { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device \\(18\\);" 1 "gimple" } } + ! { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ = \\*obj_loc_ptr;" 1 "gimple" } } + ! { dg-final { scan-tree-dump-times "vsub_no_arg \\(&obj_loc, D\\.\[0-9\]+\\);" 1 "gimple" } } + + !$omp dispatch device(19) interop(obj_loc_ptr, obj_loc) + call sub_no_arg + ! subroutine vsub_no_arg (o_dummy, o_value) + ! { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device \\(19\\);" 1 "gimple" } } + ! { dg-final { scan-tree-dump-times "obj_loc\\.\[0-9\]+ = obj_loc;" 1 "gimple" } } + ! { dg-final { scan-tree-dump-times "vsub_no_arg \\(obj_loc_ptr, obj_loc\\.\[0-9\]+\\);" 1 "gimple" } } + + !$omp dispatch device(20) interop(obj_loc_alloc, myobj_mod_alloc) + call sub_no_arg + ! subroutine vsub_no_arg (o_dummy, o_value) + ! { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device \\(20\\);" 1 "gimple" } } + ! { dg-final { scan-tree-dump-times "myobj_mod_alloc\\.\[0-9\]+ = myobj_mod_alloc;" 2 "gimple" } } + ! { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ = \\*myobj_mod_alloc\\.\[0-9\]+;" 1 "gimple" } } + ! { dg-final { scan-tree-dump-times "vsub_no_arg \\(obj_loc_alloc, D\\.\[0-9\]+\\);" 1 "gimple" } } + + !$omp dispatch device(21) interop(myobj_mod_alloc, obj_loc_alloc) + call sub_no_arg + ! subroutine vsub_no_arg (o_dummy, o_value) + ! { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device \\(21\\);" 1 "gimple" } } + ! { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ = \\*obj_loc_alloc;" 1 "gimple" } } + ! See above myobj_mod_alloc\\.\[0-9\]+ = myobj_mod_alloc; + ! { dg-final { scan-tree-dump-times "vsub_no_arg \\(myobj_mod_alloc\\.\[0-9\]+, D\\.\[0-9\]+\\);" 1 "gimple" } } +end + + +integer(c_int) function test_fun_cbind (obj2_dummy_val, obj2_dummy, obj2_dummy_opt, obj2_dummy_alloc, obj2_dummy_alloc_opt, obj2_dummy_ptr, obj2_dummy_ptr_opt) + use m + implicit none (type, external) + + integer(omp_interop_kind), value :: obj2_dummy_val + integer(omp_interop_kind) :: obj2_dummy + integer(omp_interop_kind), optional :: obj2_dummy_opt + + integer(omp_interop_kind), allocatable :: obj2_dummy_alloc + integer(omp_interop_kind), allocatable, optional :: obj2_dummy_alloc_opt + + integer(omp_interop_kind), pointer :: obj2_dummy_ptr + integer(omp_interop_kind), pointer, optional :: obj2_dummy_ptr_opt + + integer(omp_interop_kind), target :: obj2_loc + integer(omp_interop_kind), pointer :: obj2_loc_ptr + integer(omp_interop_kind), allocatable :: obj2_loc_alloc + + integer :: i30, i31, i32, i33, i34, i35, i36, i37, i38, i39, i40, i41 + + obj2_loc = omp_interop_none + obj2_loc_ptr => obj2_loc + + !$omp dispatch device(30) interop(obj2_dummy, obj2_dummy_val) + i30 = fun_cbind (300, "abc30" // c_null_char) + ! vfun_cbind(arg2_int, arg2_str, o2_dummy, o2_value) + ! { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device \\(30\\);" 1 "gimple" } } + ! { dg-final { scan-tree-dump-times "i30 = vfun_cbind \\(300, &\"abc30\"\\\[1\\\]\{lb: 1 sz: 1\}, obj2_dummy, obj2_dummy_val\\);" 1 "gimple" } } + + !$omp dispatch device(31) interop(obj2_dummy_val, obj2_dummy) + i31 = fun_cbind (301, "abc31" // c_null_char) + ! vfun_cbind(arg2_int, arg2_str, o2_dummy, o2_value) + ! { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device \\(31\\);" 1 "gimple" } } + ! { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ = \\*obj2_dummy;" 1 "gimple" } } + ! { dg-final { scan-tree-dump-times "obj2_dummy_val\\.\[0-9\]+ = obj2_dummy_val;" 1 "gimple" } } + ! { dg-final { scan-tree-dump-times "i31 = vfun_cbind \\(301, &\"abc31\"\\\[1\\\]\{lb: 1 sz: 1\}, &obj2_dummy_val\\.\[0-9\]+, D\\.\[0-9\]+\\);" 1 "gimple" } } + + !$omp dispatch device(32) interop(obj2_dummy_opt, obj2_dummy_alloc) + i32 = fun_cbind (302, "abc32" // c_null_char) + ! vfun_cbind(arg2_int, arg2_str, o2_dummy, o2_value) + ! { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device \\(32\\);" 1 "gimple" } } + ! { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ = \\*obj2_dummy_alloc;" 2 "gimple" } } + ! See above D\\.\[0-9\]+ = \\*D\\.\[0-9\]+;" 1 "gimple" } } + ! { dg-final { scan-tree-dump-times "i32 = vfun_cbind \\(302, &\"abc32\"\\\[1\\\]\{lb: 1 sz: 1\}, obj2_dummy_opt, D\\.\[0-9\]+\\);" 1 "gimple" } } + + !$omp dispatch device(33) interop(obj2_dummy_alloc, obj2_dummy_opt) + i33 = fun_cbind (303, "abc33" // c_null_char) + ! vfun_cbind(arg2_int, arg2_str, o2_dummy, o2_value) + ! { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device \\(33\\);" 1 "gimple" } } + ! { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ = \\*obj2_dummy_opt;" 1 "gimple" } } + ! See above D\\.\[0-9\]+ = \\*obj2_dummy_alloc; + ! { dg-final { scan-tree-dump-times "i33 = vfun_cbind \\(303, &\"abc33\"\\\[1\\\]\{lb: 1 sz: 1\}, D\\.\[0-9\]+, D\\.\[0-9\]+\\);" 1 "gimple" } } + + !$omp dispatch device(34) interop(obj2_dummy_alloc_opt, obj2_dummy_ptr) + i34 = fun_cbind (304, "abc34" // c_null_char) + ! vfun_cbind(arg2_int, arg2_str, o2_dummy, o2_value) + ! { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device \\(34\\);" 1 "gimple" } } + ! { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ = \\*obj2_dummy_ptr;" 2 "gimple" } } + ! See above D\\.\[0-9\]+ = \\*D\\.\[0-9\]+;" 1 "gimple" } } + ! { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ = \\*obj2_dummy_alloc_opt;" 2 "gimple" } } + ! { dg-final { scan-tree-dump-times "i34 = vfun_cbind \\(304, &\"abc34\"\\\[1\\\]\{lb: 1 sz: 1\}, D\\.\[0-9\]+, D\\.\[0-9\]+\\);" 1 "gimple" } } + + !$omp dispatch device(35) interop(obj2_dummy_ptr, obj2_dummy_alloc_opt) + i35 = fun_cbind (305, "abc35" // c_null_char) + ! vfun_cbind(arg2_int, arg2_str, o2_dummy, o2_value) + ! { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device \\(35\\);" 1 "gimple" } } + ! See above D\\.\[0-9\]+ = \\*obj2_dummy_alloc_opt; + ! See above D\\.\[0-9\]+ = \\*D\\.\[0-9\]+;" 1 "gimple" } } + ! See above D\\.\[0-9\]+ = \\*obj2_dummy_ptr;" 1 "gimple" } } + ! { dg-final { scan-tree-dump-times "i35 = vfun_cbind \\(305, &\"abc35\"\\\[1\\\]\{lb: 1 sz: 1\}, D\\.\[0-9\]+, D\\.\[0-9\]+\\);" 1 "gimple" } } + + !$omp dispatch device(36) interop(obj2_dummy_ptr_opt, myobj2_mod) + i36 = fun_cbind (306, "abc36" // c_null_char) + ! vfun_cbind(arg2_int, arg2_str, o2_dummy, o2_value) + ! { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device \\(36\\);" 1 "gimple" } } + ! { dg-final { scan-tree-dump-times "myobj2_mod\\.\[0-9\]+ = myobj2_mod;" 1 "gimple" } } + ! { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ = \\*obj2_dummy_ptr_opt;" 2 "gimple" } } + ! { dg-final { scan-tree-dump-times "i36 = vfun_cbind \\(306, &\"abc36\"\\\[1\\\]\{lb: 1 sz: 1\}, D\\.\[0-9\]+, myobj2_mod\\.\[0-9\]+\\);" 1 "gimple" } } + + !$omp dispatch device(37) interop(myobj2_mod, obj2_dummy_ptr_opt) + i37 = fun_cbind (307, "abc37" // c_null_char) + ! vfun_cbind(arg2_int, arg2_str, o2_dummy, o2_value) + ! { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device \\(37\\);" 1 "gimple" } } + ! See above D\\.\[0-9\]+ = \\*obj2_dummy_ptr_opt; + ! See above D\\.\[0-9\]+ = \\*D\\.\[0-9\]+;" 1 "gimple" } } + ! { dg-final { scan-tree-dump-times "i37 = vfun_cbind \\(307, &\"abc37\"\\\[1\\\]\{lb: 1 sz: 1\}, &myobj2_mod, D\\.\[0-9\]+\\);" 1 "gimple" } } + + !$omp dispatch device(38) interop(obj2_loc, obj2_loc_ptr) + i38 = fun_cbind (308, "abc38" // c_null_char) + ! vfun_cbind(arg2_int, arg2_str, o2_dummy, o2_value) + ! { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device \\(38\\);" 1 "gimple" } } + ! { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ = \\*obj2_loc_ptr;" 1 "gimple" } } + ! { dg-final { scan-tree-dump-times "i38 = vfun_cbind \\(308, &\"abc38\"\\\[1\\\]\{lb: 1 sz: 1\}, &obj2_loc, D\\.\[0-9\]+\\);" 1 "gimple" } } + + !$omp dispatch device(39) interop(obj2_loc_ptr, obj2_loc) + i39 = fun_cbind (309, "abc39" // c_null_char) + ! vfun_cbind(arg2_int, arg2_str, o2_dummy, o2_value) + ! { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device \\(39\\);" 1 "gimple" } } + ! { dg-final { scan-tree-dump-times "obj2_loc\\.\[0-9\]+ = obj2_loc;" 1 "gimple" } } + ! { dg-final { scan-tree-dump-times "i39 = vfun_cbind \\(309, &\"abc39\"\\\[1\\\]\{lb: 1 sz: 1\}, obj2_loc_ptr, obj2_loc\\.\[0-9\]+\\);" 1 "gimple" } } + + !$omp dispatch device(40) interop(obj2_loc_alloc, myobj2_mod_alloc) + i40 = fun_cbind (400, "abc40" // c_null_char) + ! vfun_cbind(arg2_int, arg2_str, o2_dummy, o2_value) + ! { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device \\(40\\);" 1 "gimple" } } + ! { dg-final { scan-tree-dump-times "myobj2_mod_alloc\\.\[0-9\]+ = myobj2_mod_alloc;" 2 "gimple" } } + ! { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ = \\*myobj2_mod_alloc\\.\[0-9\]+;" 1 "gimple" } } + ! { dg-final { scan-tree-dump-times "i40 = vfun_cbind \\(400, &\"abc40\"\\\[1\\\]\{lb: 1 sz: 1\}, obj2_loc_alloc, D\\.\[0-9\]+\\);" 1 "gimple" } } + + !$omp dispatch device(41) interop(myobj2_mod_alloc, obj2_loc_alloc) + i41 = fun_cbind (401, "abc41" // c_null_char) + ! vfun_cbind(arg2_int, arg2_str, o2_dummy, o2_value) + ! { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device \\(41\\);" 1 "gimple" } } + ! { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ = \\*obj2_loc_alloc;" 1 "gimple" } } + ! See above myobj2_mod_alloc\\.\[0-9\]+ = myobj2_mod_alloc; + ! { dg-final { scan-tree-dump-times "i41 = vfun_cbind \\(401, &\"abc41\"\\\[1\\\]\{lb: 1 sz: 1\}, myobj2_mod_alloc\\.\[0-9\]+, D\\.\[0-9\]+\\);" 1 "gimple" } } + + test_fun_cbind = i30 + i31 + i32 + i33 + i34 + i35 + i36 + i37 + i38 + i39 + i40 + i41 +end + +! { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ = __builtin_omp_get_default_device \\(\\);" 24 "gimple" } } +! { dg-final { scan-tree-dump-times "__builtin_omp_set_default_device \\(D\\.\[0-9\]+\\);" 24 "gimple" } } diff --git a/gcc/testsuite/gfortran.dg/gomp/append_args-4.f90 b/gcc/testsuite/gfortran.dg/gomp/append_args-4.f90 new file mode 100644 index 0000000..6f55084 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/append_args-4.f90 @@ -0,0 +1,264 @@ +! { dg-do compile } +! { dg-additional-options "-fdump-tree-gimple -cpp" } + +module my_omp_lib + use iso_c_binding + implicit none + + ! The following definitions are in omp_lib, which cannot be included + ! in gcc/testsuite/ + integer, parameter :: omp_interop_kind = c_intptr_t + integer, parameter :: omp_interop_fr_kind = c_int + + integer (omp_interop_kind), parameter :: omp_interop_none = 0_omp_interop_kind + integer (omp_interop_fr_kind), parameter :: omp_ifr_cuda = 1 + integer (omp_interop_fr_kind), parameter :: omp_ifr_cuda_driver = 2 + integer (omp_interop_fr_kind), parameter :: omp_ifr_opencl = 3 + integer (omp_interop_fr_kind), parameter :: omp_ifr_sycl = 4 + integer (omp_interop_fr_kind), parameter :: omp_ifr_hip = 5 + integer (omp_interop_fr_kind), parameter :: omp_ifr_level_zero = 6 + integer (omp_interop_fr_kind), parameter :: omp_ifr_hsa = 7 +end module my_omp_lib + +module m + use my_omp_lib + implicit none (type, external) + + integer(omp_interop_kind) :: myobj_mod, myobj2_mod + integer(omp_interop_kind), allocatable :: myobj_mod_alloc, myobj2_mod_alloc +contains + + integer function vifun (str, int_opt, alloc_str, o_dummy, o_value) + character(len=*) :: str + integer, optional, value :: int_opt + character(len=:), allocatable :: alloc_str + integer(omp_interop_kind) :: o_dummy + integer(omp_interop_kind), value :: o_value + vifun = 0 + end + integer function ifun (str, int_opt, alloc_str) + character(len=*) :: str + integer, optional, value :: int_opt + character(len=:), allocatable :: alloc_str + !$omp declare variant (vifun ) match(construct={dispatch}) append_args (interop(targetsync), interop( prefer_type ( {fr("cuda"), attr("ompx_xx")}, {attr("ompx_yy")} ))) + ifun = 0 + end + + character(len=len(str)) function vfun (str, int_var, int_opt, alloc_str, o2_dummy, o2_value) + character(len=*) :: str + integer, value :: int_var + integer, optional, value :: int_opt + character(len=:), allocatable :: alloc_str + integer(omp_interop_kind) :: o2_dummy + integer(omp_interop_kind), value :: o2_value + vfun = "" + end + character(len=len(str)) function fun (str, int_var, int_opt, alloc_str) + !$omp declare variant(vfun), match(construct={dispatch}),append_args (interop(target), interop(target)) + character(len=*) :: str + integer, value :: int_var + integer, optional, value :: int_opt + character(len=:), allocatable :: alloc_str + fun = "" + end +end + +integer function test_ifun(obj_dummy_val, obj_dummy, obj_dummy_opt, obj_dummy_alloc, obj_dummy_alloc_opt, obj_dummy_ptr, obj_dummy_ptr_opt) + use m + implicit none (type, external) + + integer(omp_interop_kind), value :: obj_dummy_val + integer(omp_interop_kind) :: obj_dummy + integer(omp_interop_kind), optional :: obj_dummy_opt + + integer(omp_interop_kind), allocatable :: obj_dummy_alloc + integer(omp_interop_kind), allocatable, optional :: obj_dummy_alloc_opt + + integer(omp_interop_kind), pointer :: obj_dummy_ptr + integer(omp_interop_kind), pointer, optional :: obj_dummy_ptr_opt + + integer(omp_interop_kind), target :: obj_loc + integer(omp_interop_kind), pointer :: obj_loc_ptr + integer(omp_interop_kind), allocatable :: obj_loc_alloc + + character(len=:), allocatable :: str_alloc + integer :: i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, i21 + + obj_loc = omp_interop_none + obj_loc_ptr => obj_loc + + !$omp dispatch device(10) interop(obj_dummy_val, obj_dummy) + i10 = ifun ("abc10", i10, str_alloc) + ! integer function ifun (str, int_opt, alloc_str, o_dummy, o_value) + ! -> int vifun (str, int_opt, alloc_str, o_dummy, o_value, .int_opt, _str, _alloc_str) + ! { dg-final { scan-tree-dump-times "i10 = vifun \\(&\"abc10\"\\\[1\\\]\{lb: 1 sz: 1\}, i10, &str_alloc, &obj_dummy_val\\.\[0-9\]+, D\.\[0-9\]+, 1, 5, &.str_alloc\\);" 1 "gimple" } } + + !$omp dispatch device(11) interop(obj_dummy, obj_dummy_val) + i11 = ifun ("abc11", i11, str_alloc) + ! integer function ifun (str, int_opt, alloc_str, o_dummy, o_value) + ! -> int vifun (str, int_opt, alloc_str, o_dummy, o_value, .int_opt, _str, _alloc_str) + ! { dg-final { scan-tree-dump-times "i11 = vifun \\(&\"abc11\"\\\[1\\\]\{lb: 1 sz: 1\}, i11, &str_alloc, obj_dummy, obj_dummy_val, 1, 5, &.str_alloc\\);" 1 "gimple" } } + + !$omp dispatch device(12) interop(obj_dummy_opt, obj_dummy_alloc) + i12 = ifun ("abc12", i12, str_alloc) + ! integer function ifun (str, int_opt, alloc_str, o_dummy, o_value) + ! -> int vifun (str, int_opt, alloc_str, o_dummy, o_value, .int_opt, _str, _alloc_str) + ! { dg-final { scan-tree-dump-times "i12 = vifun \\(&\"abc12\"\\\[1\\\]\{lb: 1 sz: 1\}, i12, &str_alloc, obj_dummy_opt, D\.\[0-9\]+, 1, 5, &.str_alloc\\);" 1 "gimple" } } + + !$omp dispatch device(13) interop(obj_dummy_alloc, obj_dummy_opt) + i13 = ifun ("abc13", i13, str_alloc) + ! integer function ifun (str, int_opt, alloc_str, o_dummy, o_value) + ! -> int vifun (str, int_opt, alloc_str, o_dummy, o_value, .int_opt, _str, _alloc_str) + ! { dg-final { scan-tree-dump-times "i13 = vifun \\(&\"abc13\"\\\[1\\\]\{lb: 1 sz: 1\}, i13, &str_alloc, D\.\[0-9\]+, D\.\[0-9\]+, 1, 5, &.str_alloc\\);" 1 "gimple" } } + + !$omp dispatch device(14) interop(obj_dummy_alloc_opt, obj_dummy_ptr) + i14 = ifun ("abc14", i14, str_alloc) + ! integer function ifun (str, int_opt, alloc_str, o_dummy, o_value) + ! -> int vifun (str, int_opt, alloc_str, o_dummy, o_value, .int_opt, _str, _alloc_str) + ! { dg-final { scan-tree-dump-times "i14 = vifun \\(&\"abc14\"\\\[1\\\]\{lb: 1 sz: 1\}, i14, &str_alloc, D\.\[0-9\]+, D\.\[0-9\]+, 1, 5, &.str_alloc\\);" 1 "gimple" } } + + !$omp dispatch device(15) interop(obj_dummy_ptr, obj_dummy_alloc_opt) + i15 = ifun ("abc15", i15, str_alloc) + ! integer function ifun (str, int_opt, alloc_str, o_dummy, o_value) + ! -> int vifun (str, int_opt, alloc_str, o_dummy, o_value, .int_opt, _str, _alloc_str) + ! { dg-final { scan-tree-dump-times "i15 = vifun \\(&\"abc15\"\\\[1\\\]\{lb: 1 sz: 1\}, i15, &str_alloc, D\.\[0-9\]+, D\.\[0-9\]+, 1, 5, &.str_alloc\\);" 1 "gimple" } } + + !$omp dispatch device(16) interop(obj_dummy_ptr_opt, myobj_mod) + i16 = ifun ("abc16", i16, str_alloc) + ! integer function ifun (str, int_opt, alloc_str, o_dummy, o_value) + ! -> int vifun (str, int_opt, alloc_str, o_dummy, o_value, .int_opt, _str, _alloc_str) + ! { dg-final { scan-tree-dump-times "i16 = vifun \\(&\"abc16\"\\\[1\\\]\{lb: 1 sz: 1\}, i16, &str_alloc, D\.\[0-9\]+, myobj_mod\\.\[0-9\]+, 1, 5, &.str_alloc\\);" 1 "gimple" } } + + !$omp dispatch device(17) interop(myobj_mod, obj_dummy_ptr_opt) + i17 = ifun ("abc17", i17, str_alloc) + ! integer function ifun (str, int_opt, alloc_str, o_dummy, o_value) + ! -> int vifun (str, int_opt, alloc_str, o_dummy, o_value, .int_opt, _str, _alloc_str) + ! { dg-final { scan-tree-dump-times "i17 = vifun \\(&\"abc17\"\\\[1\\\]\{lb: 1 sz: 1\}, i17, &str_alloc, &myobj_mod, D\.\[0-9\]+, 1, 5, &.str_alloc\\);" 1 "gimple" } } + + !$omp dispatch device(18) interop(obj_loc, obj_loc_ptr) + i18 = ifun ("abc18", i18, str_alloc) + ! integer function ifun (str, int_opt, alloc_str, o_dummy, o_value) + ! -> int vifun (str, int_opt, alloc_str, o_dummy, o_value, .int_opt, _str, _alloc_str) + ! { dg-final { scan-tree-dump-times "i18 = vifun \\(&\"abc18\"\\\[1\\\]\{lb: 1 sz: 1\}, i18, &str_alloc, &obj_loc, D\.\[0-9\]+, 1, 5, &.str_alloc\\);" 1 "gimple" } } + + !$omp dispatch device(19) interop(obj_loc_ptr, obj_loc) + i19 = ifun ("abc19", i19, str_alloc) + ! integer function ifun (str, int_opt, alloc_str, o_dummy, o_value) + ! -> int vifun (str, int_opt, alloc_str, o_dummy, o_value, .int_opt, _str, _alloc_str) + ! { dg-final { scan-tree-dump-times "i19 = vifun \\(&\"abc19\"\\\[1\\\]\{lb: 1 sz: 1\}, i19, &str_alloc, obj_loc_ptr, obj_loc\\.\[0-9\]+, 1, 5, &.str_alloc\\);" 1 "gimple" } } + + !$omp dispatch device(20) interop(obj_loc_alloc, myobj_mod_alloc) + i20 = ifun ("abc20", i20, str_alloc) + ! integer function ifun (str, int_opt, alloc_str, o_dummy, o_value) + ! -> int vifun (str, int_opt, alloc_str, o_dummy, o_value, .int_opt, _str, _alloc_str) + ! { dg-final { scan-tree-dump-times "i20 = vifun \\(&\"abc20\"\\\[1\\\]\{lb: 1 sz: 1\}, i20, &str_alloc, obj_loc_alloc, D\.\[0-9\]+, 1, 5, &.str_alloc\\);" 1 "gimple" } } + + !$omp dispatch device(21) interop(myobj_mod_alloc, obj_loc_alloc) + i21 = ifun ("abc21", i21, str_alloc) + ! integer function ifun (str, int_opt, alloc_str, o_dummy, o_value) + ! -> int vifun (str, int_opt, alloc_str, o_dummy, o_value, .int_opt, _str, _alloc_str) + ! { dg-final { scan-tree-dump-times "i21 = vifun \\(&\"abc21\"\\\[1\\\]\{lb: 1 sz: 1\}, i21, &str_alloc, myobj_mod_alloc\\.\[0-9\]+, D\.\[0-9\]+, 1, 5, &.str_alloc\\);" 1 "gimple" } } + + test_ifun = i10 + i11 + i12 + i13 + i14 + i15 + i16 + i17 + i18 + i19 + i20 + i21 +end + + +integer(c_int) function test_fun (obj2_dummy_val, obj2_dummy, obj2_dummy_opt, obj2_dummy_alloc, obj2_dummy_alloc_opt, obj2_dummy_ptr, obj2_dummy_ptr_opt) + use m + implicit none (type, external) + + integer(omp_interop_kind), value :: obj2_dummy_val + integer(omp_interop_kind) :: obj2_dummy + integer(omp_interop_kind), optional :: obj2_dummy_opt + + integer(omp_interop_kind), allocatable :: obj2_dummy_alloc + integer(omp_interop_kind), allocatable, optional :: obj2_dummy_alloc_opt + + integer(omp_interop_kind), pointer :: obj2_dummy_ptr + integer(omp_interop_kind), pointer, optional :: obj2_dummy_ptr_opt + + integer(omp_interop_kind), target :: obj2_loc + integer(omp_interop_kind), pointer :: obj2_loc_ptr + integer(omp_interop_kind), allocatable :: obj2_loc_alloc + + character(len=:), allocatable :: str_alloc + character(1) :: res_str + integer :: i30, i31, i32, i33, i34, i35, i36, i37, i38, i39, i40, i41 + i30 = 0; i31 = 0; i32 = 0; i33 = 0; i34 = 0; i35 = 0; i36 = 0; i37 = 0; i38 = 0; i39 = 0; i40 = 0; i41 = 0 + + obj2_loc = omp_interop_none + obj2_loc_ptr => obj2_loc + + !$omp dispatch device(30) interop(obj2_dummy, obj2_dummy_val) + res_str = fun ("klm30", 300, i30, str_alloc) + ! character(len=len(str)) function vfun (str, int_var, int_opt, alloc_str, o2_dummy, o2_value) + ! -> void vfun (__result, .__result, str, int_var, int_opt, alloc_str, o2_dummy, o2_value, .int_opt, _str, _alloc_str) + + !$omp dispatch device(31) interop(obj2_dummy_val, obj2_dummy) + res_str = fun ("klm31", 301, i31, str_alloc) + ! character(len=len(str)) function vfun (str, int_var, int_opt, alloc_str, o2_dummy, o2_value) + ! -> void vfun (__result, .__result, str, int_var, int_opt, alloc_str, o2_dummy, o2_value, .int_opt, _str, _alloc_str) + + !$omp dispatch device(32) interop(obj2_dummy_opt, obj2_dummy_alloc) + res_str = fun ("klm32", 302, i32, str_alloc) + ! character(len=len(str)) function vfun (str, int_var, int_opt, alloc_str, o2_dummy, o2_value) + ! -> void vfun (__result, .__result, str, int_var, int_opt, alloc_str, o2_dummy, o2_value, .int_opt, _str, _alloc_str) + + !$omp dispatch device(33) interop(obj2_dummy_alloc, obj2_dummy_opt) + res_str = fun ("klm33", 303, i33, str_alloc) + ! character(len=len(str)) function vfun (str, int_var, int_opt, alloc_str, o2_dummy, o2_value) + ! -> void vfun (__result, .__result, str, int_var, int_opt, alloc_str, o2_dummy, o2_value, .int_opt, _str, _alloc_str) + + !$omp dispatch device(34) interop(obj2_dummy_alloc_opt, obj2_dummy_ptr) + res_str = fun ("klm34", 304, i34, str_alloc) + ! character(len=len(str)) function vfun (str, int_var, int_opt, alloc_str, o2_dummy, o2_value) + ! -> void vfun (__result, .__result, str, int_var, int_opt, alloc_str, o2_dummy, o2_value, .int_opt, _str, _alloc_str) + + !$omp dispatch device(35) interop(obj2_dummy_ptr, obj2_dummy_alloc_opt) + res_str = fun ("klm35", 305, i35, str_alloc) + ! character(len=len(str)) function vfun (str, int_var, int_opt, alloc_str, o2_dummy, o2_value) + ! -> void vfun (__result, .__result, str, int_var, int_opt, alloc_str, o2_dummy, o2_value, .int_opt, _str, _alloc_str) + + !$omp dispatch device(36) interop(obj2_dummy_ptr_opt, myobj2_mod) + res_str = fun ("klm36", 306, i36, str_alloc) + ! character(len=len(str)) function vfun (str, int_var, int_opt, alloc_str, o2_dummy, o2_value) + ! -> void vfun (__result, .__result, str, int_var, int_opt, alloc_str, o2_dummy, o2_value, .int_opt, _str, _alloc_str) + + !$omp dispatch device(37) interop(myobj2_mod, obj2_dummy_ptr_opt) + res_str = fun ("klm37", 307, i37, str_alloc) + ! character(len=len(str)) function vfun (str, int_var, int_opt, alloc_str, o2_dummy, o2_value) + ! -> void vfun (__result, .__result, str, int_var, int_opt, alloc_str, o2_dummy, o2_value, .int_opt, _str, _alloc_str) + + !$omp dispatch device(38) interop(obj2_loc, obj2_loc_ptr) + res_str = fun ("klm30", 308, i38, str_alloc) + ! character(len=len(str)) function vfun (str, int_var, int_opt, alloc_str, o2_dummy, o2_value) + ! -> void vfun (__result, .__result, str, int_var, int_opt, alloc_str, o2_dummy, o2_value, .int_opt, _str, _alloc_str) + + !$omp dispatch device(39) interop(obj2_loc_ptr, obj2_loc) + res_str = fun ("klm39", 309, i39, str_alloc) + ! character(len=len(str)) function vfun (str, int_var, int_opt, alloc_str, o2_dummy, o2_value) + ! -> void vfun (__result, .__result, str, int_var, int_opt, alloc_str, o2_dummy, o2_value, .int_opt, _str, _alloc_str) + + !$omp dispatch device(40) interop(obj2_loc_alloc, myobj2_mod_alloc) + res_str = fun ("klm40", 400, i40, str_alloc) + ! character(len=len(str)) function vfun (str, int_var, int_opt, alloc_str, o2_dummy, o2_value) + + !$omp dispatch device(41) interop(myobj2_mod_alloc, obj2_loc_alloc) + res_str = fun ("klm41", 401, i41, str_alloc) + ! character(len=len(str)) function vfun (str, int_var, int_opt, alloc_str, o2_dummy, o2_value) + ! -> void vfun (__result, .__result, str, int_var, int_opt, alloc_str, o2_dummy, o2_value, .int_opt, _str, _alloc_str) + + test_fun = i30 + i31 + i32 + i33 + i34 + i35 + i36 + i37 + i38 + i39 + i40 + i41 +end + ! { dg-final { scan-tree-dump-times "vfun \\(&str\\.\[0-9\]+, 5, D\\.\[0-9\]+, 300, D\\.\[0-9\]+, D\\.\[0-9\]+, obj2_dummy, obj2_dummy_val, 1, 5, &.str_alloc\\.\[0-9\]+\\);" 1 "gimple" } } + ! { dg-final { scan-tree-dump-times "vfun \\(&str\\.\[0-9\]+, 5, D\\.\[0-9\]+, 301, D\\.\[0-9\]+, D\\.\[0-9\]+, &obj2_dummy_val\\.\[0-9\]+, D\\.\[0-9\]+, 1, 5, &.str_alloc\\.\[0-9\]+\\);" 1 "gimple" } } + ! { dg-final { scan-tree-dump-times "vfun \\(&str\\.\[0-9\]+, 5, D\\.\[0-9\]+, 302, D\\.\[0-9\]+, D\\.\[0-9\]+, obj2_dummy_opt, D\\.\[0-9\]+, 1, 5, &.str_alloc\\.\[0-9\]+\\);" 1 "gimple" } } + ! { dg-final { scan-tree-dump-times "vfun \\(&str\\.\[0-9\]+, 5, D\\.\[0-9\]+, 303, D\\.\[0-9\]+, D\\.\[0-9\]+, D\\.\[0-9\]+, D\\.\[0-9\]+, 1, 5, &.str_alloc\\.\[0-9\]+\\);" 1 "gimple" } } + ! { dg-final { scan-tree-dump-times "vfun \\(&str\\.\[0-9\]+, 5, D\\.\[0-9\]+, 304, D\\.\[0-9\]+, D\\.\[0-9\]+, D\\.\[0-9\]+, D\\.\[0-9\]+, 1, 5, &.str_alloc\\.\[0-9\]+\\);" 1 "gimple" } } + ! { dg-final { scan-tree-dump-times "vfun \\(&str\\.\[0-9\]+, 5, D\\.\[0-9\]+, 305, D\\.\[0-9\]+, D\\.\[0-9\]+, D\\.\[0-9\]+, D\\.\[0-9\]+, 1, 5, &.str_alloc\\.\[0-9\]+\\);" 1 "gimple" } } + ! { dg-final { scan-tree-dump-times "vfun \\(&str\\.\[0-9\]+, 5, D\\.\[0-9\]+, 306, D\\.\[0-9\]+, D\\.\[0-9\]+, D\\.\[0-9\]+, myobj2_mod\\.\[0-9\]+, 1, 5, &.str_alloc\\.\[0-9\]+\\);" 1 "gimple" } } + ! { dg-final { scan-tree-dump-times "vfun \\(&str\\.\[0-9\]+, 5, D\\.\[0-9\]+, 307, D\\.\[0-9\]+, D\\.\[0-9\]+, &myobj2_mod, D\\.\[0-9\]+, 1, 5, &.str_alloc\\.\[0-9\]+\\);" 1 "gimple" } } + ! { dg-final { scan-tree-dump-times "vfun \\(&str\\.\[0-9\]+, 5, D\\.\[0-9\]+, 308, D\\.\[0-9\]+, D\\.\[0-9\]+, &obj2_loc, D\\.\[0-9\]+, 1, 5, &.str_alloc\\.\[0-9\]+\\);" 1 "gimple" } } + ! { dg-final { scan-tree-dump-times "vfun \\(&str\\.\[0-9\]+, 5, D\\.\[0-9\]+, 309, D\\.\[0-9\]+, D\\.\[0-9\]+, obj2_loc_ptr, obj2_loc\\.\[0-9\]+, 1, 5, &.str_alloc\\.\[0-9\]+\\);" 1 "gimple" } } + ! { dg-final { scan-tree-dump-times "vfun \\(&str\\.\[0-9\]+, 5, D\\.\[0-9\]+, 400, D\\.\[0-9\]+, D\\.\[0-9\]+, obj2_loc_alloc, D\\.\[0-9\]+, 1, 5, &.str_alloc\\.\[0-9\]+\\);" 1 "gimple" } } + ! { dg-final { scan-tree-dump-times "vfun \\(&str\\.\[0-9\]+, 5, D\\.\[0-9\]+, 401, D\\.\[0-9\]+, D\\.\[0-9\]+, myobj2_mod_alloc\\.\[0-9\]+, D\\.\[0-9\]+, 1, 5, &.str_alloc\\.\[0-9\]+\\);" 1 "gimple" } } diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-variant-2.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-variant-2.f90 index 17b112f..11be76e 100644 --- a/gcc/testsuite/gfortran.dg/gomp/declare-variant-2.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/declare-variant-2.f90 @@ -18,10 +18,10 @@ contains !$omp declare variant match(user={condition(.false.)}) ! { dg-error "expected '\\(' at .1." } end subroutine subroutine f6 () - !$omp declare variant (f1) ! { dg-error "expected 'match' or 'adjust_args' at .1." } + !$omp declare variant (f1) ! { dg-error "expected 'match', 'adjust_args' or 'append_args' at .1." } end subroutine subroutine f7 () - !$omp declare variant (f1) simd ! { dg-error "expected 'match' or 'adjust_args' at .1." } + !$omp declare variant (f1) simd ! { dg-error "expected 'match', 'adjust_args' or 'append_args' at .1." } end subroutine subroutine f8 () !$omp declare variant (f1) match ! { dg-error "expected '\\(' at .1." } @@ -183,13 +183,13 @@ contains !$omp declare variant (f1) match(construct={requires}) ! { dg-warning "unknown selector 'requires' for context selector set 'construct' at .1." } end subroutine subroutine f75a () - !$omp declare variant(f1) ,,match(construct={dispatch}) adjust_args(need_device_ptr : c) ! { dg-error "expected 'match' or 'adjust_args' at .1." } + !$omp declare variant(f1) ,,match(construct={dispatch}) adjust_args(need_device_ptr : c) ! { dg-error "expected 'match', 'adjust_args' or 'append_args' at .1." } end subroutine subroutine f75b () - !$omp declare variant(f1) match(construct={dispatch}),,adjust_args(need_device_ptr : c) ! { dg-error "expected 'match' or 'adjust_args' at .1." } + !$omp declare variant(f1) match(construct={dispatch}),,adjust_args(need_device_ptr : c) ! { dg-error "expected 'match', 'adjust_args' or 'append_args' at .1." } end subroutine subroutine f75c () - !$omp declare variant(f1) match(construct={dispatch}),nowait(a) ! { dg-error "expected 'match' or 'adjust_args' at .1." } + !$omp declare variant(f1) match(construct={dispatch}),nowait(a) ! { dg-error "expected 'match', 'adjust_args' or 'append_args' at .1." } end subroutine subroutine f76 () !$omp declare variant (f1) match(implementation={atomic_default_mem_order("relaxed")}) ! { dg-error "expected identifier at .1." } diff --git a/libgomp/libgomp.texi b/libgomp/libgomp.texi index 7d8cd70..ec0e06d 100644 --- a/libgomp/libgomp.texi +++ b/libgomp/libgomp.texi @@ -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 |