fputs (" PDT-STRING", dumpfile);
if (attr->omp_udr_artificial_var)
fputs (" OMP-UDR-ARTIFICIAL-VAR", dumpfile);
+ if (attr->omp_udm_artificial_var)
+ fputs (" OMP-UDM-ARTIFICIAL-VAR", dumpfile);
if (attr->omp_declare_target)
fputs (" OMP-DECLARE-TARGET", dumpfile);
if (attr->omp_declare_target_link)
fputs ("always,present,tofrom:", dumpfile); break;
case OMP_MAP_DELETE: fputs ("delete:", dumpfile); break;
case OMP_MAP_RELEASE: fputs ("release:", dumpfile); break;
+ case OMP_MAP_UNSET: fputs ("unset:", dumpfile); break;
default: break;
}
else if (list_type == OMP_LIST_LINEAR && n->u.linear.old_modifier)
ST_OMP_TASKWAIT, ST_OMP_TASKYIELD, ST_OMP_CANCEL, ST_OMP_CANCELLATION_POINT,
ST_OMP_TASKGROUP, ST_OMP_END_TASKGROUP, ST_OMP_SIMD, ST_OMP_END_SIMD,
ST_OMP_DO_SIMD, ST_OMP_END_DO_SIMD, ST_OMP_PARALLEL_DO_SIMD,
- ST_OMP_END_PARALLEL_DO_SIMD, ST_OMP_DECLARE_SIMD, ST_OMP_DECLARE_REDUCTION,
- ST_OMP_TARGET, ST_OMP_END_TARGET, ST_OMP_TARGET_DATA, ST_OMP_END_TARGET_DATA,
+ ST_OMP_END_PARALLEL_DO_SIMD, ST_OMP_DECLARE_SIMD, ST_OMP_DECLARE_MAPPER,
+ ST_OMP_DECLARE_REDUCTION, ST_OMP_TARGET, ST_OMP_END_TARGET,
+ ST_OMP_TARGET_DATA, ST_OMP_END_TARGET_DATA,
ST_OMP_TARGET_UPDATE, ST_OMP_DECLARE_TARGET, ST_OMP_DECLARE_VARIANT,
ST_OMP_TEAMS, ST_OMP_END_TEAMS, ST_OMP_DISTRIBUTE, ST_OMP_END_DISTRIBUTE,
ST_OMP_DISTRIBUTE_SIMD, ST_OMP_END_DISTRIBUTE_SIMD,
!$OMP DECLARE REDUCTION. */
unsigned omp_udr_artificial_var:1;
+ /* This is a placeholder variable used in an !$OMP DECLARE MAPPER
+ directive. */
+ unsigned omp_udm_artificial_var:1;
+
/* Mentioned in OMP DECLARE TARGET. */
unsigned omp_declare_target:1;
unsigned omp_declare_target_link:1;
OMP_MAP_PRESENT_TOFROM = (1 << 13) | OMP_MAP_TOFROM,
OMP_MAP_ALWAYS_PRESENT_TO = OMP_MAP_ALWAYS_TO | OMP_MAP_PRESENT_TO,
OMP_MAP_ALWAYS_PRESENT_FROM = OMP_MAP_ALWAYS_FROM | OMP_MAP_PRESENT_FROM,
- OMP_MAP_ALWAYS_PRESENT_TOFROM = OMP_MAP_ALWAYS_TOFROM | OMP_MAP_PRESENT_TOFROM
+ OMP_MAP_ALWAYS_PRESENT_TOFROM = OMP_MAP_ALWAYS_TOFROM | OMP_MAP_PRESENT_TOFROM,
+ OMP_MAP_UNSET = 1 << 14
};
enum gfc_omp_defaultmap
OMP_LINEAR_UVAL
};
+typedef struct gfc_omp_namelist_udm
+{
+ /* When adding more struct members, change the struct use in gfc_omp_namelist
+ to a pointer and move the struct definition down, placing it after
+ '#define gfc_get_omp_udm'. */
+ struct gfc_omp_udm *udm;
+}
+gfc_omp_namelist_udm;
+
/* For use in OpenMP clauses in case we need extra information
(aligned clause alignment, linear clause step, etc.). */
union
{
struct gfc_omp_namelist_udr *udr;
+ struct gfc_omp_namelist_udm udm;
gfc_namespace *ns;
gfc_expr *allocator;
struct gfc_symbol *traits_sym;
gfc_omp_namelist_udr;
#define gfc_get_omp_namelist_udr() XCNEW (gfc_omp_namelist_udr)
+
+typedef struct gfc_omp_udm
+{
+ struct gfc_omp_udm *next;
+ locus where; /* Where the !$omp declare mapper construct occurred. */
+
+ const char *mapper_id;
+ gfc_typespec ts;
+
+ struct gfc_symbol *var_sym;
+ struct gfc_namespace *mapper_ns;
+
+ /* FIXME: We don't need a whole gfc_omp_clauses here. We only use the
+ OMP_LIST_MAP clause list; however, the used resolve_omp_clauses
+ requires the full set. */
+ gfc_omp_clauses *clauses;
+
+ tree backend_decl;
+}
+gfc_omp_udm;
+#define gfc_get_omp_udm() XCNEW (gfc_omp_udm)
+
/* The gfc_st_label structure is a BBT attached to a namespace that
records the usage of statement labels within that space. */
gfc_common_head *common;
gfc_typebound_proc *tb;
gfc_omp_udr *omp_udr;
+ gfc_omp_udm *omp_udm;
}
n;
unsigned import_only:1;
gfc_symtree *common_root;
/* Tree containing all the OpenMP user defined reductions. */
gfc_symtree *omp_udr_root;
+ /* Tree containing all the OpenMP user defined mappers. */
+ gfc_symtree *omp_udm_root;
/* Tree containing type-bound procedures. */
gfc_symtree *tb_sym_root;
/* Set to 1 for !$OMP DECLARE REDUCTION namespaces. */
unsigned omp_udr_ns:1;
+ /* Set to 1 for !$OMP DECLARE MAPPER namespaces. */
+ unsigned omp_udm_ns:1;
+
/* Set to 1 for !$ACC ROUTINE namespaces. */
unsigned oacc_routine:1;
void gfc_free_omp_declare_simd (gfc_omp_declare_simd *);
void gfc_free_omp_declare_simd_list (gfc_omp_declare_simd *);
void gfc_free_omp_udr (gfc_omp_udr *);
+void gfc_free_omp_udm (gfc_omp_udm *);
void gfc_free_omp_variants (gfc_omp_variant *);
gfc_omp_udr *gfc_omp_udr_find (gfc_symtree *, gfc_typespec *);
+gfc_omp_udm *gfc_omp_udm_find (gfc_symtree *, gfc_typespec *);
+gfc_omp_udm *gfc_find_omp_udm (gfc_namespace *ns, const char *mapper_id,
+ gfc_typespec *ts);
void gfc_resolve_omp_allocate (gfc_namespace *, gfc_omp_namelist *);
void gfc_resolve_omp_assumptions (gfc_omp_assumptions *);
void gfc_resolve_omp_directive (gfc_code *, gfc_namespace *);
void gfc_resolve_omp_do_blocks (gfc_code *, gfc_namespace *);
void gfc_resolve_omp_declare (gfc_namespace *);
void gfc_resolve_omp_udrs (gfc_symtree *);
+void gfc_resolve_omp_udms (gfc_symtree *);
void gfc_omp_save_and_clear_state (struct gfc_omp_saved_state *);
void gfc_omp_restore_state (struct gfc_omp_saved_state *);
void gfc_free_expr_list (gfc_expr_list *);
bool free_align_allocator = (list == OMP_LIST_ALLOCATE);
bool free_mem_traits_space = (list == OMP_LIST_USES_ALLOCATORS);
bool free_init = (list == OMP_LIST_INIT);
+ bool free_mapper = (list == OMP_LIST_MAP);
gfc_omp_namelist *n;
gfc_expr *last_allocator = NULL;
free (name->u2.init_interop);
}
}
- else if (name->u2.udr)
+ else if (free_mapper)
+ { } /* For now, u2.udm is not a pointer. */
+ else if (!free_mapper && name->u2.udr)
{
if (name->u2.udr->combiner)
gfc_free_statement (name->u2.udr->combiner);
match gfc_match_omp_cancel (void);
match gfc_match_omp_cancellation_point (void);
match gfc_match_omp_critical (void);
+match gfc_match_omp_declare_mapper (void);
match gfc_match_omp_declare_reduction (void);
match gfc_match_omp_declare_simd (void);
match gfc_match_omp_declare_target (void);
{"cancel", GFC_OMP_DIR_EXECUTABLE, ST_OMP_CANCEL},
{"critical", GFC_OMP_DIR_EXECUTABLE, ST_OMP_CRITICAL},
/* {"declare induction", GFC_OMP_DIR_DECLARATIVE, ST_OMP_DECLARE_INDUCTION}, */
- /* {"declare mapper", GFC_OMP_DIR_DECLARATIVE, ST_OMP_DECLARE_MAPPER}, */
+ {"declare mapper", GFC_OMP_DIR_DECLARATIVE, ST_OMP_DECLARE_MAPPER},
{"declare reduction", GFC_OMP_DIR_DECLARATIVE, ST_OMP_DECLARE_REDUCTION},
{"declare simd", GFC_OMP_DIR_DECLARATIVE, ST_OMP_DECLARE_SIMD},
{"declare target", GFC_OMP_DIR_DECLARATIVE, ST_OMP_DECLARE_TARGET},
}
}
+/* Free an !$omp declare mapper. */
+
+void
+gfc_free_omp_udm (gfc_omp_udm *omp_udm)
+{
+ if (omp_udm)
+ {
+ gfc_free_omp_udm (omp_udm->next);
+ gfc_free_namespace (omp_udm->mapper_ns);
+ free (omp_udm);
+ }
+}
+
static gfc_omp_udr *
gfc_find_omp_udr (gfc_namespace *ns, const char *name, gfc_typespec *ts)
{
"clause at %L");
}
+
+/* Search upwards though namespace NS and its parents to find an
+ !$omp declare mapper named MAPPER_ID, for typespec TS. */
+
+gfc_omp_udm *
+gfc_find_omp_udm (gfc_namespace *ns, const char *mapper_id, gfc_typespec *ts)
+{
+ gfc_symtree *st;
+
+ if (ns == NULL)
+ ns = gfc_current_ns;
+
+ do
+ {
+ gfc_omp_udm *omp_udm;
+
+ st = gfc_find_symtree (ns->omp_udm_root, mapper_id);
+
+ if (st != NULL)
+ {
+ for (omp_udm = st->n.omp_udm; omp_udm; omp_udm = omp_udm->next)
+ if (gfc_compare_types (&omp_udm->ts, ts))
+ return omp_udm;
+ }
+
+ /* Don't escape an interface block. */
+ if (ns && !ns->has_import_set
+ && ns->proc_name && ns->proc_name->attr.if_source == IFSRC_IFBODY)
+ break;
+
+ ns = ns->parent;
+ }
+ while (ns != NULL);
+
+ return NULL;
+}
+
+
/* Match OpenMP and OpenACC directive clauses. MASK is a bitmask of
clauses that are allowed for a particular directive. */
static match
gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
bool first = true, bool needs_space = true,
- bool openacc = false, bool openmp_target = false)
+ bool openacc = false, bool openmp_target = false,
+ gfc_omp_map_op default_map_op = OMP_MAP_TOFROM)
{
bool error = false;
gfc_omp_clauses *c = gfc_get_omp_clauses ();
int always_modifier = 0;
int close_modifier = 0;
int present_modifier = 0;
+ int mapper_modifier = 0;
locus second_always_locus = old_loc2;
locus second_close_locus = old_loc2;
+ locus second_mapper_locus = old_loc2;
locus second_present_locus = old_loc2;
+ char mapper_id[GFC_MAX_SYMBOL_LEN + 1] = { '\0' };
for (;;)
{
if (present_modifier++ == 1)
second_present_locus = current_locus;
}
+ else if (gfc_match ("mapper ( ") == MATCH_YES)
+ {
+ if (mapper_modifier++ == 1)
+ second_mapper_locus = current_locus;
+ m = gfc_match (" %n ) ", mapper_id);
+ if (m != MATCH_YES)
+ goto error;
+ }
else
break;
if (gfc_match (", ") != MATCH_YES)
"OpenMP 5.2");
}
- gfc_omp_map_op map_op = OMP_MAP_TOFROM;
+ gfc_omp_map_op map_op = default_map_op;
int always_present_modifier
= always_modifier && present_modifier;
gfc_current_locus = old_loc2;
always_modifier = 0;
close_modifier = 0;
+ mapper_modifier = 0;
}
if (always_modifier > 1)
&second_present_locus);
break;
}
+ if (mapper_modifier > 1)
+ {
+ gfc_error ("too many %<mapper%> modifiers at %L",
+ &second_mapper_locus);
+ break;
+ }
head = NULL;
if (gfc_match_omp_variable_list ("", &c->lists[OMP_LIST_MAP],
{
gfc_omp_namelist *n;
for (n = *head; n; n = n->next)
- n->u.map.op = map_op;
+ {
+ n->u.map.op = map_op;
+
+ gfc_typespec *ts;
+ if (n->expr)
+ ts = &n->expr->ts;
+ else
+ ts = &n->sym->ts;
+
+ gfc_omp_udm *udm
+ = gfc_find_omp_udm (gfc_current_ns, mapper_id, ts);
+ if (udm)
+ {
+ n->u2.udm.udm = udm;
+ }
+ }
continue;
}
gfc_current_locus = old_loc;
}
+/* Find a matching "!$omp declare mapper" for typespec TS in symtree ST. */
+
+gfc_omp_udm *
+gfc_omp_udm_find (gfc_symtree *st, gfc_typespec *ts)
+{
+ gfc_omp_udm *omp_udm;
+
+ if (st == NULL)
+ return NULL;
+
+ for (omp_udm = st->n.omp_udm; omp_udm; omp_udm = omp_udm->next)
+ if ((omp_udm->ts.type == BT_DERIVED || omp_udm->ts.type == BT_CLASS)
+ && (ts->type == BT_DERIVED || ts->type == BT_CLASS)
+ && strcmp (omp_udm->ts.u.derived->name, ts->u.derived->name) == 0)
+ return omp_udm;
+
+ return NULL;
+}
+
+
+/* Match !$omp declare mapper([ mapper-identifier : ] type :: var) clauses-list */
+
+match
+gfc_match_omp_declare_mapper (void)
+{
+ match m;
+ gfc_typespec ts;
+ char mapper_id[GFC_MAX_SYMBOL_LEN + 1];
+ char var[GFC_MAX_SYMBOL_LEN + 1];
+ gfc_namespace *mapper_ns = NULL;
+ gfc_symtree *var_st;
+ gfc_symtree *st;
+ gfc_omp_udm *omp_udm = NULL, *prev_udm = NULL;
+ locus where = gfc_current_locus;
+
+ if (gfc_match_char ('(') != MATCH_YES)
+ {
+ gfc_error ("Expected %<(%> at %C");
+ return MATCH_ERROR;
+ }
+
+ locus old_locus = gfc_current_locus;
+
+ m = gfc_match (" %n : ", mapper_id);
+
+ if (m == MATCH_ERROR)
+ return MATCH_ERROR;
+
+ /* As a special case, a mapper named "default" and an unnamed mapper are
+ both the default mapper for a given type. */
+ if (strcmp (mapper_id, "default") == 0)
+ mapper_id[0] = '\0';
+
+ if (gfc_peek_ascii_char () == ':')
+ {
+ /* If we see '::', the user did not name the mapper, and instead we just
+ saw the type. So backtrack and try parsing as a type instead. */
+ mapper_id[0] = '\0';
+ gfc_current_locus = old_locus;
+ }
+ old_locus = gfc_current_locus;
+
+ m = gfc_match_type_spec (&ts);
+ if (m != MATCH_YES)
+ {
+ gfc_error ("Expected either a type name at %L or a map-type "
+ "identifier, a colon, or a type name", &old_locus);
+ return MATCH_ERROR;
+ }
+
+ if (ts.type != BT_DERIVED)
+ {
+ gfc_error ("!$OMP DECLARE MAPPER with non-derived type at %L", &old_locus);
+ return MATCH_ERROR;
+ }
+
+ if (gfc_match (" :: ") != MATCH_YES)
+ {
+ gfc_error ("Expected %<::%> at %C");
+ return MATCH_ERROR;
+ }
+
+ if (gfc_match_name (var) != MATCH_YES)
+ {
+ gfc_error ("Expected variable name at %C");
+ return MATCH_ERROR;
+ }
+
+ if (gfc_match_char (')') != MATCH_YES)
+ {
+ gfc_error ("Expected %<)%> at %C");
+ return MATCH_ERROR;
+ }
+
+ st = gfc_find_symtree (gfc_current_ns->omp_udm_root, mapper_id);
+
+ /* Now we need to set up a new namespace, and create a new sym_tree for our
+ dummy variable so we can use it in the following list of mapping
+ clauses. */
+
+ gfc_current_ns = mapper_ns = gfc_get_namespace (gfc_current_ns, 1);
+ mapper_ns->proc_name = mapper_ns->parent->proc_name;
+ mapper_ns->omp_udm_ns = 1;
+
+ gfc_get_sym_tree (var, mapper_ns, &var_st, false);
+ var_st->n.sym->ts = ts;
+ var_st->n.sym->attr.omp_udm_artificial_var = 1;
+ var_st->n.sym->attr.flavor = FL_VARIABLE;
+ gfc_commit_symbols ();
+
+ gfc_omp_clauses *clauses = NULL;
+
+ m = gfc_match_omp_clauses (&clauses, omp_mask (OMP_CLAUSE_MAP), true, true,
+ false, false, OMP_MAP_UNSET);
+ if (m != MATCH_YES)
+ goto failure;
+
+ omp_udm = gfc_get_omp_udm ();
+ omp_udm->next = NULL;
+ omp_udm->where = where;
+ omp_udm->mapper_id = gfc_get_string ("%s", mapper_id);
+ omp_udm->ts = ts;
+ omp_udm->var_sym = var_st->n.sym;
+ omp_udm->mapper_ns = mapper_ns;
+ omp_udm->clauses = clauses;
+
+ gfc_current_ns = mapper_ns->parent;
+
+ prev_udm = gfc_omp_udm_find (st, &ts);
+ if (prev_udm)
+ {
+ if (mapper_id[0])
+ gfc_error ("Redefinition of !$OMP DECLARE MAPPER at %L for type %qs with id %qs",
+ &where, gfc_typename (&ts), mapper_id);
+ else
+ gfc_error ("Redefinition of !$OMP DECLARE MAPPER at %L for type %qs",
+ &where, gfc_typename (&ts));
+ inform (gfc_get_location (&prev_udm->where),
+ "Previous !$OMP DECLARE MAPPER here");
+ return MATCH_ERROR;
+ }
+ else if (st)
+ {
+ omp_udm->next = st->n.omp_udm;
+ st->n.omp_udm = omp_udm;
+ }
+ else
+ {
+ st = gfc_new_symtree (&gfc_current_ns->omp_udm_root, mapper_id);
+ st->n.omp_udm = omp_udm;
+ }
+
+ return MATCH_YES;
+
+failure:
+ if (mapper_ns)
+ gfc_current_ns = mapper_ns->parent;
+ gfc_free_omp_udm (omp_udm);
+
+ return MATCH_ERROR;
+}
+
+
static bool
match_udr_expr (gfc_symtree *omp_sym1, gfc_symtree *omp_sym2)
{
n->sym->reduc_mark = 0;
if (n->sym->attr.flavor == FL_VARIABLE
|| n->sym->attr.proc_pointer
- || (!code && (!n->sym->attr.dummy || n->sym->ns != ns)))
+ || (!code
+ && !ns->omp_udm_ns
+ && (!n->sym->attr.dummy || n->sym->ns != ns)))
{
- if (!code && (!n->sym->attr.dummy || n->sym->ns != ns))
+ if (!code
+ && !ns->omp_udm_ns
+ && (!n->sym->attr.dummy || n->sym->ns != ns))
gfc_error ("Variable %qs is not a dummy argument at %L",
n->sym->name, &n->where);
continue;
array isn't contiguous. An expression such as
arr(-n:n,-n:n) could be contiguous even if it looks
like it may not be. */
- if (code->op != EXEC_OACC_UPDATE
+ if (code
+ && code->op != EXEC_OACC_UPDATE
&& list != OMP_LIST_CACHE
&& list != OMP_LIST_DEPEND
&& !gfc_is_simply_contiguous (n->expr, false, true)
&& n->sym->as->type == AS_ASSUMED_SIZE)
gfc_error ("Assumed size array %qs in %s clause at %L",
n->sym->name, name, &n->where);
- if (list == OMP_LIST_MAP && !openacc)
+ if (code && list == OMP_LIST_MAP && !openacc)
switch (code->op)
{
case EXEC_OMP_TARGET:
for (omp_udr = st->n.omp_udr; omp_udr; omp_udr = omp_udr->next)
gfc_resolve_omp_udr (omp_udr);
}
+
+/* Resolve !$omp declare mapper constructs. */
+
+static void
+gfc_resolve_omp_udm (gfc_omp_udm *omp_udm)
+{
+ resolve_omp_clauses (NULL, omp_udm->clauses, omp_udm->mapper_ns);
+
+ gfc_omp_namelist *n;
+ for (n = omp_udm->clauses->lists[OMP_LIST_MAP]; n; n = n->next)
+ if (n->sym == omp_udm->var_sym)
+ break;
+ if (!n)
+ gfc_error ("At least one %<map%> clause in !$OMP DECLARE MAPPER at %L must "
+ "map %qs or an element of it",
+ &omp_udm->where, omp_udm->var_sym->name);
+}
+
+void
+gfc_resolve_omp_udms (gfc_symtree *st)
+{
+ gfc_omp_udm *omp_udm;
+
+ if (st == NULL)
+ return;
+ gfc_resolve_omp_udms (st->left);
+ gfc_resolve_omp_udms (st->right);
+ for (omp_udm = st->n.omp_udm; omp_udm; omp_udm = omp_udm->next)
+ gfc_resolve_omp_udm (omp_udm);
+}
break;
case 'd':
+ matchdo ("declare mapper", gfc_match_omp_declare_mapper,
+ ST_OMP_DECLARE_MAPPER);
matchds ("declare reduction", gfc_match_omp_declare_reduction,
ST_OMP_DECLARE_REDUCTION);
matchds ("declare simd", gfc_match_omp_declare_simd,
#define case_omp_decl case ST_OMP_THREADPRIVATE: case ST_OMP_DECLARE_SIMD: \
case ST_OMP_DECLARE_TARGET: case ST_OMP_DECLARE_REDUCTION: \
case ST_OMP_DECLARE_VARIANT: case ST_OMP_ALLOCATE: case ST_OMP_ASSUMES: \
- case ST_OMP_REQUIRES: case ST_OMP_GROUPPRIVATE: \
+ case ST_OMP_REQUIRES: case ST_OMP_GROUPPRIVATE: case ST_OMP_DECLARE_MAPPER: \
case ST_OACC_ROUTINE: case ST_OACC_DECLARE
/* OpenMP statements that are followed by a structured block. */
case ST_OMP_CRITICAL:
p = "!$OMP CRITICAL";
break;
+ case ST_OMP_DECLARE_MAPPER:
+ p = "!$OMP DECLARE MAPPER";
+ break;
case ST_OMP_DECLARE_REDUCTION:
p = "!$OMP DECLARE REDUCTION";
break;
gfc_resolve_omp_udrs (ns->omp_udr_root);
+ gfc_resolve_omp_udms (ns->omp_udm_root);
+ if (ns->omp_udm_root)
+ gfc_error ("Sorry, %<declare mapper%>, used at %L, is not yet implemented",
+ &ns->omp_udm_root->n.omp_udm->where);
+
ns->types_resolved = 1;
gfc_current_ns = old_ns;
free (omp_udr_tree);
}
+/* Similar, for !$omp declare mappers. */
+
+static void
+free_omp_udm_tree (gfc_symtree *omp_udm_tree)
+{
+ if (omp_udm_tree == NULL)
+ return;
+
+ free_omp_udm_tree (omp_udm_tree->left);
+ free_omp_udm_tree (omp_udm_tree->right);
+
+ gfc_free_omp_udm (omp_udm_tree->n.omp_udm);
+ free (omp_udm_tree);
+}
+
/* Recursive function that deletes an entire tree and all the user
operator nodes that it contains. */
free_uop_tree (ns->uop_root);
free_common_tree (ns->common_root);
free_omp_udr_tree (ns->omp_udr_root);
+ free_omp_udm_tree (ns->omp_udm_root);
free_tb_tree (ns->tb_sym_root);
free_tb_tree (ns->tb_uop_root);
gfc_free_finalizer_list (ns->finalizers);
--- /dev/null
+! Check that other variables are fine to be mapped - but only if the var itself is mapped
+
+subroutine one
+implicit none
+type t
+ integer :: x(5)
+end type
+
+integer :: q, z
+
+!$omp declare mapper(t :: v) map(v%x(1:5)) ! { dg-error "Sorry, 'declare mapper', used at .1., is not yet implemented" }
+!$omp declare mapper(my_name : t :: v2) map(q) map(v2) map(z)
+
+type(t) :: var(4)
+type(t) :: var2(4)
+
+ !$omp target enter data map(var)
+ !$omp target enter data map(mapper(my_name), to : var2)
+
+!$omp assume contains(declare mapper) ! { dg-error "Invalid 'DECLARE MAPPER' directive at .1. in CONTAINS clause: declarative, informational, and meta directives not permitted" }
+block
+end block
+end
+
+
+subroutine two
+implicit none
+type t
+end type t
+integer :: y
+!$omp declare mapper( t :: var) map(to: y) ! { dg-error "At least one 'map' clause in !.OMP DECLARE MAPPER at .1. must map 'var' or an element of it" }
+! { dg-error "Sorry, 'declare mapper', used at .1., is not yet implemented" "" { target *-*-* } .-1 }
+end
+
+
+subroutine three
+implicit none
+type t
+end type t
+integer :: y
+!$omp declare mapper( t :: var) ! { dg-error "At least one 'map' clause in !.OMP DECLARE MAPPER at .1. must map 'var' or an element of it" }
+! { dg-error "Sorry, 'declare mapper', used at .1., is not yet implemented" "" { target *-*-* } .-1 }
+end
+
+subroutine four
+ type t
+ end type t
+ !$omp declare mapper(my_id : t :: v2) map(v2) ! { dg-note "Previous !.OMP DECLARE MAPPER here" }
+
+ !$omp declare mapper(my_id : t :: v3) map(v3) ! { dg-error "Redefinition of !.OMP DECLARE MAPPER at .1. for type 'TYPE\\(t\\)' with id 'my_id'" }
+
+ !$omp declare mapper(t :: v4) map(v4) ! { dg-note "Previous !.OMP DECLARE MAPPER here" }
+! { dg-error "Sorry, 'declare mapper', used at .1., is not yet implemented" "" { target *-*-* } .-1 }
+ !$omp declare mapper(t :: v5) map(v5) ! { dg-error "Redefinition of !.OMP DECLARE MAPPER at .1. for type 'TYPE\\(t\\)'" }
+end
--- /dev/null
+implicit none
+type t
+end type t
+integer :: a,b,c
+
+!$omp declare mapper ! { dg-error "Expected '\\('" }
+!$omp declare mapper( ! { dg-error "Expected either a type name at .1. or a map-type identifier, a colon, or a type name" }
+!$omp declare mapper(a : b ! { dg-error "Expected either a type name at .1. or a map-type identifier, a colon, or a type name" }
+
+!$omp declare mapper(t : a ! { dg-error "Expected either a type name at .1. or a map-type identifier, a colon, or a type name" }
+!$omp declare mapper(t :: a ! { dg-error "Expected '\\)'" }
+
+!$omp declare mapper( name : t :: ! { dg-error "Expected variable name" }
+
+!$omp declare mapper( name : t :: var ! { dg-error "Expected '\\)'" }
+
+!$omp declare mapper( name : t :: var) foo ! { dg-error "Failed to match clause" }
+
+
+!$omp declare mapper( name : t2 :: var) ! { dg-error "Expected either a type name at .1. or a map-type identifier, a colon, or a type name" }
+!$omp declare mapper( name : integer :: var) ! { dg-error "!.OMP DECLARE MAPPER with non-derived type" }
+end
projects / thirdparty / gcc.git / commitdiff
