I would like to write OpenMP's '!$omp declare mapper' to a .mod module file.
And I have now two options how to implement it:
(A) Only write out the 'declare mapper' if used - without bumping the
module version number.
It is expected that most Fortran OpenMP users will not use 'declare mapper'
as allocatable components of derived types are mapped along side the derived
type - and also because, even for pointers, their size is automatically
available.
Hence, if no declare mapper is used, GCC 17 modules will be compatible with
GCC 15 and GCC 16 compilers - with the obvious advantages.
Downside: If a mapper is written to a module, GCC 15/16 will output the
following not so helpful error:
f951: Fatal Error: Reading module ‘m.mod’ at line 20 column 2: Expected
integer
(B) Bumping the MOD_VERSION
While GCC 17 can still read GCC 15/16 .mod files, it means that all GCC 17
produced mod files will fail with:
Cannot read module file %qs opened at %C, because it was created
by a different version of GNU Fortran
That's obviously a nicer diagnostic, but it breaks .mod file downward
compatibility with GCC 15/GCC 16 - even if only very rarely required.
The code will still look similar as I cannot really get rid of the 'UDM'
marker as there is no way to distinguish the cases otherwise on read.
(C) Adding a check whether mappers are declared and only then use "17" as
module version - otherwise, keep using "16" as MOD_VERSION. This modifies
some larger parts in the general handling, but for the read, it would
boil down to a simple numeric condition ('if (actual_mod_version > 16)').
Thoughts? The current version implements (A).
* * *
The attached patch still needs to be proofread and the change log updated;
however, to make it easier to discuss this, I attached the full patch.
Relevant for this discussion is only module.cc, but obviously any patch
comment is welcome!
Tobias
PS: Known issues 'declare mapper' + 'declare reduction' don't handle
derived-type renaming.
And for 'declare mapper', resolving + actual code gen is still missing;
I need to combine the mentioned patch plus three follow up commits by
Julian to do this. But let's first get the module handling part in.
Fortran/OpenMP: Add module support for 'declare mapper'
This patch is based on
Julian Brown <[email protected]>
OG14 commit 015cb4002d6c022b33234e6098303edf159fb19e
OpenMP: Fortran "!$omp declare mapper" support
gcc/fortran/ChangeLog:
* gfortran.h (enum gfc_omp_linear_op):
(gfc_get_omp_namelist_udm):
* match.cc (gfc_free_omp_namelist):
* module.cc (MOD_VERSION_NUMERIC):
(load_omp_udms):
(check_omp_declare_mappers):
(read_module):
(write_omp_udr):
(write_omp_udm):
(write_omp_udms):
(write_module):
* openmp.cc (gfc_match_dupl_atomic):
(gfc_match_omp_clauses):
(resolve_omp_clauses):
* resolve.cc (resolve_types):
* trans-openmp.cc (gfc_trans_omp_clauses):
gcc/testsuite/ChangeLog:
* gfortran.dg/gomp/declare-mapper-1.f90:
* gfortran.dg/gomp/declare-mapper-3.f90: New test.
* gfortran.dg/gomp/declare-mapper-31.f90: New test.
* gfortran.dg/gomp/declare-mapper-4.f90: New test.
* gfortran.dg/gomp/declare-mapper-5.f90: New test.
gcc/fortran/gfortran.h | 20 +-
gcc/fortran/match.cc | 8 +-
gcc/fortran/module.cc | 258 ++++++++++++++++++++-
gcc/fortran/openmp.cc | 46 +++-
gcc/fortran/resolve.cc | 3 -
gcc/fortran/trans-openmp.cc | 7 +
.../gfortran.dg/gomp/declare-mapper-1.f90 | 5 +-
.../gfortran.dg/gomp/declare-mapper-3.f90 | 29 +++
.../gfortran.dg/gomp/declare-mapper-31.f90 | 38 +++
.../gfortran.dg/gomp/declare-mapper-4.f90 | 20 ++
.../gfortran.dg/gomp/declare-mapper-5.f90 | 39 ++++
11 files changed, 441 insertions(+), 32 deletions(-)
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index ef6239cd667..ce360921d18 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1423,15 +1423,6 @@ enum gfc_omp_linear_op
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.). */
@@ -1485,7 +1476,7 @@ typedef struct gfc_omp_namelist
} u2;
union
{
- struct gfc_omp_namelist_udm udm;
+ struct gfc_omp_namelist_udm *udm;
} u3;
struct gfc_omp_namelist *next;
locus where;
@@ -1898,6 +1889,15 @@ typedef struct gfc_omp_udm
gfc_omp_udm;
#define gfc_get_omp_udm() XCNEW (gfc_omp_udm)
+typedef struct gfc_omp_namelist_udm
+{
+ const char *mapper_id;
+ struct gfc_omp_udm *udm;
+}
+gfc_omp_namelist_udm;
+#define gfc_get_omp_namelist_udm() XCNEW (gfc_omp_namelist_udm)
+
+
/* The gfc_st_label structure is a BBT attached to a namespace that
records the usage of statement labels within that space. */
diff --git a/gcc/fortran/match.cc b/gcc/fortran/match.cc
index e8f2cd8580c..e2cd813780b 100644
--- a/gcc/fortran/match.cc
+++ b/gcc/fortran/match.cc
@@ -6521,7 +6521,9 @@ gfc_free_omp_namelist (gfc_omp_namelist *name, enum gfc_omp_list_type 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);
+ bool free_mapper = (list == OMP_LIST_MAP
+ || list == OMP_LIST_TO
+ || list == OMP_LIST_FROM);
gfc_omp_namelist *n;
gfc_expr *last_allocator = NULL;
@@ -6555,8 +6557,8 @@ gfc_free_omp_namelist (gfc_omp_namelist *name, enum gfc_omp_list_type list)
free (name->u2.init_interop);
}
}
- else if (free_mapper)
- { } /* For now, u3.udm is not a pointer. */
+ else if (free_mapper && name->u3.udm)
+ free (name->u3.udm);
else if (!free_mapper && name->u2.udr)
{
if (name->u2.udr->combiner)
diff --git a/gcc/fortran/module.cc b/gcc/fortran/module.cc
index 2bb116c79a4..913afba7a65 100644
--- a/gcc/fortran/module.cc
+++ b/gcc/fortran/module.cc
@@ -86,6 +86,7 @@ along with GCC; see the file COPYING3. If not see
/* Don't put any single quote (') in MOD_VERSION, if you want it to be
recognized. */
#define MOD_VERSION "16"
+#define MOD_VERSION_NUMERIC 16
/* Older mod versions we can still parse. */
#define COMPAT_MOD_VERSIONS { "15" }
@@ -5486,6 +5487,120 @@ load_omp_udrs (void)
}
+/* In declare mapper, not all map types are permitted; hence, only
+ a subset is needed. */
+
+static const mstring omp_map_clause_ops[] =
+{
+ minit ("ALLOC", OMP_MAP_ALLOC),
+ minit ("TO", OMP_MAP_TO),
+ minit ("FROM", OMP_MAP_FROM),
+ minit ("TOFROM", OMP_MAP_TOFROM),
+ minit ("ALWAYS_TO", OMP_MAP_ALWAYS_TO),
+ minit ("ALWAYS_FROM", OMP_MAP_ALWAYS_FROM),
+ minit ("ALWAYS_TOFROM", OMP_MAP_ALWAYS_TOFROM),
+ minit ("UNSET", OMP_MAP_UNSET),
+ minit (NULL, -1)
+};
+
+/* This function loads OpenMP user-defined mappers. */
+
+static void
+load_omp_udms (void)
+{
+ while (peek_atom () != ATOM_RPAREN)
+ {
+ const char *mapper_id = NULL;
+ gfc_symtree *st;
+
+ mio_lparen ();
+ gfc_omp_udm *udm = gfc_get_omp_udm ();
+
+ require_atom (ATOM_INTEGER);
+ pointer_info *udmpi = get_integer (atom_int);
+ associate_integer_pointer (udmpi, udm);
+
+ mio_pool_string (&mapper_id);
+
+ /* Note: for a derived-type typespec, we might not have loaded the
+ "u.derived" symbol yet. Defer checking duplicates until
+ check_omp_declare_mappers is called after loading all symbols. */
+ mio_typespec (&udm->ts);
+
+ if (mapper_id == NULL)
+ mapper_id = gfc_get_string ("%s", "");
+
+ st = gfc_find_symtree (gfc_current_ns->omp_udm_root, mapper_id);
+
+ pointer_info *p = mio_symbol_ref (&udm->var_sym);
+ pointer_info *q = get_integer (p->u.rsym.ns);
+
+ udm->where = gfc_current_locus;
+ udm->mapper_id = mapper_id;
+ udm->mapper_ns = gfc_get_namespace (gfc_current_ns, 1);
+ udm->mapper_ns->proc_name = gfc_current_ns->proc_name;
+ udm->mapper_ns->omp_udm_ns = 1;
+
+ associate_integer_pointer (q, udm->mapper_ns);
+
+ gfc_omp_namelist *clauses = NULL;
+ gfc_omp_namelist **clausep = &clauses;
+
+ mio_lparen ();
+ while (peek_atom () != ATOM_RPAREN)
+ {
+ /* Read each map clause. */
+ gfc_omp_namelist *n = gfc_get_omp_namelist ();
+
+ mio_lparen ();
+
+ n->u.map.op = (gfc_omp_map_op) mio_name (0, omp_map_clause_ops);
+ mio_symbol_ref (&n->sym);
+ mio_expr (&n->expr);
+
+ mio_lparen ();
+
+ if (peek_atom () != ATOM_RPAREN)
+ {
+ n->u3.udm = gfc_get_omp_namelist_udm ();
+ mio_pool_string (&n->u3.udm->mapper_id);
+
+ if (n->u3.udm->mapper_id == NULL)
+ n->u3.udm->mapper_id = gfc_get_string ("%s", "");
+
+ mio_pointer_ref (&n->u3.udm->udm);
+ }
+
+ mio_rparen ();
+
+ n->where = gfc_current_locus;
+
+ mio_rparen ();
+
+ *clausep = n;
+ clausep = &n->next;
+ }
+ mio_rparen ();
+
+ udm->clauses = gfc_get_omp_clauses ();
+ udm->clauses->lists[OMP_LIST_MAP] = clauses;
+
+ if (st)
+ {
+ udm->next = st->n.omp_udm;
+ st->n.omp_udm = udm;
+ }
+ else
+ {
+ st = gfc_new_symtree (&gfc_current_ns->omp_udm_root, mapper_id);
+ st->n.omp_udm = udm;
+ }
+
+ mio_rparen ();
+ }
+}
+
+
/* Recursive function to traverse the pointer_info tree and load a
needed symbol. We return nonzero if we load a symbol and stop the
traversal, because the act of loading can alter the tree. */
@@ -5676,12 +5791,50 @@ check_for_ambiguous (gfc_symtree *st, pointer_info *info)
}
+static void
+check_omp_declare_mappers (gfc_symtree *st)
+{
+ if (!st)
+ return;
+
+ check_omp_declare_mappers (st->left);
+ check_omp_declare_mappers (st->right);
+
+ gfc_omp_udm **udmp = &st->n.omp_udm;
+ gfc_symtree tmp_st;
+
+ while (*udmp)
+ {
+ gfc_omp_udm *udm = *udmp;
+ tmp_st.n.omp_udm = udm->next;
+ gfc_omp_udm *prev_udm = gfc_omp_udm_find (&tmp_st, &udm->ts);
+ if (prev_udm)
+ {
+ gfc_error ("Ambiguous !$OMP DECLARE MAPPER %qs for type %qs from "
+ "module %qs at %L",
+ st->n.omp_udm->mapper_id[0] != '\0'
+ ? st->n.omp_udm->mapper_id : "default",
+ udm->ts.u.derived->name, module_name,
+ &udm->where);
+ inform (gfc_get_location (&prev_udm->where),
+ "Previous !$OMP DECLARE MAPPER from module %qs",
+ prev_udm->var_sym->module);
+ /* Delete the duplicate. */
+ *udmp = (*udmp)->next;
+ }
+ else
+ udmp = &(*udmp)->next;
+ }
+}
+
+
/* Read a module file. */
static void
read_module (void)
{
- module_locus operator_interfaces, user_operators, omp_udrs;
+ module_locus operator_interfaces, user_operators, omp_udrs, omp_udms;
+ bool has_omp_udms = false;
const char *p;
char name[GFC_MAX_SYMBOL_LEN + 1];
int i;
@@ -5708,6 +5861,20 @@ read_module (void)
get_module_locus (&omp_udrs);
skip_list ();
+ /* Skip OpenMP's user-defined 'declare mapper' (UDM); some extra code is
+ required to permit reading files without USM; see write_module for
+ details. */
+ get_module_locus (&omp_udms);
+ if (peek_atom () == ATOM_LPAREN
+ && parse_atom ()
+ && module_char () == 'U'
+ && module_char () == 'D'
+ && module_char () == 'M')
+ has_omp_udms = true;
+ set_module_locus (&omp_udms);
+ if (has_omp_udms)
+ skip_list ();
+
mio_lparen ();
/* Create the fixup nodes for all the symbols. */
@@ -6057,6 +6224,19 @@ read_module (void)
set_module_locus (&omp_udrs);
load_omp_udrs ();
+ /* Load OpenMP user defined mappers. */
+ if (has_omp_udms)
+ {
+ set_module_locus (&omp_udms);
+ mio_lparen ();
+ /* Skip 'UDM' marker, cf. above. */
+ (void) module_char ();
+ (void) module_char ();
+ (void) module_char ();
+ load_omp_udms ();
+ mio_rparen ();
+ }
+
/* At this point, we read those symbols that are needed but haven't
been loaded yet. If one symbol requires another, the other gets
marked as NEEDED if its previous state was UNUSED. */
@@ -6089,6 +6269,9 @@ read_module (void)
module_name);
}
+ /* Check "omp declare mappers" for duplicates from different modules. */
+ check_omp_declare_mappers (gfc_current_ns->omp_udm_root);
+
/* Clean up symbol nodes that were never loaded, create references
to hidden symbols. */
@@ -6454,6 +6637,8 @@ write_omp_udr (gfc_omp_udr *udr)
}
+/* Write OpenMP's declare reduction (used defined reductions). */
+
static void
write_omp_udrs (gfc_symtree *st)
{
@@ -6468,6 +6653,63 @@ write_omp_udrs (gfc_symtree *st)
}
+/* Write OpenMP's declare mapper (used defined mapper). */
+
+static void
+write_omp_udm (gfc_omp_udm *udm)
+{
+ mio_lparen ();
+ /* We need this pointer ref to identify this mapper so that other mappers
+ can refer to it. */
+ mio_pointer_ref (&udm);
+ mio_pool_string (&udm->mapper_id);
+ mio_typespec (&udm->ts);
+
+ if (udm->var_sym->module == NULL)
+ udm->var_sym->module = module_name;
+
+ mio_symbol_ref (&udm->var_sym);
+ mio_lparen ();
+ gfc_omp_namelist *n;
+ for (n = udm->clauses->lists[OMP_LIST_MAP]; n; n = n->next)
+ {
+ mio_lparen ();
+
+ mio_name (n->u.map.op, omp_map_clause_ops);
+ mio_symbol_ref (&n->sym);
+ mio_expr (&n->expr);
+
+ mio_lparen ();
+
+ if (n->u3.udm)
+ {
+ mio_pool_string (&n->u3.udm->mapper_id);
+ mio_pointer_ref (&n->u3.udm->udm);
+ }
+
+ mio_rparen ();
+
+ mio_rparen ();
+ }
+ mio_rparen ();
+ mio_rparen ();
+}
+
+
+static void
+write_omp_udms (gfc_symtree *st)
+{
+ if (st == NULL)
+ return;
+
+ write_omp_udms (st->left);
+ gfc_omp_udm *udm;
+ for (udm = st->n.omp_udm; udm; udm = udm->next)
+ write_omp_udm (udm);
+ write_omp_udms (st->right);
+}
+
+
/* Type for the temporary tree used when writing secondary symbols. */
struct sorted_pointer_info
@@ -6730,6 +6972,20 @@ write_module (void)
write_char ('\n');
write_char ('\n');
+ /* Condition can be removed if version is bumped. Note that
+ write_symbol0 starts with an integer. Keep in sync with read_module;
+ The 'UDM' tag can be only removed when changing COMPAT_MOD_VERSIONS. */
+ STATIC_ASSERT (MOD_VERSION_NUMERIC == 16);
+ if (gfc_current_ns->omp_udm_root)
+ {
+ mio_lparen ();
+ write_atom (ATOM_NAME, "UDM"); /* Marker. */
+ write_omp_udms (gfc_current_ns->omp_udm_root);
+ mio_rparen ();
+ write_char ('\n');
+ write_char ('\n');
+ }
+
/* Write symbol information. First we traverse all symbols in the
primary namespace, writing those that need to be written.
Sometimes writing one symbol will cause another to need to be
diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc
index 4fd681efece..3d7d12de0c2 100644
--- a/gcc/fortran/openmp.cc
+++ b/gcc/fortran/openmp.cc
@@ -2466,7 +2466,8 @@ gfc_match_dupl_atomic (bool not_dupl, const char *name)
/* Search upwards though namespace NS and its parents to find an
- !$omp declare mapper named MAPPER_ID, for typespec TS. */
+ !$omp declare mapper named MAPPER_ID, for typespec TS. The default
+ mapper has mapper_id == "". */
gfc_omp_udm *
gfc_find_omp_udm (gfc_namespace *ns, const char *mapper_id, gfc_typespec *ts)
@@ -3841,6 +3842,8 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
m = gfc_match (" %n ) ", mapper_id);
if (m != MATCH_YES)
goto error;
+ if (strcmp (mapper_id, "default") == 0)
+ mapper_id[0] = '\0';
}
else if (gfc_match_iterator (&ns_iter, true) == MATCH_YES)
{
@@ -3934,17 +3937,11 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
for (n = *head; n; n = n->next)
{
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)
+ if (mapper_id[0] != '\0')
{
- n->u3.udm.udm = udm;
+ n->u3.udm = gfc_get_omp_namelist_udm ();
+ n->u3.udm->mapper_id
+ = gfc_get_string ("%s", mapper_id);
}
n->u2.ns = ns_iter;
if (ns_iter)
@@ -10452,6 +10449,33 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
default:
break;
}
+ if (list == OMP_LIST_MAP
+ || list == OMP_LIST_TO
+ || list == OMP_LIST_FROM)
+ {
+ gfc_typespec *ts = n->expr ? &n->expr->ts : &n->sym->ts;
+
+ if (ts->type == BT_DERIVED || ts->type == BT_CLASS)
+ {
+ const char *mapper_id = (n->u3.udm
+ ? n->u3.udm->mapper_id : "");
+ gfc_omp_udm *udm = gfc_find_omp_udm (gfc_current_ns,
+ mapper_id, ts);
+ if (mapper_id[0] != '\0' && !udm)
+ gfc_error ("User-defined mapper %qs not found at %L",
+ mapper_id, &n->where);
+ else if (udm)
+ {
+ if (!n->u3.udm)
+ {
+ gcc_assert (mapper_id[0] == '\0');
+ n->u3.udm = gfc_get_omp_namelist_udm ();
+ n->u3.udm->mapper_id = mapper_id;
+ }
+ n->u3.udm->udm = udm;
+ }
+ }
+ }
}
if (list != OMP_LIST_DEPEND)
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 8d2a0349881..6bfc5ff01ca 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -20631,9 +20631,6 @@ resolve_types (gfc_namespace *ns)
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;
diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc
index 43697e99453..af1c5c1046a 100644
--- a/gcc/fortran/trans-openmp.cc
+++ b/gcc/fortran/trans-openmp.cc
@@ -4322,6 +4322,13 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
{
if (!openacc)
{
+ if (n->u3.udm)
+ gfc_error ("Sorry, declared mapper %qs, used for %qs at %L, "
+ "is not yet supported",
+ n->u3.udm->mapper_id[0] != '\0'
+ ? n->u3.udm->mapper_id : "default",
+ n->sym->name, &n->where);
+
// Remove duplicates
bool skip = false;
for (gfc_omp_namelist *n2 = n->next; n2 != NULL;
diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-mapper-1.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-1.f90
index ef79f91e3fe..ee5d004c262 100644
--- a/gcc/testsuite/gfortran.dg/gomp/declare-mapper-1.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-1.f90
@@ -8,7 +8,7 @@ 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(t :: v) map(v%x(1:5))
!$omp declare mapper(my_name : t :: v2) map(q) map(v2) map(z)
type(t) :: var(4)
@@ -29,7 +29,6 @@ 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
@@ -39,7 +38,6 @@ 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
@@ -50,6 +48,5 @@ subroutine four
!$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
diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-mapper-3.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-3.f90
new file mode 100644
index 00000000000..52e2170e046
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-3.f90
@@ -0,0 +1,29 @@
+! { dg-do compile }
+
+! Simple module test.
+
+module m
+ implicit none
+ type t
+ integer :: x
+ end type t
+ !$omp declare mapper(t :: v) map(v)
+ !$omp declare mapper(only_x : t :: y) map(y%x)
+
+type(t) :: var2
+contains
+subroutine s
+!$omp target enter data map(mapper(default), to: var2) ! { dg-error "Sorry, declared mapper 'default', used for 'var2' at .1., is not yet supported" }
+end
+end module m
+
+use m
+implicit none
+type(t) :: var
+!$omp target enter data map(mapper(default), to: var) ! { dg-error "Sorry, declared mapper 'default', used for 'var' at .1., is not yet supported" }
+
+!$omp target exit data map(mapper(only_x), release: var) ! { dg-error "Sorry, declared mapper 'only_x', used for 'var' at .1., is not yet supported" }
+
+!$omp target map(var) ! { dg-error "Sorry, declared mapper 'default', used for 'var' at .1., is not yet supported" }
+!$omp end target
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-mapper-31.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-31.f90
new file mode 100644
index 00000000000..f0701d54194
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-31.f90
@@ -0,0 +1,38 @@
+! { dg-do compile }
+
+type t
+integer :: x, y
+integer, allocatable :: arr(:)
+end type t
+
+type(t) :: var
+
+allocate(var%arr(1:20))
+
+var%arr = 0
+
+! If we ask for a named mapper that hasn't been defined, an error should be
+! raised. This isn't a *syntax* error, so the !$omp target..!$omp end target
+! block should still be parsed correctly.
+!$omp target map(mapper(arraymapper), tofrom: var)
+! { dg-error "User-defined mapper .arraymapper. not found" "" { target *-*-* } .-1 }
+block
+var%arr(5) = 5
+end block
+!$omp end target
+
+! OTOH, this is a syntax error, and the offload block is not recognized.
+!$omp target map(
+! { dg-error "Syntax error in OpenMP variable list" "" { target *-*-* } .-1 }
+block
+var%arr(6) = 6
+end block
+
+! ...but not for the specific name 'default'.
+!$omp target map(mapper(default), tofrom: var)
+block
+var%arr(5) = 5
+end block
+!$omp end target
+
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-mapper-4.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-4.f90
new file mode 100644
index 00000000000..9403dd58993
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-4.f90
@@ -0,0 +1,20 @@
+module m
+ implicit none
+ private
+ type t
+ integer :: x, z
+ end type t
+ type t2
+ ! private
+ type(t) :: y
+ end type t2
+ public :: t2
+ !$omp declare mapper(t :: v) map(v%x)
+end module m
+
+use m
+implicit none
+type(t2) :: var
+! Shall honor mapper
+!$omp target enter data map(var%y) ! { dg-error "Sorry, declared mapper 'default', used for 'var' at .1., is not yet supported" }
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-mapper-5.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-5.f90
new file mode 100644
index 00000000000..97a2f0b5b45
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-5.f90
@@ -0,0 +1,39 @@
+! { dg-do compile }
+
+! The following are two declare mapper.
+! Technically, they aren't ambiguous as they are identical
+! but still we expect an error.
+
+module one
+ implicit none
+ type t
+ integer, pointer :: x(:)
+ end type t
+end module
+
+module two
+ use one
+ implicit none
+ !$omp declare mapper(t :: v) map(v, v%x)
+end module two
+
+module three
+ use one
+ implicit none
+ !$omp declare mapper(t :: v) map(v, v%x)
+end module three
+
+subroutine sub1
+ use two ! { dg-note "Previous !.OMP DECLARE MAPPER from module 'two'" }
+ use three ! { dg-error "Ambiguous !.OMP DECLARE MAPPER 'default' for type 't' from module 'three' at .1." }
+ implicit none
+ type(t) :: var
+
+ allocate(var%x(1:20))
+ var%x = 0
+
+ !$omp target map(tofrom: var)
+ block
+ var%x = 1
+ end block
+end
