diff options
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 |