* [PATCH 6/6] OpenMP: Fortran "!$omp declare mapper" support
2022-06-01 18:39 [PATCH 0/6] OpenMP 5.0: Fortran "declare mapper" support Julian Brown
` (4 preceding siblings ...)
2022-06-01 18:40 ` [PATCH 5/6] OpenMP: Pointers and member mappings Julian Brown
@ 2022-06-01 18:40 ` Julian Brown
5 siblings, 0 replies; 8+ messages in thread
From: Julian Brown @ 2022-06-01 18:40 UTC (permalink / raw)
To: gcc-patches; +Cc: fortran, Tobias Burnus, Jakub Jelinek
This patch implements "omp declare mapper" functionality for Fortran,
following the equivalent support for C and C++.
Fortran differs quite substantially from C and C++ in that "map"
clauses are naturally represented in the gfortran front-end's own
representation rather than as trees. Those are turned into one -- or
several -- OMP_CLAUSE_MAP nodes in gfc_trans_omp_clauses.
The "several nodes" case is problematic for mappers, for a few different
reasons:
- Firstly, if we're invoking a nested mapper, we need some way of
keeping those nodes together so they can be replaced "as one" by the
clauses listed in that mapper. (For C and C++, a single OMP_CLAUSE_MAP
node is used to represent a map clause early in compilation, which
is then expanded in c_finish_omp_clauses for C, and similar for C++.
We process mappers before that function is called.)
- Secondly, the process of translating FE representation of clauses
into "tree" mapping nodes can generate preamble code, and we need to
either defer that generation or else put the preamble code somewhere
if we're defining a mapper.
- Thirdly, gfc_trans_omp_clauses needs to examine both the FE
representation and partially-translated tree codes. In the case
where we're instantiating mappers implicitly from the middle end,
the FE representation is long gone.
The scheme used is as follows.
For the first problem, we introduce a GOMP_MAP_MAPPING_GROUP mapping kind.
This is used to keep several mapping nodes together in mapper definitions
until instantiation time. If the group triggers a nested mapper,
the required information can be extracted from it and then it can be
deleted/replaced as a whole.
For the second and third problems, we emit preamble code into a function
wrapping the "omp declare mapper" node. This extends the scheme currently
under review for C++, and performs inlining of a modified version of
the function whenever a mapper is invoked from the middle-end. New copies
of variables (e.g. temporary array descriptors or other metadata) are
introduced to copy needed values out of the inlined function to where
they're needed in the mapper instantiation.
For Fortran, we also need to add special-case handling for mapping
derived-type variables that are (a) pointers and (b) trigger a mapper,
in both the explicit mapping and implicit mapping cases. If we have a
type and a mapper like this:
type T
integer, dimension(10) :: iarr
end type T
type(T), pointer :: tptr
!$omp declare mapper (T :: t) map(t%iarr)
!$omp target map(tptr)
[...]
!$omp end target
Here "map(tptr)" maps the pointer itself, and implicitly maps the
pointed-to object as well. So, when invoking the mapper, rather than
rewriting this as just:
!$omp target map(tptr%iarr)
we must introduce a new node to map the pointer also, i.e.:
!$omp target map(alloc:tptr) map(tptr%iarr)
...before the mapping nodes go off to gimplify for processing.
(This relates to the previous patch in the series.)
We also need to handle module writing and reading for "declare mappers".
This requires an ABI bump that I noticed one of Tobias's patches also
does, so we'll probably need to synchronize on that somehow.
OK?
Thanks,
Julian
2022-06-01 Julian Brown <julian@codesourcery.com>
gcc/fortran/
* dump-parse-tree.cc (show_attr): Show omp_udm_artificial_var flag.
(show_omp_namelist): Support OMP_MAP_UNSET.
* f95-lang.cc (LANG_HOOKS_OMP_FINISH_MAPPER_CLAUSES,
LANG_HOOKS_OMP_EXTRACT_MAPPER_DIRECTIVE,
LANG_HOOKS_OMP_MAP_ARRAY_SECTION): Define language hooks.
* gfortran.h (gfc_statement): Add ST_OMP_DECLARE_MAPPER.
(symbol_attribute): Add omp_udm_artificial_var attribute.
(gfc_omp_map_op): Add OMP_MAP_UNSET.
(gfc_omp_namelist): Add udm pointer to u2 union.
(gfc_omp_udm): New struct.
(gfc_omp_namelist_udm): New struct.
(gfc_symtree): Add omp_udm pointer.
(gfc_namespace): Add omp_udm_root symtree. Add omp_udm_ns flag.
(gfc_free_omp_namelist): Update prototype.
(gfc_free_omp_udm, gfc_omp_udm_find, gfc_find_omp_udm,
gfc_resolve_omp_udms): Add prototypes.
* match.cc (gfc_free_omp_namelist): Change FREE_NS parameter to LIST,
to handle freeing user-defined mapper namelists safely.
* match.h (gfc_match_omp_declare_mapper): Add prototype.
* module.cc (MOD_VERSION): Bump to 16.
(ab_attribute): Add AB_OMP_DECLARE_MAPPER_VAR.
(attr_bits): Add OMP_DECLARE_MAPPER_VAR.
(mio_symbol_attribute): Read/write AB_OMP_DECLARE_MAPPER_VAR attribute.
Set referenced attr on read.
(omp_map_clause_ops, omp_map_cardinality): New arrays.
(load_omp_udms, check_omp_declare_mappers): New functions.
(read_module): Load and check OMP declare mappers.
(write_omp_udm, write_omp_udms): New functions.
(write_module): Write OMP declare mappers.
* openmp.cc (gfc_free_omp_clauses, gfc_match_omp_variable_list,
gfc_match_omp_to_link, gfc_match_omp_depend_sink,
gfc_match_omp_clause_reduction): Update calls to gfc_free_omp_namelist.
(gfc_free_omp_udm, gfc_find_omp_udm, gfc_omp_udm_find,
gfc_match_omp_declare_mapper): New functions.
(gfc_match_omp_clauses): Add DEFAULT_MAP_OP parameter. Update calls to
gfc_free_omp_namelist. Add declare mapper support.
(resolve_omp_clauses): Add declare mapper support. Update calls to
gfc_free_omp_namelist.
(gfc_resolve_omp_udm, gfc_resolve_omp_udms): New functions.
* parse.cc (decode_omp_directive): Add declare mapper support.
(case_omp_decl): Add ST_OMP_DECLARE_MAPPER case.
(gfc_ascii_statement): Add ST_OMP_DECLARE_MAPPER case.
* resolve.cc (resolve_types): Call gfc_resolve_omp_udms.
* st.cc (gfc_free_statement): Update call to gfc_free_omp_namelist.
* symbol.cc (free_omp_udm_tree): New function.
(gfc_free_namespace): Call above.
* trans-decl.cc (omp_declare_mapper_ns): New global.
(gfc_finish_var_decl, gfc_generate_function_code): Support declare
mappers.
* trans-openmp.cc (tree-iterator.h): Include.
(gfc_omp_finish_mapper_clauses, gfc_omp_extract_mapper_directive,
gfc_omp_map_array_section): New functions.
(omp_clause_directive): New enum.
(gfc_trans_omp_clauses): Remove DECLARE_SIMD and OPENACC parameters.
Replace with omp_clause_directive CD, defaulting to OMP_CD_OPENMP.
Add declare mapper support.
(gfc_trans_omp_construct, gfc_trans_oacc_executable_directive,
gfc_trans_oacc_combined_directive): Update calls to
gfc_trans_omp_clauses.
(gfc_subst_replace, gfc_subst_prepend_ref): New variables.
(gfc_subst_in_expr_1, gfc_subst_in_expr, gfc_subst_mapper_var,
gfc_trans_omp_instantiate_mapper, gfc_trans_omp_instantiate_mappers,
gfc_record_mapper_bindings_code_fn, gfc_record_mapper_bindings_expr_fn,
gfc_find_nested_mappers, gfc_record_mapper_bindings): New functions.
(gfc_typespec * hash traits): New template.
(omp_declare_mapper_ns): Extern declaration.
(gfc_trans_omp_target): Call gfc_trans_omp_instantiate_mappers and
gfc_record_mapper_bindings. Update calls to gfc_trans_omp_clauses.
(gfc_trans_omp_declare_simd, gfc_trans_omp_declare_variant): Update
calls to gfc_trans_omp_clauses.
(gfc_trans_omp_mapper_name, gfc_trans_omp_declare_mapper,
gfc_trans_omp_declare_mappers): New functions.
* trans-stmt.h (gfc_trans_omp_declare_mappers): Add prototype.
* trans.h (gfc_omp_finish_mapper_clauses,
gfc_omp_extract_mapper_directive, gfc_omp_map_array_section): Add
prototypes.
gcc/
* gimplify.cc (remap_mapper_decl_info): Remove.
(remap_mapper_decl_1): Rewrite to use remap_decl.
(omp_mapper_copy_decl, omp_mapping_group_data, omp_mapping_group_ptr):
New functions.
(omp_instantiate_mapper): Add PRE_P parameter. Change MAPPER parameter
to MAPPERFN. Handle inlining of "declare mapper" function bodies
containing setup code (e.g. for Fortran). Handle pointers to derived
types. Handle GOMP_MAP_MAPPING_GROUPs.
(omp_find_explicitly_mapped_structs): Reimplement using decl splay
tree, rename to...
(omp_find_explicitly_mapped_structs_r): This.
(omp_instantiate_implicit_mappers): Skip explicitly mapped/nonlocal/not
seen decls. Avoid mapping structs with mappers twice (in
gimplify_adjust_omp_clauses_1 also).
(gimplify_scan_omp_clauses): Update call to
omp_find_explicitly_mapped_structs_r. Put mapperfn instead of mapper
in context's implicit_mappers table.
* tree-pretty-print.cc (dump_omp_clause): Handle GOMP_MAP_MAPPING_GROUP.
include/
* gomp-constants.h (gomp_map_kind): Add GOMP_MAP_MAPPING_GROUP.
gcc/testsuite/
* gfortran.dg/gomp/declare-mapper-1.f90: New test.
* gfortran.dg/gomp/declare-mapper-5.f90: New test.
* gfortran.dg/gomp/declare-mapper-14.f90: New test.
* gfortran.dg/gomp/declare-mapper-16.f90: New test.
libgomp/
* testsuite/libgomp.fortran/declare-mapper-2.f90: New test.
* testsuite/libgomp.fortran/declare-mapper-3.f90: New test.
* testsuite/libgomp.fortran/declare-mapper-4.f90: New test.
* testsuite/libgomp.fortran/declare-mapper-6.f90: New test.
* testsuite/libgomp.fortran/declare-mapper-7.f90: New test.
* testsuite/libgomp.fortran/declare-mapper-8.f90: New test.
* testsuite/libgomp.fortran/declare-mapper-9.f90: New test.
* testsuite/libgomp.fortran/declare-mapper-10.f90: New test.
* testsuite/libgomp.fortran/declare-mapper-11.f90: New test.
* testsuite/libgomp.fortran/declare-mapper-12.f90: New test.
* testsuite/libgomp.fortran/declare-mapper-13.f90: New test.
* testsuite/libgomp.fortran/declare-mapper-15.f90: New test.
* testsuite/libgomp.fortran/declare-mapper-17.f90: New test.
* testsuite/libgomp.fortran/declare-mapper-18.f90: New test.
* testsuite/libgomp.fortran/declare-mapper-19.f90: New test.
* testsuite/libgomp.fortran/declare-mapper-20.f90: New test.
---
gcc/fortran/dump-parse-tree.cc | 3 +
gcc/fortran/f95-lang.cc | 7 +
gcc/fortran/gfortran.h | 55 +-
gcc/fortran/match.cc | 8 +-
gcc/fortran/match.h | 1 +
gcc/fortran/module.cc | 252 ++++++-
gcc/fortran/openmp.cc | 296 +++++++-
gcc/fortran/parse.cc | 9 +-
gcc/fortran/resolve.cc | 2 +
gcc/fortran/st.cc | 2 +-
gcc/fortran/symbol.cc | 16 +
gcc/fortran/trans-decl.cc | 30 +-
gcc/fortran/trans-openmp.cc | 670 +++++++++++++++++-
gcc/fortran/trans-stmt.h | 1 +
gcc/fortran/trans.h | 3 +
gcc/gimplify.cc | 409 +++++++++--
.../gfortran.dg/gomp/declare-mapper-1.f90 | 71 ++
.../gfortran.dg/gomp/declare-mapper-14.f90 | 26 +
.../gfortran.dg/gomp/declare-mapper-16.f90 | 22 +
.../gfortran.dg/gomp/declare-mapper-5.f90 | 45 ++
gcc/tree-pretty-print.cc | 3 +
include/gomp-constants.h | 5 +-
.../libgomp.fortran/declare-mapper-10.f90 | 40 ++
.../libgomp.fortran/declare-mapper-11.f90 | 38 +
.../libgomp.fortran/declare-mapper-12.f90 | 33 +
.../libgomp.fortran/declare-mapper-13.f90 | 49 ++
.../libgomp.fortran/declare-mapper-15.f90 | 24 +
.../libgomp.fortran/declare-mapper-17.f90 | 92 +++
.../libgomp.fortran/declare-mapper-18.f90 | 46 ++
.../libgomp.fortran/declare-mapper-19.f90 | 29 +
.../libgomp.fortran/declare-mapper-2.f90 | 32 +
.../libgomp.fortran/declare-mapper-20.f90 | 29 +
.../libgomp.fortran/declare-mapper-3.f90 | 33 +
.../libgomp.fortran/declare-mapper-4.f90 | 36 +
.../libgomp.fortran/declare-mapper-6.f90 | 28 +
.../libgomp.fortran/declare-mapper-7.f90 | 29 +
.../libgomp.fortran/declare-mapper-8.f90 | 115 +++
.../libgomp.fortran/declare-mapper-9.f90 | 27 +
38 files changed, 2501 insertions(+), 115 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/gomp/declare-mapper-1.f90
create mode 100644 gcc/testsuite/gfortran.dg/gomp/declare-mapper-14.f90
create mode 100644 gcc/testsuite/gfortran.dg/gomp/declare-mapper-16.f90
create mode 100644 gcc/testsuite/gfortran.dg/gomp/declare-mapper-5.f90
create mode 100644 libgomp/testsuite/libgomp.fortran/declare-mapper-10.f90
create mode 100644 libgomp/testsuite/libgomp.fortran/declare-mapper-11.f90
create mode 100644 libgomp/testsuite/libgomp.fortran/declare-mapper-12.f90
create mode 100644 libgomp/testsuite/libgomp.fortran/declare-mapper-13.f90
create mode 100644 libgomp/testsuite/libgomp.fortran/declare-mapper-15.f90
create mode 100644 libgomp/testsuite/libgomp.fortran/declare-mapper-17.f90
create mode 100644 libgomp/testsuite/libgomp.fortran/declare-mapper-18.f90
create mode 100644 libgomp/testsuite/libgomp.fortran/declare-mapper-19.f90
create mode 100644 libgomp/testsuite/libgomp.fortran/declare-mapper-2.f90
create mode 100644 libgomp/testsuite/libgomp.fortran/declare-mapper-20.f90
create mode 100644 libgomp/testsuite/libgomp.fortran/declare-mapper-3.f90
create mode 100644 libgomp/testsuite/libgomp.fortran/declare-mapper-4.f90
create mode 100644 libgomp/testsuite/libgomp.fortran/declare-mapper-6.f90
create mode 100644 libgomp/testsuite/libgomp.fortran/declare-mapper-7.f90
create mode 100644 libgomp/testsuite/libgomp.fortran/declare-mapper-8.f90
create mode 100644 libgomp/testsuite/libgomp.fortran/declare-mapper-9.f90
diff --git a/gcc/fortran/dump-parse-tree.cc b/gcc/fortran/dump-parse-tree.cc
index f7bf91370a5..a044d1003fe 100644
--- a/gcc/fortran/dump-parse-tree.cc
+++ b/gcc/fortran/dump-parse-tree.cc
@@ -894,6 +894,8 @@ show_attr (symbol_attribute *attr, const char * module)
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)
@@ -1413,6 +1415,7 @@ show_omp_namelist (int list_type, gfc_omp_namelist *n)
case OMP_MAP_TO: fputs ("to:", dumpfile); break;
case OMP_MAP_FROM: fputs ("from:", dumpfile); break;
case OMP_MAP_TOFROM: fputs ("tofrom:", dumpfile); break;
+ case OMP_MAP_UNSET: fputs ("unset:", dumpfile); break;
default: break;
}
else if (list_type == OMP_LIST_LINEAR)
diff --git a/gcc/fortran/f95-lang.cc b/gcc/fortran/f95-lang.cc
index 1a895a25132..bda89709e71 100644
--- a/gcc/fortran/f95-lang.cc
+++ b/gcc/fortran/f95-lang.cc
@@ -126,6 +126,9 @@ static const struct attribute_spec gfc_attribute_table[] =
#undef LANG_HOOKS_OMP_CLAUSE_LINEAR_CTOR
#undef LANG_HOOKS_OMP_CLAUSE_DTOR
#undef LANG_HOOKS_OMP_FINISH_CLAUSE
+#undef LANG_HOOKS_OMP_FINISH_MAPPER_CLAUSES
+#undef LANG_HOOKS_OMP_EXTRACT_MAPPER_DIRECTIVE
+#undef LANG_HOOKS_OMP_MAP_ARRAY_SECTION
#undef LANG_HOOKS_OMP_ALLOCATABLE_P
#undef LANG_HOOKS_OMP_SCALAR_TARGET_P
#undef LANG_HOOKS_OMP_SCALAR_P
@@ -164,6 +167,10 @@ static const struct attribute_spec gfc_attribute_table[] =
#define LANG_HOOKS_OMP_CLAUSE_LINEAR_CTOR gfc_omp_clause_linear_ctor
#define LANG_HOOKS_OMP_CLAUSE_DTOR gfc_omp_clause_dtor
#define LANG_HOOKS_OMP_FINISH_CLAUSE gfc_omp_finish_clause
+#define LANG_HOOKS_OMP_FINISH_MAPPER_CLAUSES gfc_omp_finish_mapper_clauses
+#define LANG_HOOKS_OMP_EXTRACT_MAPPER_DIRECTIVE \
+ gfc_omp_extract_mapper_directive
+#define LANG_HOOKS_OMP_MAP_ARRAY_SECTION gfc_omp_map_array_section
#define LANG_HOOKS_OMP_ALLOCATABLE_P gfc_omp_allocatable_p
#define LANG_HOOKS_OMP_SCALAR_P gfc_omp_scalar_p
#define LANG_HOOKS_OMP_SCALAR_TARGET_P gfc_omp_scalar_target_p
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 993879feda4..2b3fa57f90f 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -271,8 +271,9 @@ enum gfc_statement
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,
@@ -988,6 +989,10 @@ typedef struct
!$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;
@@ -1298,7 +1303,8 @@ enum gfc_omp_map_op
OMP_MAP_RELEASE,
OMP_MAP_ALWAYS_TO,
OMP_MAP_ALWAYS_FROM,
- OMP_MAP_ALWAYS_TOFROM
+ OMP_MAP_ALWAYS_TOFROM,
+ OMP_MAP_UNSET
};
enum gfc_omp_defaultmap
@@ -1351,6 +1357,7 @@ typedef struct gfc_omp_namelist
union
{
struct gfc_omp_namelist_udr *udr;
+ struct gfc_omp_namelist_udm *udm;
gfc_namespace *ns;
} u2;
struct gfc_omp_namelist *next;
@@ -1690,6 +1697,35 @@ typedef struct gfc_omp_namelist_udr
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;
+
+ /* We probably don't need a whole gfc_omp_clauses here. We only use the
+ OMP_LIST_MAP clause list. */
+ gfc_omp_clauses *clauses;
+
+ tree backend_decl;
+}
+gfc_omp_udm;
+#define gfc_get_omp_udm() XCNEW (gfc_omp_udm)
+
+typedef struct gfc_omp_namelist_udm
+{
+ bool multiple_elems_p;
+ 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. */
@@ -2009,6 +2045,7 @@ typedef struct gfc_symtree
gfc_common_head *common;
gfc_typebound_proc *tb;
gfc_omp_udr *omp_udr;
+ gfc_omp_udm *omp_udm;
}
n;
}
@@ -2052,6 +2089,8 @@ typedef struct gfc_namespace
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;
@@ -2167,6 +2206,9 @@ typedef struct gfc_namespace
/* 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;
@@ -3542,7 +3584,7 @@ void gfc_free_iterator (gfc_iterator *, int);
void gfc_free_forall_iterator (gfc_forall_iterator *);
void gfc_free_alloc_list (gfc_alloc *);
void gfc_free_namelist (gfc_namelist *);
-void gfc_free_omp_namelist (gfc_omp_namelist *, bool);
+void gfc_free_omp_namelist (gfc_omp_namelist *, int = OMP_LIST_NUM);
void gfc_free_equiv (gfc_equiv *);
void gfc_free_equiv_until (gfc_equiv *, gfc_equiv *);
void gfc_free_data (gfc_data *);
@@ -3563,7 +3605,11 @@ void gfc_free_omp_declare_variant_list (gfc_omp_declare_variant *list);
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 *);
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_directive (gfc_code *, gfc_namespace *);
void gfc_resolve_do_iterator (gfc_code *, gfc_symbol *, bool);
void gfc_resolve_omp_local_vars (gfc_namespace *);
@@ -3571,6 +3617,7 @@ void gfc_resolve_omp_parallel_blocks (gfc_code *, gfc_namespace *);
void gfc_resolve_omp_do_blocks (gfc_code *, gfc_namespace *);
void gfc_resolve_omp_declare_simd (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 *);
diff --git a/gcc/fortran/match.cc b/gcc/fortran/match.cc
index 8edfe4a3a2d..c7d8ed1bb81 100644
--- a/gcc/fortran/match.cc
+++ b/gcc/fortran/match.cc
@@ -5452,8 +5452,10 @@ gfc_free_namelist (gfc_namelist *name)
/* Free an OpenMP namelist structure. */
void
-gfc_free_omp_namelist (gfc_omp_namelist *name, bool free_ns)
+gfc_free_omp_namelist (gfc_omp_namelist *name, int list)
{
+ bool free_ns = (list == OMP_LIST_AFFINITY || list == OMP_LIST_DEPEND);
+ bool free_mapper = (list == OMP_LIST_MAP);
gfc_omp_namelist *n;
for (; name; name = n)
@@ -5461,7 +5463,9 @@ gfc_free_omp_namelist (gfc_omp_namelist *name, bool free_ns)
gfc_free_expr (name->expr);
if (free_ns)
gfc_free_namespace (name->u2.ns);
- else if (name->u2.udr)
+ else if (free_mapper && name->u2.udm)
+ free (name->u2.udm);
+ else if (!free_mapper && name->u2.udr)
{
if (name->u2.udr->combiner)
gfc_free_statement (name->u2.udr->combiner);
diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h
index 495c93e0b5c..597d2c04328 100644
--- a/gcc/fortran/match.h
+++ b/gcc/fortran/match.h
@@ -154,6 +154,7 @@ match gfc_match_omp_barrier (void);
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);
diff --git a/gcc/fortran/module.cc b/gcc/fortran/module.cc
index 281b1b17fbf..bab72052945 100644
--- a/gcc/fortran/module.cc
+++ b/gcc/fortran/module.cc
@@ -84,7 +84,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 "15"
+#define MOD_VERSION "16"
/* Structure that describes a position within a module file. */
@@ -2080,7 +2080,8 @@ enum ab_attribute
AB_IS_BIND_C, AB_IS_C_INTEROP, AB_IS_ISO_C, AB_ABSTRACT, AB_ZERO_COMP,
AB_IS_CLASS, AB_PROCEDURE, AB_PROC_POINTER, AB_ASYNCHRONOUS, AB_CODIMENSION,
AB_COARRAY_COMP, AB_VTYPE, AB_VTAB, AB_CONTIGUOUS, AB_CLASS_POINTER,
- AB_IMPLICIT_PURE, AB_ARTIFICIAL, AB_UNLIMITED_POLY, AB_OMP_DECLARE_TARGET,
+ AB_IMPLICIT_PURE, AB_ARTIFICIAL, AB_UNLIMITED_POLY,
+ AB_OMP_DECLARE_MAPPER_VAR, AB_OMP_DECLARE_TARGET,
AB_ARRAY_OUTER_DEPENDENCY, AB_MODULE_PROCEDURE, AB_OACC_DECLARE_CREATE,
AB_OACC_DECLARE_COPYIN, AB_OACC_DECLARE_DEVICEPTR,
AB_OACC_DECLARE_DEVICE_RESIDENT, AB_OACC_DECLARE_LINK,
@@ -2148,6 +2149,7 @@ static const mstring attr_bits[] =
minit ("CLASS_POINTER", AB_CLASS_POINTER),
minit ("IMPLICIT_PURE", AB_IMPLICIT_PURE),
minit ("UNLIMITED_POLY", AB_UNLIMITED_POLY),
+ minit ("OMP_DECLARE_MAPPER_VAR", AB_OMP_DECLARE_MAPPER_VAR),
minit ("OMP_DECLARE_TARGET", AB_OMP_DECLARE_TARGET),
minit ("ARRAY_OUTER_DEPENDENCY", AB_ARRAY_OUTER_DEPENDENCY),
minit ("MODULE_PROCEDURE", AB_MODULE_PROCEDURE),
@@ -2368,6 +2370,8 @@ mio_symbol_attribute (symbol_attribute *attr)
MIO_NAME (ab_attribute) (AB_VTYPE, attr_bits);
if (attr->vtab)
MIO_NAME (ab_attribute) (AB_VTAB, attr_bits);
+ if (attr->omp_udm_artificial_var)
+ MIO_NAME (ab_attribute) (AB_OMP_DECLARE_MAPPER_VAR, attr_bits);
if (attr->omp_declare_target)
MIO_NAME (ab_attribute) (AB_OMP_DECLARE_TARGET, attr_bits);
if (attr->array_outer_dependency)
@@ -2625,6 +2629,17 @@ mio_symbol_attribute (symbol_attribute *attr)
case AB_VTAB:
attr->vtab = 1;
break;
+ case AB_OMP_DECLARE_MAPPER_VAR:
+ attr->omp_udm_artificial_var = 1;
+ /* For the placeholder variable used in an !$OMP DECLARE MAPPER,
+ we don't know if the final clauses will reference used
+ variables or not, yet. Make sure the clause list doesn't get
+ skipped in trans-openmp.cc by forcing the variable referenced
+ attribute true here (else on reading the module, the symbol is
+ created with "referenced" false, and nothing else sets it to
+ true). */
+ attr->referenced = 1;
+ break;
case AB_OMP_DECLARE_TARGET:
attr->omp_declare_target = 1;
break;
@@ -5133,6 +5148,129 @@ load_omp_udrs (void)
}
+/* We only need some of the enumeration values of gfc_omp_map_op for mapping
+ ops in the "!$omp declare mapper" clause list. */
+
+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)
+};
+
+
+/* Whether a namelist in an "!$omp declare mapper" maps a single element or
+ multiple elements. */
+
+static const mstring omp_map_cardinality[] =
+{
+ minit ("SINGLE", 0),
+ minit ("MULTIPLE", 1),
+ minit (NULL, -1)
+};
+
+/* This function loads OpenMP user-defined mappers. */
+
+static void
+load_omp_udms (void)
+{
+ mio_lparen ();
+ 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->u2.udm = gfc_get_omp_namelist_udm ();
+ n->u2.udm->multiple_elems_p = mio_name (0, omp_map_cardinality);
+ mio_pointer_ref (&n->u2.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 ();
+ }
+ 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. */
@@ -5323,12 +5461,44 @@ 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 from module %s at %L",
+ udm->ts.u.derived->module, &udm->where);
+ gfc_error ("Previous !$OMP DECLARE MAPPER from module %s at %L",
+ prev_udm->ts.u.derived->module, &prev_udm->where);
+ /* 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;
const char *p;
char name[GFC_MAX_SYMBOL_LEN + 1];
int i;
@@ -5355,6 +5525,10 @@ read_module (void)
get_module_locus (&omp_udrs);
skip_list ();
+ /* Skip OpenMP UDMs. */
+ get_module_locus (&omp_udms);
+ skip_list ();
+
mio_lparen ();
/* Create the fixup nodes for all the symbols. */
@@ -5689,6 +5863,10 @@ read_module (void)
set_module_locus (&omp_udrs);
load_omp_udrs ();
+ /* Load OpenMP user defined mappers. */
+ set_module_locus (&omp_udms);
+ load_omp_udms ();
+
/* 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. */
@@ -5721,6 +5899,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. */
@@ -6099,6 +6280,65 @@ write_omp_udrs (gfc_symtree *st)
}
+static void
+write_omp_udm (gfc_omp_udm *udm)
+{
+ /* If "!$omp declare mapper" type is private, don't write it. */
+ if (!gfc_check_symbol_access (udm->ts.u.derived))
+ return;
+
+ 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->u2.udm)
+ {
+ mio_name (n->u2.udm->multiple_elems_p, omp_map_cardinality);
+ mio_pointer_ref (&n->u2.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
@@ -6360,6 +6600,12 @@ write_module (void)
write_char ('\n');
write_char ('\n');
+ mio_lparen ();
+ 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 38c67e1f640..7fe3d818403 100644
--- a/gcc/fortran/openmp.cc
+++ b/gcc/fortran/openmp.cc
@@ -106,8 +106,7 @@ gfc_free_omp_clauses (gfc_omp_clauses *c)
gfc_free_expr (c->num_workers_expr);
gfc_free_expr (c->vector_length_expr);
for (i = 0; i < OMP_LIST_NUM; i++)
- gfc_free_omp_namelist (c->lists[i],
- i == OMP_LIST_AFFINITY || i == OMP_LIST_DEPEND);
+ gfc_free_omp_namelist (c->lists[i], i);
gfc_free_expr_list (c->wait_list);
gfc_free_expr_list (c->tile_list);
free (CONST_CAST (char *, c->critical_name));
@@ -248,6 +247,19 @@ gfc_free_omp_udr (gfc_omp_udr *omp_udr)
}
}
+/* 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)
@@ -423,7 +435,7 @@ syntax:
gfc_error ("Syntax error in OpenMP variable list at %C");
cleanup:
- gfc_free_omp_namelist (head, false);
+ gfc_free_omp_namelist (head);
gfc_current_locus = old_loc;
return MATCH_ERROR;
}
@@ -513,7 +525,7 @@ syntax:
gfc_error ("Syntax error in OpenMP variable list at %C");
cleanup:
- gfc_free_omp_namelist (head, false);
+ gfc_free_omp_namelist (head);
gfc_current_locus = old_loc;
return MATCH_ERROR;
}
@@ -620,7 +632,7 @@ syntax:
gfc_error ("Syntax error in OpenMP DEPEND SINK list at %C");
cleanup:
- gfc_free_omp_namelist (head, false);
+ gfc_free_omp_namelist (head);
gfc_current_locus = old_loc;
return MATCH_ERROR;
}
@@ -1343,7 +1355,7 @@ gfc_match_omp_clause_reduction (char pc, gfc_omp_clauses *c, bool openacc,
*head = NULL;
gfc_error_now ("!$OMP DECLARE REDUCTION %s not found at %L",
buffer, &old_loc);
- gfc_free_omp_namelist (n, false);
+ gfc_free_omp_namelist (n, list_idx);
}
else
for (n = *head; n; n = n->next)
@@ -1429,6 +1441,44 @@ gfc_match_dupl_atomic (bool not_dupl, const char *name)
"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. */
@@ -1436,7 +1486,8 @@ 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 context_selector = false,
- bool openmp_target = 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 ();
@@ -1486,7 +1537,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
if (end_colon && gfc_match (" %e )", &alignment) != MATCH_YES)
{
- gfc_free_omp_namelist (*head, false);
+ gfc_free_omp_namelist (*head);
gfc_current_locus = old_loc;
*head = NULL;
break;
@@ -2295,7 +2346,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
end_colon = true;
else if (gfc_match (" )") != MATCH_YES)
{
- gfc_free_omp_namelist (*head, false);
+ gfc_free_omp_namelist (*head);
gfc_current_locus = old_loc;
*head = NULL;
break;
@@ -2303,7 +2354,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
}
if (end_colon && gfc_match (" %e )", &step) != MATCH_YES)
{
- gfc_free_omp_namelist (*head, false);
+ gfc_free_omp_namelist (*head);
gfc_current_locus = old_loc;
*head = NULL;
break;
@@ -2341,8 +2392,11 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
locus old_loc2 = gfc_current_locus;
int always_modifier = 0;
int close_modifier = 0;
+ int mapper_modifier = 0;
locus second_always_locus = old_loc2;
locus second_close_locus = old_loc2;
+ locus second_mapper_locus = old_loc2;
+ char mapper_id[GFC_MAX_SYMBOL_LEN + 1] = { '\0' };
for (;;)
{
@@ -2357,12 +2411,20 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
if (close_modifier++ == 1)
second_close_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;
gfc_match (", ");
}
- gfc_omp_map_op map_op = OMP_MAP_TOFROM;
+ gfc_omp_map_op map_op = default_map_op;
if (gfc_match ("alloc : ") == MATCH_YES)
map_op = OMP_MAP_ALLOC;
else if (gfc_match ("tofrom : ") == MATCH_YES)
@@ -2380,6 +2442,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
gfc_current_locus = old_loc2;
always_modifier = 0;
close_modifier = 0;
+ mapper_modifier = 0;
}
if (always_modifier > 1)
@@ -2394,6 +2457,12 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
&second_close_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],
@@ -2402,7 +2471,23 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
{
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 = gfc_get_omp_namelist_udm ();
+ n->u2.udm->udm = udm;
+ }
+ }
continue;
}
gfc_current_locus = old_loc;
@@ -4002,14 +4087,14 @@ gfc_match_omp_flush (void)
{
gfc_error ("List specified together with memory order clause in FLUSH "
"directive at %C");
- gfc_free_omp_namelist (list, false);
+ gfc_free_omp_namelist (list);
gfc_free_omp_clauses (c);
return MATCH_ERROR;
}
if (gfc_match_omp_eos () != MATCH_YES)
{
gfc_error ("Unexpected junk after $OMP FLUSH statement at %C");
- gfc_free_omp_namelist (list, false);
+ gfc_free_omp_namelist (list);
gfc_free_omp_clauses (c);
return MATCH_ERROR;
}
@@ -4056,6 +4141,153 @@ gfc_match_omp_declare_simd (void)
}
+/* 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
+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)
+ 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;
+ }
+
+ /* This accepts 't' but not e.g. 'type(t)'. Is that correct? */
+ m = gfc_match_type_spec (&ts);
+ if (m != MATCH_YES)
+ return MATCH_ERROR;
+
+ if (ts.type != BT_DERIVED)
+ {
+ gfc_error_now ("!$OMP DECLARE MAPPER with non-derived type at %C");
+ return MATCH_ERROR;
+ }
+
+ if (gfc_match (" :: ") != MATCH_YES)
+ return MATCH_ERROR;
+
+ if (gfc_match_name (var) != MATCH_YES)
+ return MATCH_ERROR;
+
+ if (gfc_match_char (')') != MATCH_YES)
+ 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, 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)
+ {
+ gfc_error_now ("Redefinition of !$OMP DECLARE MAPPER at %L", &where);
+ gfc_error_now ("Previous !$OMP DECLARE MAPPER at %L", &prev_udm->where);
+ }
+ 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;
+ }
+
+ if (gfc_match_omp_eos () != MATCH_YES)
+ {
+ gfc_error ("Unexpected junk after !$OMP DECLARE MAPPER at %C");
+ gfc_current_locus = where;
+ return MATCH_ERROR;
+ }
+
+ return MATCH_YES;
+
+failure:
+ if (mapper_ns)
+ gfc_current_ns = mapper_ns->parent;
+ gfc_free_omp_udm (omp_udm);
+
+ gfc_clear_error ();
+
+ return MATCH_ERROR;
+}
+
+
static bool
match_udr_expr (gfc_symtree *omp_sym1, gfc_symtree *omp_sym2)
{
@@ -6496,9 +6728,13 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
n->sym->comp_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;
@@ -6671,7 +6907,7 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
{
prev->next = n->next;
n->next = NULL;
- gfc_free_omp_namelist (n, 0);
+ gfc_free_omp_namelist (n);
n = prev->next;
}
continue;
@@ -6944,7 +7180,8 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
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)
@@ -7041,7 +7278,7 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
gfc_error ("List item %qs with allocatable components is not "
"permitted in map clause at %L", n->sym->name,
&n->where);
- if (list == OMP_LIST_MAP && !openacc)
+ if (code && list == OMP_LIST_MAP && !openacc)
switch (code->op)
{
case EXEC_OMP_TARGET:
@@ -9418,3 +9655,24 @@ gfc_resolve_omp_udrs (gfc_symtree *st)
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);
+}
+
+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);
+}
diff --git a/gcc/fortran/parse.cc b/gcc/fortran/parse.cc
index 3caa4d4b4b5..d97a4312f48 100644
--- a/gcc/fortran/parse.cc
+++ b/gcc/fortran/parse.cc
@@ -900,6 +900,8 @@ decode_omp_directive (void)
matcho ("critical", gfc_match_omp_critical, ST_OMP_CRITICAL);
break;
case 'd':
+ matchds ("declare mapper", gfc_match_omp_declare_mapper,
+ ST_OMP_DECLARE_MAPPER);
matchds ("declare reduction", gfc_match_omp_declare_reduction,
ST_OMP_DECLARE_REDUCTION);
matcho ("depobj", gfc_match_omp_depobj, ST_OMP_DEPOBJ);
@@ -1733,8 +1735,8 @@ next_statement (void)
the specification part. */
#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_DECLARE_TARGET: case ST_OMP_DECLARE_MAPPER: \
+ case ST_OMP_DECLARE_REDUCTION: case ST_OMP_DECLARE_VARIANT: \
case ST_OMP_REQUIRES: case ST_OACC_ROUTINE: case ST_OACC_DECLARE
/* Block end statements. Errors associated with interchanging these
@@ -2369,6 +2371,9 @@ gfc_ascii_statement (gfc_statement st)
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;
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 835a4783718..00cbedf5856 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -17499,6 +17499,8 @@ resolve_types (gfc_namespace *ns)
gfc_resolve_omp_udrs (ns->omp_udr_root);
+ gfc_resolve_omp_udms (ns->omp_udm_root);
+
ns->types_resolved = 1;
gfc_current_ns = old_ns;
diff --git a/gcc/fortran/st.cc b/gcc/fortran/st.cc
index 73f30c2137f..186b01f447e 100644
--- a/gcc/fortran/st.cc
+++ b/gcc/fortran/st.cc
@@ -285,7 +285,7 @@ gfc_free_statement (gfc_code *p)
break;
case EXEC_OMP_FLUSH:
- gfc_free_omp_namelist (p->ext.omp_namelist, false);
+ gfc_free_omp_namelist (p->ext.omp_namelist);
break;
case EXEC_OMP_BARRIER:
diff --git a/gcc/fortran/symbol.cc b/gcc/fortran/symbol.cc
index 7a80dfd063b..0121eabdcea 100644
--- a/gcc/fortran/symbol.cc
+++ b/gcc/fortran/symbol.cc
@@ -3870,6 +3870,21 @@ free_omp_udr_tree (gfc_symtree * omp_udr_tree)
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. */
@@ -4044,6 +4059,7 @@ gfc_free_namespace (gfc_namespace *&ns)
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);
diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index 6493cc2f6b1..28d5212c9fe 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -88,6 +88,11 @@ static stmtblock_t caf_init_block;
tree gfc_static_ctors;
+/* The namespace in which to look up "declare mapper" mappers (in
+ trans-openmp.cc:gfc_trans_omp_target). This is somewhat grubby. */
+
+gfc_namespace *omp_declare_mapper_ns;
+
/* Whether we've seen a symbol from an IEEE module in the namespace. */
static int seen_ieee_symbol;
@@ -639,9 +644,12 @@ gfc_finish_var_decl (tree decl, gfc_symbol * sym)
function scope. */
if (current_function_decl != NULL_TREE)
{
- if (sym->ns->proc_name
- && (sym->ns->proc_name->backend_decl == current_function_decl
- || sym->result == sym))
+ if (sym->ns->omp_udm_ns)
+ /* ...except for in omp declare mappers, which are special. */
+ pushdecl (decl);
+ else if (sym->ns->proc_name
+ && (sym->ns->proc_name->backend_decl == current_function_decl
+ || sym->result == sym))
gfc_add_decl_to_function (decl);
else if (sym->ns->proc_name
&& sym->ns->proc_name->attr.flavor == FL_LABEL)
@@ -7583,6 +7591,16 @@ gfc_generate_function_code (gfc_namespace * ns)
gfc_conv_cfi_to_gfc (&init, &cleanup, tmp, desc, fsym);
}
+ {
+ tree dm_saved_parent_function_decls = saved_parent_function_decls;
+ saved_parent_function_decls = saved_function_decls;
+ /* NOTE: Decls referenced in a mapper (other than the placeholder variable)
+ may be added to "saved_parent_function_decls". */
+ gfc_trans_omp_declare_mappers (ns->omp_udm_root);
+ saved_function_decls = saved_parent_function_decls;
+ saved_parent_function_decls = dm_saved_parent_function_decls;
+ }
+
gfc_generate_contained_functions (ns);
has_coarray_vars = false;
@@ -7651,9 +7669,15 @@ gfc_generate_function_code (gfc_namespace * ns)
finish_oacc_declare (ns, sym, false);
+ /* Record the namespace for looking up OpenMP declare mappers in. */
+ omp_declare_mapper_ns = ns;
+
tmp = gfc_trans_code (ns->code);
gfc_add_expr_to_block (&body, tmp);
+ /* Unset this to avoid accidentally using a stale pointer. */
+ omp_declare_mapper_ns = NULL;
+
if (TREE_TYPE (DECL_RESULT (fndecl)) != void_type_node
|| (sym->result && sym->result != sym
&& sym->result->ts.type == BT_DERIVED
diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc
index 21f3336a898..c68e4622df4 100644
--- a/gcc/fortran/trans-openmp.cc
+++ b/gcc/fortran/trans-openmp.cc
@@ -49,6 +49,7 @@ along with GCC; see the file COPYING3. If not see
#define GCC_DIAG_STYLE __gcc_gfc__
#include "attribs.h"
#include "function.h"
+#include "tree-iterator.h"
int ompws_flags;
@@ -2476,6 +2477,107 @@ gfc_trans_omp_array_section (stmtblock_t *block, gfc_omp_namelist *n,
ptr, ptr2);
}
+/* CLAUSES is a list of clauses resulting from an "omp declare mapper"
+ instantiation in gimplify.cc. In some cases we don't know if we need to
+ create any extra mapping nodes as a result of mapper expansion until after
+ substitution has taken place, so do that now. */
+
+tree
+gfc_omp_finish_mapper_clauses (tree clauses)
+{
+ tree *clausep = &clauses;
+
+ while (*clausep)
+ {
+ tree n = *clausep;
+
+ if (OMP_CLAUSE_CODE (n) != OMP_CLAUSE_MAP)
+ {
+ clausep = &OMP_CLAUSE_CHAIN (*clausep);
+ continue;
+ }
+
+ tree decl = OMP_CLAUSE_DECL (n);
+
+ switch (OMP_CLAUSE_MAP_KIND (n))
+ {
+ case GOMP_MAP_ALLOC:
+ case GOMP_MAP_TO:
+ case GOMP_MAP_FROM:
+ case GOMP_MAP_TOFROM:
+ case GOMP_MAP_ALWAYS_TO:
+ case GOMP_MAP_ALWAYS_FROM:
+ case GOMP_MAP_ALWAYS_TOFROM:
+ {
+ if ((TREE_CODE (decl) == INDIRECT_REF
+ || (TREE_CODE (decl) == MEM_REF
+ && integer_zerop (TREE_OPERAND (decl, 1))))
+ && DECL_P (TREE_OPERAND (decl, 0)))
+ {
+ tree ptr = TREE_OPERAND (decl, 0);
+ /* A DECL_P pointer arising from a mapper expansion needs a
+ GOMP_MAP_POINTER after it. */
+ tree pnode = build_omp_clause (OMP_CLAUSE_LOCATION (n),
+ OMP_CLAUSE_MAP);
+ /* Should this ever be FIRSTPRIVATE_POINTER or
+ FIRSTPRIVATE_REFERENCE? */
+ OMP_CLAUSE_SET_MAP_KIND (pnode, GOMP_MAP_POINTER);
+ OMP_CLAUSE_DECL (pnode) = ptr;
+ OMP_CLAUSE_SIZE (pnode) = size_zero_node;
+ OMP_CLAUSE_CHAIN (pnode) = OMP_CLAUSE_CHAIN (n);
+ OMP_CLAUSE_CHAIN (n) = pnode;
+ clausep = &OMP_CLAUSE_CHAIN (pnode);
+ continue;
+ }
+ }
+ break;
+
+ default:
+ ;
+ }
+
+ clausep = &OMP_CLAUSE_CHAIN (*clausep);
+ }
+
+ return clauses;
+}
+
+tree
+gfc_omp_extract_mapper_directive (tree fndecl)
+{
+ tree body = DECL_SAVED_TREE (fndecl);
+
+ if (TREE_CODE (body) == BIND_EXPR)
+ body = BIND_EXPR_BODY (body);
+
+ if (TREE_CODE (body) == OMP_DECLARE_MAPPER)
+ return body;
+
+ if (TREE_CODE (body) != STATEMENT_LIST)
+ return error_mark_node;
+
+ tree_stmt_iterator tsi;
+ for (tsi = tsi_start (body); !tsi_end_p (tsi); tsi_next (&tsi))
+ {
+ tree stmt = tsi_stmt (tsi);
+ if (TREE_CODE (stmt) == OMP_DECLARE_MAPPER)
+ {
+ gcc_assert (tsi_one_before_end_p (tsi));
+ return stmt;
+ }
+ }
+
+ return error_mark_node;
+}
+
+tree
+gfc_omp_map_array_section (location_t, tree section)
+{
+ /* For Fortran, detection of attempts to use array sections or full arrays
+ whose elements are mapped with a mapper happens elsewhere. */
+ return section;
+}
+
static tree
handle_iterator (gfc_namespace *ns, stmtblock_t *iter_block, tree block)
{
@@ -2535,11 +2637,21 @@ handle_iterator (gfc_namespace *ns, stmtblock_t *iter_block, tree block)
return list;
}
+enum omp_clause_directive
+{
+ OMP_CD_OPENMP,
+ OMP_CD_OPENMP_DECLARE_SIMD,
+ OMP_CD_OPENMP_DECLARE_MAPPER,
+ OMP_CD_OPENACC
+};
+
static tree
gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
- locus where, bool declare_simd = false,
- bool openacc = false)
+ locus where, omp_clause_directive cd = OMP_CD_OPENMP)
{
+ bool declare_simd = (cd == OMP_CD_OPENMP_DECLARE_SIMD);
+ bool openacc = (cd == OMP_CD_OPENACC);
+ bool declare_mapper = (cd == OMP_CD_OPENMP_DECLARE_MAPPER);
tree omp_clauses = NULL_TREE, prev_clauses, chunk_size, c;
tree iterator = NULL_TREE;
tree tree_block = NULL_TREE;
@@ -3011,6 +3123,9 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
case OMP_MAP_FORCE_DEVICEPTR:
OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_FORCE_DEVICEPTR);
break;
+ case OMP_MAP_UNSET:
+ OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_UNSET);
+ break;
default:
gcc_unreachable ();
}
@@ -3553,6 +3668,14 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
goto finalize_map_clause;
}
}
+
+ if (n->u2.udm && n->u2.udm->multiple_elems_p)
+ {
+ gfc_error ("cannot map non-unit size array "
+ "with mapper at %C");
+ node2 = NULL_TREE;
+ goto finalize_map_clause;
+ }
}
node3 = build_omp_clause (input_location,
OMP_CLAUSE_MAP);
@@ -3596,13 +3719,73 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
finalize_map_clause:
- omp_clauses = gfc_trans_add_clause (node, omp_clauses);
- if (node2)
- omp_clauses = gfc_trans_add_clause (node2, omp_clauses);
- if (node3)
- omp_clauses = gfc_trans_add_clause (node3, omp_clauses);
- if (node4)
- omp_clauses = gfc_trans_add_clause (node4, omp_clauses);
+ /* If we're processing an "omp declare mapper" directive, group
+ together multiple nodes used for some given map clause using
+ GOMP_MAP_MAPPING_GROUP. These are then either flattened or
+ appropriately transformed if they cause a nested mapper to be
+ invoked. */
+
+ if (declare_mapper)
+ {
+ tree cl, container;
+
+ if (node2 || node3 || node4)
+ cl = tree_cons (node, NULL_TREE, NULL_TREE);
+ else
+ cl = node;
+
+ if (node2)
+ cl = tree_cons (node2, NULL_TREE, cl);
+ if (node3)
+ cl = tree_cons (node3, NULL_TREE, cl);
+ if (node4)
+ cl = tree_cons (node4, NULL_TREE, cl);
+
+ if (node != cl)
+ {
+ cl = nreverse (cl);
+
+ container = build_omp_clause (input_location,
+ OMP_CLAUSE_MAP);
+ OMP_CLAUSE_SET_MAP_KIND (container,
+ GOMP_MAP_MAPPING_GROUP);
+ OMP_CLAUSE_DECL (container) = cl;
+ }
+ else
+ container = cl;
+
+ if (n->u2.udm
+ && n->u2.udm->udm->mapper_id
+ && n->u2.udm->udm->mapper_id[0] != '\0')
+ {
+ tree push = build_omp_clause (input_location,
+ OMP_CLAUSE_MAP);
+ OMP_CLAUSE_SET_MAP_KIND (push, GOMP_MAP_PUSH_MAPPER_NAME);
+ OMP_CLAUSE_DECL (push)
+ = get_identifier (n->u2.udm->udm->mapper_id);
+ tree pop = build_omp_clause (input_location,
+ OMP_CLAUSE_MAP);
+ OMP_CLAUSE_SET_MAP_KIND (pop, GOMP_MAP_POP_MAPPER_NAME);
+ OMP_CLAUSE_DECL (pop) = null_pointer_node;
+ omp_clauses = gfc_trans_add_clause (push, omp_clauses);
+ omp_clauses = gfc_trans_add_clause (container,
+ omp_clauses);
+ omp_clauses = gfc_trans_add_clause (pop, omp_clauses);
+ }
+ else
+ omp_clauses = gfc_trans_add_clause (container, omp_clauses);
+ }
+ else
+ {
+ omp_clauses = gfc_trans_add_clause (node, omp_clauses);
+
+ if (node2)
+ omp_clauses = gfc_trans_add_clause (node2, omp_clauses);
+ if (node3)
+ omp_clauses = gfc_trans_add_clause (node3, omp_clauses);
+ if (node4)
+ omp_clauses = gfc_trans_add_clause (node4, omp_clauses);
+ }
}
break;
case OMP_LIST_TO:
@@ -4485,7 +4668,7 @@ gfc_trans_oacc_construct (gfc_code *code)
gfc_start_block (&block);
oacc_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses,
- code->loc, false, true);
+ code->loc, OMP_CD_OPENACC);
stmt = gfc_trans_omp_code (code->block->next, true);
stmt = build2_loc (gfc_get_location (&code->loc), construct_code,
void_type_node, stmt, oacc_clauses);
@@ -4521,7 +4704,7 @@ gfc_trans_oacc_executable_directive (gfc_code *code)
gfc_start_block (&block);
oacc_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses,
- code->loc, false, true);
+ code->loc, OMP_CD_OPENACC);
stmt = build1_loc (input_location, construct_code, void_type_node,
oacc_clauses);
gfc_add_expr_to_block (&block, stmt);
@@ -5524,7 +5707,7 @@ gfc_trans_oacc_combined_directive (gfc_code *code)
if (construct_code == OACC_KERNELS)
construct_clauses.lists[OMP_LIST_REDUCTION] = NULL;
oacc_clauses = gfc_trans_omp_clauses (&block, &construct_clauses,
- code->loc, false, true);
+ code->loc, OMP_CD_OPENACC);
}
if (!loop_clauses.seq)
pblock = █
@@ -6869,6 +7052,337 @@ gfc_trans_omp_teams (gfc_code *code, gfc_omp_clauses *clausesa,
return gfc_finish_block (&block);
}
+static gfc_symtree *gfc_subst_replace;
+static gfc_ref *gfc_subst_prepend_ref;
+
+static bool
+gfc_subst_in_expr_1 (gfc_expr *expr, gfc_symbol *search, int *)
+{
+ /* The base-object for component accesses may be stored in expr->symtree.
+ If it's the symbol for our "declare mapper" placeholder variable,
+ substitute it. */
+ if (expr->symtree && expr->symtree->n.sym == search)
+ {
+ gfc_ref **lastptr = NULL;
+ expr->symtree = gfc_subst_replace;
+
+ if (!gfc_subst_prepend_ref)
+ return false;
+
+ gfc_ref *prepend_ref = gfc_copy_ref (gfc_subst_prepend_ref);
+
+ for (gfc_ref *walk = prepend_ref; walk; walk = walk->next)
+ lastptr = &walk->next;
+
+ *lastptr = expr->ref;
+ expr->ref = prepend_ref;
+ }
+
+ return false;
+}
+
+static void
+gfc_subst_in_expr (gfc_expr *expr, gfc_symbol *search, gfc_symtree *replace,
+ gfc_ref *prepend_ref)
+{
+ gfc_subst_replace = replace;
+ gfc_subst_prepend_ref = prepend_ref;
+ gfc_traverse_expr (expr, search, gfc_subst_in_expr_1, 0);
+}
+
+static void
+gfc_subst_mapper_var (gfc_symbol **out_sym, gfc_expr **out_expr,
+ gfc_symbol *orig_sym, gfc_expr *orig_expr,
+ gfc_symbol *dummy_var,
+ gfc_symbol *templ_sym, gfc_expr *templ_expr)
+{
+ gfc_ref *orig_ref = orig_expr ? orig_expr->ref : NULL;
+ gfc_symtree *orig_st = gfc_find_symtree (orig_sym->ns->sym_root,
+ orig_sym->name);
+
+ if (dummy_var == templ_sym)
+ *out_sym = orig_sym;
+ else
+ *out_sym = templ_sym;
+
+ if (templ_expr)
+ {
+ *out_expr = gfc_copy_expr (templ_expr);
+ gfc_subst_in_expr (*out_expr, dummy_var, orig_st, orig_ref);
+ }
+ else if (orig_expr)
+ *out_expr = gfc_copy_expr (orig_expr);
+ else
+ *out_expr = NULL;
+}
+
+static gfc_omp_namelist **
+gfc_trans_omp_instantiate_mapper (gfc_omp_namelist **outlistp,
+ gfc_omp_namelist *clause, gfc_omp_udm *udm)
+{
+ /* Here "sym" and "expr" describe the clause as written, to be substituted
+ for the dummy variable in the mapper definition. */
+ struct gfc_symbol *sym = clause->sym;
+ struct gfc_expr *expr = clause->expr;
+ gfc_omp_namelist *mapper_clause = udm->clauses->lists[OMP_LIST_MAP];
+ gfc_omp_map_op outer_map_op = clause->u.map_op;
+ bool pointer_needed_p = false;
+
+ if (expr)
+ {
+ gfc_ref *lastref = expr->ref;
+
+ while (lastref->next)
+ lastref = lastref->next;
+
+ if (lastref && lastref->type == REF_ARRAY)
+ {
+ mpz_t elems;
+ bool multiple_elems_p = false;
+
+ if (gfc_array_size (expr, &elems))
+ {
+ HOST_WIDE_INT nelems = gfc_mpz_get_hwi (elems);
+ if (nelems > 1)
+ multiple_elems_p = true;
+ }
+ else
+ multiple_elems_p = true;
+
+ if (multiple_elems_p)
+ {
+ gcc_assert (clause->u2.udm);
+ clause->u2.udm->multiple_elems_p = true;
+ *outlistp = clause;
+ return &(*outlistp)->next;
+ }
+ }
+
+ if (lastref
+ && lastref->type == REF_COMPONENT
+ && (lastref->u.c.component->attr.pointer
+ || lastref->u.c.component->attr.allocatable))
+ pointer_needed_p = true;
+ }
+
+ if (pointer_needed_p)
+ {
+ /* If we're instantiating a mapper via a pointer, we need to map that
+ pointer as well as mapping the entities explicitly listed in the
+ mapper definition. Create a node for that. */
+ gfc_omp_namelist *new_clause = gfc_get_omp_namelist ();
+ new_clause->sym = sym;
+ new_clause->expr = gfc_copy_expr (expr);
+ new_clause->u.map_op = OMP_MAP_ALLOC;
+ *outlistp = new_clause;
+ outlistp = &new_clause->next;
+ }
+
+ for (; mapper_clause; mapper_clause = mapper_clause->next)
+ {
+ gfc_omp_namelist *new_clause = gfc_get_omp_namelist ();
+
+ gfc_subst_mapper_var (&new_clause->sym, &new_clause->expr,
+ sym, expr, udm->var_sym, mapper_clause->sym,
+ mapper_clause->expr);
+
+ if (mapper_clause->u.map_op == OMP_MAP_UNSET)
+ new_clause->u.map_op = outer_map_op;
+ else
+ new_clause->u.map_op = mapper_clause->u.map_op;
+
+ new_clause->where = clause->where;
+
+ if (mapper_clause->u2.udm
+ && mapper_clause->u2.udm->udm != udm)
+ {
+ gfc_omp_udm *inner_udm = mapper_clause->u2.udm->udm;
+ outlistp = gfc_trans_omp_instantiate_mapper (outlistp, new_clause,
+ inner_udm);
+ }
+ else
+ {
+ *outlistp = new_clause;
+ outlistp = &new_clause->next;
+ }
+ }
+
+ return outlistp;
+}
+
+static void
+gfc_trans_omp_instantiate_mappers (gfc_omp_clauses *clauses)
+{
+ gfc_omp_namelist *clause = clauses->lists[OMP_LIST_MAP];
+ gfc_omp_namelist **clausep = &clauses->lists[OMP_LIST_MAP];
+
+ for (; clause; clause = *clausep)
+ {
+ if (clause->u2.udm)
+ {
+ clausep = gfc_trans_omp_instantiate_mapper (clausep,
+ clause,
+ clause->u2.udm->udm);
+ *clausep = clause->next;
+ }
+ else
+ clausep = &clause->next;
+ }
+}
+
+/* Code callback for gfc_code_walker. */
+
+static int
+gfc_record_mapper_bindings_code_fn (gfc_code **, int *, void *)
+{
+ return 0;
+}
+
+template <>
+struct default_hash_traits <omp_name_type<gfc_typespec *>>
+ : typed_noop_remove <omp_name_type<gfc_typespec *>>
+{
+ GTY((skip)) typedef omp_name_type<gfc_typespec *> value_type;
+ GTY((skip)) typedef omp_name_type<gfc_typespec *> compare_type;
+
+ static hashval_t
+ hash (omp_name_type<gfc_typespec *> p)
+ {
+ tree typenode = gfc_typenode_for_spec (p.type);
+ return p.name ? iterative_hash_expr (p.name, TYPE_UID (typenode))
+ : TYPE_UID (typenode);
+ }
+
+ static const bool empty_zero_p = true;
+
+ static bool
+ is_empty (omp_name_type<gfc_typespec *> p)
+ {
+ return p.type == NULL;
+ }
+
+ static bool
+ is_deleted (omp_name_type<gfc_typespec *>)
+ {
+ return false;
+ }
+
+ static bool
+ equal (const omp_name_type<gfc_typespec *> &a,
+ const omp_name_type<gfc_typespec *> &b)
+ {
+ if (a.name == NULL_TREE && b.name == NULL_TREE)
+ return a.type == b.type;
+ else if (a.name == NULL_TREE || b.name == NULL_TREE)
+ return false;
+ else
+ return a.name == b.name && gfc_compare_types (a.type, b.type);
+ }
+
+ static void
+ mark_empty (omp_name_type<gfc_typespec *> &e)
+ {
+ e.type = NULL;
+ }
+};
+
+
+extern gfc_namespace *omp_declare_mapper_ns;
+
+/* Conceptually similar to c-omp.cc:c_omp_find_nested_mappers, but using
+ Fortran typespec to idenfify mappers. */
+
+static void
+gfc_find_nested_mappers (omp_mapper_list<gfc_typespec *> *mlist,
+ gfc_omp_udm *udm)
+{
+ gfc_omp_namelist *ns = udm->clauses->lists[OMP_LIST_MAP];
+
+ for (; ns; ns = ns->next)
+ {
+ if (ns->u2.udm && ns->u2.udm->udm != udm)
+ {
+ gfc_omp_udm *nested_udm = ns->u2.udm->udm;
+ tree mapper_id
+ = (nested_udm->mapper_id ? get_identifier (nested_udm->mapper_id)
+ : NULL_TREE);
+ mlist->add_mapper (mapper_id, &nested_udm->ts,
+ nested_udm->backend_decl);
+ gfc_find_nested_mappers (mlist, nested_udm);
+ }
+ }
+}
+
+/* Expr callback for gfc_code_walker. */
+
+static int
+gfc_record_mapper_bindings_expr_fn (gfc_expr **exprp, int *walk_subexpr,
+ void *data)
+{
+ gfc_typespec *ts = NULL;
+ omp_mapper_list<gfc_typespec *> *mlist
+ = (omp_mapper_list<gfc_typespec *> *) data;
+
+ if ((*exprp)->symtree)
+ {
+ gfc_symbol *sym = (*exprp)->symtree->n.sym;
+ if (sym->ts.type == BT_DERIVED || sym->ts.type == BT_CLASS)
+ ts = &sym->ts;
+ }
+ else if ((*exprp)->base_expr)
+ {
+ gfc_expr *base_expr = (*exprp)->base_expr;
+ if (base_expr->ts.type == BT_DERIVED || base_expr->ts.type == BT_CLASS)
+ ts = &base_expr->ts;
+ }
+
+ if (!ts)
+ return 0;
+
+ gfc_omp_udm *udm = gfc_find_omp_udm (omp_declare_mapper_ns, "", ts);
+
+ if (udm)
+ {
+ mlist->add_mapper (NULL_TREE, &udm->ts, udm->backend_decl);
+ gfc_find_nested_mappers (mlist, udm);
+ }
+
+ return 0;
+}
+
+static void
+gfc_record_mapper_bindings (tree *clauses, gfc_code *code)
+{
+ hash_set<omp_name_type<gfc_typespec *>> seen_types;
+ auto_vec<tree> mappers;
+ omp_mapper_list<gfc_typespec *> mlist (&seen_types, &mappers);
+
+ gfc_code_walker (&code, gfc_record_mapper_bindings_code_fn,
+ gfc_record_mapper_bindings_expr_fn, (void *) &mlist);
+
+ unsigned int i;
+ tree mapperfn;
+ FOR_EACH_VEC_ELT (mappers, i, mapperfn)
+ {
+ tree mapper = gfc_omp_extract_mapper_directive (mapperfn);
+ if (mapper == error_mark_node)
+ continue;
+ tree mapper_name = OMP_DECLARE_MAPPER_ID (mapper);
+ tree decl = OMP_DECLARE_MAPPER_DECL (mapper);
+
+ if (mapper_name && IDENTIFIER_POINTER (mapper_name)[0] == '\0')
+ mapper_name = NULL_TREE;
+
+ tree c = build_omp_clause (input_location, OMP_CLAUSE__MAPPER_BINDING_);
+ OMP_CLAUSE__MAPPER_BINDING__ID (c) = mapper_name;
+ OMP_CLAUSE__MAPPER_BINDING__DECL (c) = decl;
+ OMP_CLAUSE__MAPPER_BINDING__MAPPER (c) = mapperfn;
+
+ OMP_CLAUSE_CHAIN (c) = *clauses;
+ *clauses = c;
+ }
+}
+
static tree
gfc_trans_omp_target (gfc_code *code)
{
@@ -6879,14 +7393,18 @@ gfc_trans_omp_target (gfc_code *code)
gfc_start_block (&block);
gfc_split_omp_clauses (code, clausesa);
if (flag_openmp)
- omp_clauses
- = gfc_trans_omp_clauses (&block, &clausesa[GFC_OMP_SPLIT_TARGET],
- code->loc);
+ {
+ gfc_omp_clauses *target_clauses = &clausesa[GFC_OMP_SPLIT_TARGET];
+ gfc_trans_omp_instantiate_mappers (target_clauses);
+ omp_clauses = gfc_trans_omp_clauses (&block, target_clauses,
+ code->loc);
+ }
switch (code->op)
{
case EXEC_OMP_TARGET:
pushlevel ();
stmt = gfc_trans_omp_code (code->block->next, true);
+ gfc_record_mapper_bindings (&omp_clauses, code->block->next);
stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
break;
case EXEC_OMP_TARGET_PARALLEL:
@@ -6899,6 +7417,7 @@ gfc_trans_omp_target (gfc_code *code)
= gfc_trans_omp_clauses (&iblock, &clausesa[GFC_OMP_SPLIT_PARALLEL],
code->loc);
stmt = gfc_trans_omp_code (code->block->next, true);
+ gfc_record_mapper_bindings (&omp_clauses, code->block->next);
stmt = build2_loc (input_location, OMP_PARALLEL, void_type_node, stmt,
inner_clauses);
gfc_add_expr_to_block (&iblock, stmt);
@@ -7385,7 +7904,7 @@ gfc_trans_oacc_declare (gfc_code *code)
gfc_start_block (&block);
oacc_clauses = gfc_trans_omp_clauses (&block, code->ext.oacc_declare->clauses,
- code->loc, false, true);
+ code->loc, OMP_CD_OPENACC);
stmt = gfc_trans_omp_code (code->block->next, true);
stmt = build2_loc (input_location, construct_code, void_type_node, stmt,
oacc_clauses);
@@ -7552,7 +8071,8 @@ gfc_trans_omp_declare_simd (gfc_namespace *ns)
gfc_omp_declare_simd *ods;
for (ods = ns->omp_declare_simd; ods; ods = ods->next)
{
- tree c = gfc_trans_omp_clauses (NULL, ods->clauses, ods->where, true);
+ tree c = gfc_trans_omp_clauses (NULL, ods->clauses, ods->where,
+ OMP_CD_OPENMP_DECLARE_SIMD);
tree fndecl = ns->proc_name->backend_decl;
if (c != NULL_TREE)
c = tree_cons (NULL_TREE, c, NULL_TREE);
@@ -7679,8 +8199,10 @@ gfc_trans_omp_declare_variant (gfc_namespace *ns)
}
break;
case CTX_PROPERTY_SIMD:
- properties = gfc_trans_omp_clauses (NULL, otp->clauses,
- odv->where, true);
+ properties
+ = gfc_trans_omp_clauses (NULL, otp->clauses,
+ odv->where,
+ OMP_CD_OPENMP_DECLARE_SIMD);
break;
default:
gcc_unreachable ();
@@ -7765,3 +8287,113 @@ gfc_trans_omp_declare_variant (gfc_namespace *ns)
}
}
}
+
+static tree
+gfc_trans_omp_mapper_name (const char *mapper_id, gfc_typespec *ts)
+{
+ /* Enough space for "<mapper_id>:CLASS(<typename>)" + '\0'. */
+ char buffer[2 * GFC_MAX_SYMBOL_LEN + 9];
+ const char *type_name = gfc_typename (ts);
+ if (!mapper_id)
+ mapper_id = "default";
+ snprintf (buffer, sizeof (buffer), "omp declare mapper %s:%s", mapper_id,
+ type_name);
+ return get_identifier (buffer);
+}
+
+/* Here we need to translate the internal representation of an OpenMP
+ "declare mapper" into a form that can be consumed by the middle-end. */
+
+static void
+gfc_trans_omp_declare_mapper (gfc_omp_udm *udm)
+{
+ tree mapper_name = gfc_trans_omp_mapper_name (udm->mapper_id, &udm->ts);
+ tree fn;
+ tree saved_fn_decl = current_function_decl;
+ tree decl, decls;
+
+ if (saved_fn_decl)
+ push_function_context ();
+
+ tree tmp = build_function_type_list (void_type_node, NULL_TREE);
+ fn = build_decl (input_location, FUNCTION_DECL, mapper_name, tmp);
+
+ DECL_ARTIFICIAL (fn) = 1;
+ DECL_EXTERNAL (fn) = 1;
+ DECL_DECLARED_INLINE_P (fn) = 1;
+ DECL_IGNORED_P (fn) = 1;
+ SET_DECL_ASSEMBLER_NAME (fn, get_identifier ("<udm>"));
+ DECL_ATTRIBUTES (fn)
+ = tree_cons (get_identifier ("gnu_inline"), NULL_TREE,
+ DECL_ATTRIBUTES (fn));
+
+ decl = build_decl (input_location, RESULT_DECL, NULL_TREE, void_type_node);
+ DECL_ARTIFICIAL (decl) = 1;
+ DECL_IGNORED_P (decl) = 1;
+ DECL_CONTEXT (decl) = fn;
+ DECL_RESULT (fn) = decl;
+
+ pushdecl (fn);
+ current_function_decl = fn;
+
+ allocate_struct_function (fn, false);
+
+ pushlevel ();
+
+ stmtblock_t block;
+ gfc_init_block (&block);
+
+ tree mapper_id = udm->mapper_id ? get_identifier (udm->mapper_id) : NULL_TREE;
+ tree type = gfc_typenode_for_spec (&udm->ts);
+ tree var = gfc_get_symbol_decl (udm->var_sym);
+
+ DECL_CONTEXT (var) = fn;
+ /* Normally a "use"-related variable will get the DECL_EXTERN flag set, but
+ we don't want that here because it interferes with rewriting the decl. */
+ DECL_EXTERNAL (var) = 0;
+
+ tree maplist = gfc_trans_omp_clauses (&block, udm->clauses, udm->where,
+ OMP_CD_OPENMP_DECLARE_MAPPER);
+
+ tree stmt = make_node (OMP_DECLARE_MAPPER);
+ TREE_TYPE (stmt) = void_type_node;
+ OMP_DECLARE_MAPPER_ID (stmt) = mapper_id;
+ OMP_DECLARE_MAPPER_TYPE (stmt) = type;
+ OMP_DECLARE_MAPPER_DECL (stmt) = var;
+ OMP_DECLARE_MAPPER_CLAUSES (stmt) = maplist;
+
+ gfc_add_expr_to_block (&block, stmt);
+ DECL_SAVED_TREE (fn) = gfc_finish_block (&block);
+ decls = getdecls ();
+ poplevel (1, 1);
+ BLOCK_SUPERCONTEXT (DECL_INITIAL (fn)) = fn;
+
+ DECL_SAVED_TREE (fn) = fold_build3_loc (input_location, BIND_EXPR,
+ void_type_node, decls,
+ DECL_SAVED_TREE (fn),
+ DECL_INITIAL (fn));
+ dump_function (TDI_original, fn);
+
+ udm->backend_decl = fn;
+
+ set_cfun (NULL);
+
+ if (saved_fn_decl)
+ {
+ pop_function_context ();
+ current_function_decl = saved_fn_decl;
+ }
+}
+
+void
+gfc_trans_omp_declare_mappers (gfc_symtree *omp_udm_root)
+{
+ if (!omp_udm_root)
+ return;
+
+ gfc_trans_omp_declare_mappers (omp_udm_root->left);
+ gfc_trans_omp_declare_mappers (omp_udm_root->right);
+
+ for (gfc_omp_udm *udm = omp_udm_root->n.omp_udm; udm; udm = udm->next)
+ gfc_trans_omp_declare_mapper (udm);
+}
diff --git a/gcc/fortran/trans-stmt.h b/gcc/fortran/trans-stmt.h
index 477add43f6c..7a2737df6dd 100644
--- a/gcc/fortran/trans-stmt.h
+++ b/gcc/fortran/trans-stmt.h
@@ -71,6 +71,7 @@ tree gfc_trans_deallocate (gfc_code *);
tree gfc_trans_omp_directive (gfc_code *);
void gfc_trans_omp_declare_simd (gfc_namespace *);
void gfc_trans_omp_declare_variant (gfc_namespace *);
+void gfc_trans_omp_declare_mappers (gfc_symtree *);
tree gfc_trans_oacc_directive (gfc_code *);
tree gfc_trans_oacc_declare (gfc_namespace *);
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 738c7487a56..3220be7c0c1 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -816,6 +816,9 @@ tree gfc_omp_clause_assign_op (tree, tree, tree);
tree gfc_omp_clause_linear_ctor (tree, tree, tree, tree);
tree gfc_omp_clause_dtor (tree, tree);
void gfc_omp_finish_clause (tree, gimple_seq *, bool);
+tree gfc_omp_finish_mapper_clauses (tree);
+tree gfc_omp_extract_mapper_directive (tree);
+tree gfc_omp_map_array_section (location_t, tree);
bool gfc_omp_allocatable_p (tree);
bool gfc_omp_scalar_p (tree, bool);
bool gfc_omp_scalar_target_p (tree);
diff --git a/gcc/gimplify.cc b/gcc/gimplify.cc
index 742fd5e4a8d..457752da766 100644
--- a/gcc/gimplify.cc
+++ b/gcc/gimplify.cc
@@ -10414,60 +10414,354 @@ struct instantiate_mapper_info
hash_set<tree> *handled_structs;
tree *mapper_clauses_p;
struct gimplify_omp_ctx *omp_ctx;
-};
-
-struct remap_mapper_decl_info
-{
- tree dummy_var;
- tree expr;
+ gimple_seq *pre_p;
};
static tree
remap_mapper_decl_1 (tree *tp, int *walk_subtrees, void *data)
{
- remap_mapper_decl_info *map_info = (remap_mapper_decl_info *) data;
+ copy_body_data *id = (copy_body_data *) data;
- if (operand_equal_p (*tp, map_info->dummy_var))
+ if (DECL_P (*tp))
{
- *tp = unshare_expr (map_info->expr);
- *walk_subtrees = 0;
+ tree replacement = remap_decl (*tp, id);
+ if (*tp != replacement)
+ {
+ *tp = unshare_expr (replacement);
+ *walk_subtrees = 0;
+ }
}
return NULL_TREE;
}
+/* A copy_decl implementation (for use with tree-inline.cc functions) that
+ only transform decls or SSA names that are part of a map we already
+ prepared. */
+
+static tree
+omp_mapper_copy_decl (tree var, copy_body_data *cb)
+{
+ tree *repl = cb->decl_map->get (var);
+
+ if (repl)
+ return *repl;
+
+ return var;
+}
+
+/* If we have a TREE_LIST representing an unprocessed mapping group (e.g. from
+ a "declare mapper" definition emitted by the Fortran FE), return the node
+ for the data being mapped (usually the first, but not always). */
+
+static tree
+omp_mapping_group_data (tree group)
+{
+ gcc_assert (TREE_CODE (group) == TREE_LIST);
+
+ int len = list_length (group);
+
+ switch (len)
+ {
+ case 3:
+ {
+ tree node1 = TREE_PURPOSE (group);
+ tree node2 = TREE_PURPOSE (TREE_CHAIN (group));
+ tree node3 = TREE_PURPOSE (TREE_CHAIN (TREE_CHAIN (group)));
+
+ gcc_assert (OMP_CLAUSE_CODE (node1) == OMP_CLAUSE_MAP
+ && OMP_CLAUSE_CODE (node2) == OMP_CLAUSE_MAP
+ && OMP_CLAUSE_CODE (node3) == OMP_CLAUSE_MAP);
+
+ /* For derived-type members that are array descriptors, The Fortran FE
+ creates a TO mapping for an array descriptor, then a mapping (to,
+ from, etc.) for the actual data, then an ALWAYS_POINTER. When
+ invoking a mapper, we only substitute the actual data, i.e. the
+ second node, and drop the others. */
+ if (OMP_CLAUSE_MAP_KIND (node1) == GOMP_MAP_TO
+ && OMP_CLAUSE_MAP_KIND (node3) == GOMP_MAP_ALWAYS_POINTER)
+ return node2;
+ }
+ /* Fallthrough. */
+
+ default:
+ /* Otherwise use the first member of the group for substitution. */
+ return TREE_PURPOSE (group);
+ }
+}
+
+static tree
+omp_mapping_group_ptr (tree group)
+{
+ gcc_assert (TREE_CODE (group) == TREE_LIST);
+
+ while (TREE_CHAIN (group))
+ group = TREE_CHAIN (group);
+
+ tree node = TREE_PURPOSE (group);
+
+ gcc_assert (OMP_CLAUSE_CODE (node) == OMP_CLAUSE_MAP);
+
+ if (OMP_CLAUSE_MAP_KIND (node) == GOMP_MAP_ALWAYS_POINTER)
+ return node;
+
+ return NULL_TREE;
+}
+
static tree *
-omp_instantiate_mapper (hash_map<omp_name_type<tree>, tree> *implicit_mappers,
- tree mapper, tree expr, enum gomp_map_kind outer_kind,
+omp_instantiate_mapper (gimple_seq *pre_p,
+ hash_map<omp_name_type<tree>, tree> *implicit_mappers,
+ tree mapperfn, tree expr, enum gomp_map_kind outer_kind,
tree *mapper_clauses_p)
{
tree mapper_name = NULL_TREE;
+ tree mapper = lang_hooks.decls.omp_extract_mapper_directive (mapperfn);
gcc_assert (TREE_CODE (mapper) == OMP_DECLARE_MAPPER);
tree clause = OMP_DECLARE_MAPPER_CLAUSES (mapper);
tree dummy_var = OMP_DECLARE_MAPPER_DECL (mapper);
- remap_mapper_decl_info map_info;
+ /* The "extraction map" is used to map the mapper variable in the "declare
+ mapper" directive, and also any temporary variables that have been created
+ as part of expanding the mapper function's body (which are expanded as a
+ "bind" expression in the pre_p sequence). */
+ hash_map<tree, tree> extraction_map;
- map_info.dummy_var = dummy_var;
- map_info.expr = expr;
+ if (TREE_CODE (mapperfn) == FUNCTION_DECL
+ && TREE_CODE (DECL_SAVED_TREE (mapperfn)) == BIND_EXPR)
+ {
+ tree body = NULL_TREE, bind = DECL_SAVED_TREE (mapperfn);
+ copy_body_data id;
+ hash_map<tree, tree> decl_map;
+
+ /* The "decl map" maps declarations in the definition of the mapper
+ function into new declarations in the current function. These are
+ local to the bind in which they are expanded, so we copy them out to
+ temporaries in the enclosing function scope, and use those temporaries
+ in the mapper expansion (see "extraction_map" above). (This also
+ allows a mapper to be invoked for multiple variables). */
+
+ memset (&id, 0, sizeof (id));
+ /* The source function isn't always mapperfn: e.g. for C++ mappers
+ defined within functions, the mapper decl is created in a scope
+ within that function, rather than in mapperfn. So, that containing
+ function is the one we need to copy from. */
+ id.src_fn = DECL_CONTEXT (dummy_var);
+ id.dst_fn = current_function_decl;
+ id.src_cfun = DECL_STRUCT_FUNCTION (mapperfn);
+ id.decl_map = &decl_map;
+ id.copy_decl = copy_decl_no_change;
+ id.transform_call_graph_edges = CB_CGE_DUPLICATE;
+ id.transform_new_cfg = true;
+
+ walk_tree (&bind, copy_tree_body_r, &id, NULL);
+
+ body = BIND_EXPR_BODY (bind);
+
+ extraction_map.put (dummy_var, expr);
+ extraction_map.put (expr, expr);
+
+ tree dummy_var_remapped, *remapped_var_p = decl_map.get (dummy_var);
+ if (remapped_var_p)
+ dummy_var_remapped = *remapped_var_p;
+ else
+ internal_error ("failed to remap mapper variable");
+
+ hash_map<tree, tree> mapper_map;
+ mapper_map.put (dummy_var_remapped, expr);
+
+ /* Now we need to make two adjustments to the inlined bind: we have to
+ substitute the dummy variable for the expression in the clause
+ triggering this mapper instantiation, and we need to remove the
+ (remapped) decl from the bind's decl list. */
+
+ if (TREE_CODE (body) == STATEMENT_LIST)
+ {
+ copy_body_data id2;
+ memset (&id2, 0, sizeof (id2));
+ id2.src_fn = current_function_decl;
+ id2.dst_fn = current_function_decl;
+ id2.src_cfun = cfun;
+ id2.decl_map = &mapper_map;
+ id2.copy_decl = omp_mapper_copy_decl;
+ id2.transform_call_graph_edges = CB_CGE_DUPLICATE;
+ id2.transform_new_cfg = true;
+
+ tree_stmt_iterator tsi;
+ for (tsi = tsi_start (body); !tsi_end_p (tsi); tsi_next (&tsi))
+ {
+ tree* stmtp = tsi_stmt_ptr (tsi);
+ if (TREE_CODE (*stmtp) == OMP_DECLARE_MAPPER)
+ *stmtp = NULL_TREE;
+ else if (TREE_CODE (*stmtp) == DECL_EXPR
+ && DECL_EXPR_DECL (*stmtp) == dummy_var_remapped)
+ *stmtp = NULL_TREE;
+ else
+ walk_tree (stmtp, remap_mapper_decl_1, &id2, NULL);
+ }
+
+ tsi = tsi_last (body);
+
+ for (hash_map<tree, tree>::iterator ti = decl_map.begin ();
+ ti != decl_map.end ();
+ ++ti)
+ {
+ tree tmp, var = (*ti).first, inlined = (*ti).second;
+
+ if (var == dummy_var || var == inlined || !DECL_P (var))
+ continue;
+
+ if (!is_gimple_reg (var))
+ {
+ const char *decl_name
+ = IDENTIFIER_POINTER (DECL_NAME (var));
+ tmp = create_tmp_var (TREE_TYPE (var), decl_name);
+ }
+ else
+ tmp = create_tmp_var (TREE_TYPE (var));
+
+ /* We have three versions of the decl here. VAR is the version
+ as represented in the function defining the "declare mapper",
+ and in the clause list attached to the OMP_DECLARE_MAPPER
+ directive within that function. INLINED is the variable that
+ has been localised to a bind within the function where the
+ mapper is being instantiated (i.e. current_function_decl).
+ TMP is the variable that we copy the values created in that
+ block to. */
+
+ extraction_map.put (var, tmp);
+ extraction_map.put (tmp, tmp);
+
+ tree asgn = build2 (MODIFY_EXPR, TREE_TYPE (tmp), tmp, inlined);
+ tsi_link_after (&tsi, asgn, TSI_CONTINUE_LINKING);
+ }
+ }
+
+ /* We've replaced the "dummy variable" of the declare mapper definition
+ with a localised version in a bind expr in the current function. We
+ have just rewritten all references to that, so remove the decl. */
+
+ for (tree *decl = &BIND_EXPR_VARS (bind); *decl;)
+ {
+ if (*decl == dummy_var_remapped)
+ *decl = DECL_CHAIN (*decl);
+ else
+ decl = &DECL_CHAIN (*decl);
+ }
+
+ gimplify_bind_expr (&bind, pre_p);
+ }
+ else
+ {
+ extraction_map.put (dummy_var, expr);
+ extraction_map.put (expr, expr);
+ }
+
+ /* This copy_body_data is only used to remap the decls in the
+ OMP_DECLARE_MAPPER tree node expansion itself. All relevant decls should
+ already be in the current function. */
+ copy_body_data id;
+ memset (&id, 0, sizeof (id));
+ id.src_fn = current_function_decl;
+ id.dst_fn = current_function_decl;
+ id.src_cfun = cfun;
+ id.decl_map = &extraction_map;
+ id.copy_decl = omp_mapper_copy_decl;
+ id.transform_call_graph_edges = CB_CGE_DUPLICATE; // ???
+ id.transform_new_cfg = true; // ???
for (; clause; clause = OMP_CLAUSE_CHAIN (clause))
{
- enum gomp_map_kind clause_kind = OMP_CLAUSE_MAP_KIND (clause);
+ enum gomp_map_kind map_kind = OMP_CLAUSE_MAP_KIND (clause);
+ tree *nested_mapper_p = NULL;
- if (clause_kind == GOMP_MAP_PUSH_MAPPER_NAME)
+ if (map_kind == GOMP_MAP_PUSH_MAPPER_NAME)
{
mapper_name = OMP_CLAUSE_DECL (clause);
continue;
}
- else if (clause_kind == GOMP_MAP_POP_MAPPER_NAME)
+ else if (map_kind == GOMP_MAP_POP_MAPPER_NAME)
{
mapper_name = NULL_TREE;
continue;
}
- tree decl = OMP_CLAUSE_DECL (clause), unshared, type;
+ tree decl = OMP_CLAUSE_DECL (clause);
+
+ if (map_kind == GOMP_MAP_MAPPING_GROUP)
+ {
+ tree data = omp_mapping_group_data (decl);
+ tree group_type = TREE_TYPE (OMP_CLAUSE_DECL (data));
+
+ group_type = TYPE_MAIN_VARIANT (group_type);
+
+ nested_mapper_p = implicit_mappers->get ({ mapper_name, group_type });
+
+ if (nested_mapper_p && *nested_mapper_p != mapperfn)
+ {
+ tree unshared = unshare_expr (data);
+ map_kind = OMP_CLAUSE_MAP_KIND (data);
+ walk_tree (&unshared, remap_mapper_decl_1, &id, NULL);
+ tree ptr = omp_mapping_group_ptr (decl);
+
+ /* !!! When ptr is NULL, we're discarding the other nodes in the
+ mapping group. Is that always OK? */
+
+ if (ptr)
+ {
+ /* This behaviour is Fortran-specific. That's fine for now
+ because only Fortran is using GOMP_MAP_MAPPING_GROUP, but
+ may need revisiting if that ever changes. */
+ gcc_assert (lang_GNU_Fortran ());
+
+ /* We're invoking a (nested) mapper from CLAUSE, which was a
+ pointer to a derived type. The elements of the derived
+ type are handled by the mapper, but we need to map the
+ actual pointer as well. Create an ALLOC node to do
+ that. */
+
+ tree ptr_unshared = unshare_expr (ptr);
+ walk_tree (&ptr_unshared, remap_mapper_decl_1, &id, NULL);
+
+ tree node = build_omp_clause (OMP_CLAUSE_LOCATION (clause),
+ OMP_CLAUSE_MAP);
+ OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_ALLOC);
+ OMP_CLAUSE_DECL (node) = OMP_CLAUSE_DECL (ptr_unshared);
+ OMP_CLAUSE_SIZE (node)
+ = TYPE_SIZE_UNIT (TREE_TYPE (OMP_CLAUSE_DECL (node)));
+
+ *mapper_clauses_p = node;
+ mapper_clauses_p = &OMP_CLAUSE_CHAIN (node);
+ }
+
+ if (map_kind == GOMP_MAP_UNSET)
+ map_kind = outer_kind;
+
+ mapper_clauses_p
+ = omp_instantiate_mapper (pre_p, implicit_mappers,
+ *nested_mapper_p,
+ OMP_CLAUSE_DECL (unshared), map_kind,
+ mapper_clauses_p);
+ }
+ else
+ /* No nested mapper, so process each element of the mapping
+ group. */
+ for (tree cp = OMP_CLAUSE_DECL (clause); cp; cp = TREE_CHAIN (cp))
+ {
+ tree node = unshare_expr (TREE_PURPOSE (cp));
+ walk_tree (&node, remap_mapper_decl_1, &id, NULL);
+
+ if (OMP_CLAUSE_MAP_KIND (node) == GOMP_MAP_UNSET)
+ OMP_CLAUSE_SET_MAP_KIND (node, outer_kind);
+
+ *mapper_clauses_p = node;
+ mapper_clauses_p = &OMP_CLAUSE_CHAIN (node);
+ }
+
+ continue;
+ }
+
+ tree unshared, type;
bool nonunit_array_with_mapper = false;
if (TREE_CODE (decl) == OMP_ARRAY_SECTION)
@@ -10497,7 +10791,7 @@ omp_instantiate_mapper (hash_map<omp_name_type<tree>, tree> *implicit_mappers,
type = TREE_TYPE (decl);
}
- walk_tree (&unshared, remap_mapper_decl_1, &map_info, NULL);
+ walk_tree (&unshared, remap_mapper_decl_1, &id, NULL);
if (OMP_CLAUSE_MAP_KIND (unshared) == GOMP_MAP_UNSET)
OMP_CLAUSE_SET_MAP_KIND (unshared, outer_kind);
@@ -10505,9 +10799,9 @@ omp_instantiate_mapper (hash_map<omp_name_type<tree>, tree> *implicit_mappers,
decl = OMP_CLAUSE_DECL (unshared);
type = TYPE_MAIN_VARIANT (type);
- tree *nested_mapper_p = implicit_mappers->get ({ mapper_name, type });
+ nested_mapper_p = implicit_mappers->get ({ mapper_name, type });
- if (nested_mapper_p && *nested_mapper_p != mapper)
+ if (nested_mapper_p && *nested_mapper_p != mapperfn)
{
if (nonunit_array_with_mapper)
{
@@ -10515,12 +10809,13 @@ omp_instantiate_mapper (hash_map<omp_name_type<tree>, tree> *implicit_mappers,
continue;
}
- if (clause_kind == GOMP_MAP_UNSET)
- clause_kind = outer_kind;
+ if (map_kind == GOMP_MAP_UNSET)
+ map_kind = outer_kind;
mapper_clauses_p
- = omp_instantiate_mapper (implicit_mappers, *nested_mapper_p,
- decl, clause_kind, mapper_clauses_p);
+ = omp_instantiate_mapper (pre_p, implicit_mappers,
+ *nested_mapper_p, decl, map_kind,
+ mapper_clauses_p);
continue;
}
@@ -10531,36 +10826,18 @@ omp_instantiate_mapper (hash_map<omp_name_type<tree>, tree> *implicit_mappers,
return mapper_clauses_p;
}
-/* Scan GROUPS for mappings that map all or part of a struct or union decl,
- and add to HANDLED. Implicit user-defined mappers will then not be invoked
- for those decls. */
-
-static void
-omp_find_explicitly_mapped_structs (hash_set<tree> *handled,
- vec<omp_mapping_group> *groups)
+static int
+omp_find_explicitly_mapped_structs_r (splay_tree_node n, void *data)
{
- if (!groups)
- return;
+ hash_set<tree> *handled_structs = (hash_set<tree> *) data;
+ tree decl = (tree) n->key;
+ unsigned flags = n->value;
- for (auto &i : *groups)
- {
- tree node = *i.grp_start;
+ if ((flags & GOVD_EXPLICIT)
+ && AGGREGATE_TYPE_P (TREE_TYPE (decl)))
+ handled_structs->add (decl);
- if (OMP_CLAUSE_CODE (node) == OMP_CLAUSE_MAP
- && DECL_P (OMP_CLAUSE_DECL (node)))
- switch (OMP_CLAUSE_MAP_KIND (node) & ~GOMP_MAP_FLAG_FORCE)
- {
- case GOMP_MAP_ALLOC:
- case GOMP_MAP_TO:
- case GOMP_MAP_FROM:
- case GOMP_MAP_TOFROM:
- case GOMP_MAP_STRUCT:
- handled->add (OMP_CLAUSE_DECL (node));
- break;
- default:
- ;
- }
- }
+ return 0;
}
static int
@@ -10572,6 +10849,12 @@ omp_instantiate_implicit_mappers (splay_tree_node n, void *data)
tree *mapper_p = NULL;
tree type = TREE_TYPE (decl);
bool ref_p = false;
+ unsigned flags = n->value;
+
+ if (flags & (GOVD_EXPLICIT | GOVD_LOCAL))
+ return 0;
+ if ((flags & GOVD_SEEN) == 0)
+ return 0;
if (TREE_CODE (type) == REFERENCE_TYPE)
{
@@ -10597,8 +10880,12 @@ omp_instantiate_implicit_mappers (splay_tree_node n, void *data)
decl = build_fold_indirect_ref (decl);
im_info->mapper_clauses_p
- = omp_instantiate_mapper (ctx->implicit_mappers, *mapper_p, decl,
- GOMP_MAP_TOFROM, im_info->mapper_clauses_p);
+ = omp_instantiate_mapper (im_info->pre_p, ctx->implicit_mappers,
+ *mapper_p, decl, GOMP_MAP_TOFROM,
+ im_info->mapper_clauses_p);
+ /* Make sure we don't map the same variable implicitly in
+ gimplify_adjust_omp_clauses_1 also. */
+ n->value |= GOVD_EXPLICIT;
}
return 0;
@@ -10682,13 +10969,17 @@ gimplify_scan_omp_clauses (tree *list_p, gimple_seq *pre_p,
/* If we already have clauses pertaining to a struct variable, then
we don't want to implicitly invoke a user-defined mapper. Scan
through the groups to check what we have already. */
- omp_find_explicitly_mapped_structs (&handled_structs, groups);
+
+ splay_tree_foreach (ctx->variables,
+ omp_find_explicitly_mapped_structs_r,
+ (void *) &handled_structs);
im_info.groups = groups;
im_info.grpmap = grpmap;
im_info.handled_structs = &handled_structs;
im_info.mapper_clauses_p = &mapper_clauses;
im_info.omp_ctx = ctx;
+ im_info.pre_p = pre_p;
splay_tree_foreach (ctx->variables,
omp_instantiate_implicit_mappers,
@@ -11525,11 +11816,7 @@ gimplify_scan_omp_clauses (tree *list_p, gimple_seq *pre_p,
tree var = OMP_CLAUSE__MAPPER_BINDING__DECL (c);
tree type = TYPE_MAIN_VARIANT (TREE_TYPE (var));
tree fndecl = OMP_CLAUSE__MAPPER_BINDING__MAPPER (c);
- tree mapper
- = lang_hooks.decls.omp_extract_mapper_directive (fndecl);
- gcc_assert (mapper != NULL_TREE
- && TREE_CODE (mapper) == OMP_DECLARE_MAPPER);
- ctx->implicit_mappers->put ({ name, type }, mapper);
+ ctx->implicit_mappers->put ({ name, type }, fndecl);
remove = true;
break;
}
diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-mapper-1.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-1.f90
new file mode 100644
index 00000000000..7bf30df9cdb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-1.f90
@@ -0,0 +1,71 @@
+! { dg-do compile }
+
+! Basic "!$omp declare mapper" parsing tests.
+
+module mymod
+type s
+ integer :: c
+ integer :: d(99)
+ integer, dimension(100,100) :: e
+end type s
+
+!$omp declare mapper (s :: x) map(tofrom: x%c, x%d)
+!$omp declare mapper (withaname : s :: x) map(from: x%d(2:30))
+!$omp declare mapper (withaname2 : s :: x) map(from: x%d(5))
+!$omp declare mapper (named: s :: x) map(tofrom: x%e(:,3))
+!$omp declare mapper (named2: s :: x) map(tofrom: x%e(5,:))
+
+end module mymod
+
+program myprog
+use mymod, only: s
+type t
+ integer :: a
+ integer :: b
+end type t
+
+type u
+ integer :: q
+end type u
+
+type deriv
+ integer :: arr(100)
+ integer :: len
+end type deriv
+
+type(t) :: y
+type(s) :: z
+type(u) :: p
+type(deriv) :: d
+integer, dimension(100,100) :: i2d
+
+!$omp declare mapper (t :: x) map(tofrom: x%a) map(y%b)
+!$omp declare mapper (named: t :: x) map(tofrom: x%a) map(y%b)
+!$omp declare mapper (integer :: x) ! { dg-error "\\\!\\\$OMP DECLARE MAPPER with non-derived type" }
+
+!$omp declare mapper (deriv :: x) map(tofrom: x%len) &
+!$omp & map(tofrom: x%arr(:))
+
+!$omp target map(tofrom: z%e(:,5))
+!$omp end target
+
+!$omp target map(mapper(named), tofrom: y)
+!$omp end target
+
+!$omp target
+y%a = y%b
+!$omp end target
+
+d%len = 10
+
+!$omp target
+d%arr(5) = 13
+!$omp end target
+
+!$omp target map(tofrom: z)
+!$omp end target
+
+!$omp target map(mapper(withaname), from: z) map(tofrom:p%q)
+!$omp end target
+
+end program myprog
diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-mapper-14.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-14.f90
new file mode 100644
index 00000000000..8ae73935a2d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-14.f90
@@ -0,0 +1,26 @@
+program myprog
+type T
+integer :: arr1(10)
+integer :: arr2(10)
+end type T
+
+type U
+integer :: arr1(10)
+end type U
+
+type V
+integer :: arr1(10)
+end type V
+
+!$omp declare mapper (default: T :: x) map(to:x%arr1) map(from:x%arr2) ! { dg-error "Previous \\\!\\\$OMP DECLARE MAPPER" }
+!$omp declare mapper (T :: x) map(to:x%arr1) ! { dg-error "Redefinition of \\\!\\\$OMP DECLARE MAPPER" }
+
+! Check what happens if we're SHOUTING too.
+!$omp declare mapper (default: U :: x) map(to:x%arr1) ! { dg-error "Previous \\\!\\\$OMP DECLARE MAPPER" }
+!$omp declare mapper (DEFAULT: U :: x) map(to:x%arr1) ! { dg-error "Redefinition of \\\!\\\$OMP DECLARE MAPPER" }
+
+! Or if we're using a keyword (which should be fine).
+!$omp declare mapper (V :: x) map(alloc:x%arr1)
+!$omp declare mapper (integer : V :: x) map(tofrom:x%arr1(:))
+
+end program myprog
diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-mapper-16.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-16.f90
new file mode 100644
index 00000000000..d4b9e5b4cca
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-16.f90
@@ -0,0 +1,22 @@
+program myprog
+
+type A
+character(len=20) :: string1
+character(len=:), allocatable :: string2
+end type A
+
+!$omp declare mapper (A :: x) map(to:x%string1) map(from:x%string2) ! { dg-error "List item 'x' with allocatable components is not permitted in map clause" }
+
+type(A) :: var
+
+allocate(character(len=20) :: var%string2)
+
+var%string1 = "hello world"
+
+!$omp target
+var%string2 = var%string1
+!$omp end target
+
+if (var%string2.ne."hello world") stop 1
+
+end program myprog
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..0790fcd3508
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-5.f90
@@ -0,0 +1,45 @@
+! { dg-do compile }
+
+! Check duplicate mapper detection in module reader.
+
+module mod1
+type S
+integer, dimension(:), pointer :: arr
+end type S
+!$omp declare mapper (S :: v) map(to: v%arr) map(tofrom:v%arr(1))
+end module mod1
+
+module mod2
+type S
+character :: c
+integer, dimension(:), pointer :: arr
+end type S
+!$omp declare mapper (S :: v) map(to: v%arr) map(tofrom:v%arr(:))
+
+type(S) :: svar
+
+contains
+
+subroutine setup
+allocate(svar%arr(10))
+end subroutine setup
+
+subroutine teardown
+deallocate(svar%arr)
+end subroutine teardown
+
+end module mod2
+
+program myprog
+use mod1 ! { dg-error "Previous \\\!\\\$OMP DECLARE MAPPER from module mod1" }
+use mod2 ! { dg-error "Ambiguous \\\!\\\$OMP DECLARE MAPPER from module mod2" }
+
+call setup
+
+!$omp target
+svar%arr(1) = svar%arr(1) + 1
+!$omp end target
+
+call teardown
+
+end program myprog
diff --git a/gcc/tree-pretty-print.cc b/gcc/tree-pretty-print.cc
index 58336a9adcd..a5b743bb5b3 100644
--- a/gcc/tree-pretty-print.cc
+++ b/gcc/tree-pretty-print.cc
@@ -949,6 +949,9 @@ dump_omp_clause (pretty_printer *pp, tree clause, int spc, dump_flags_t flags)
case GOMP_MAP_POP_MAPPER_NAME:
pp_string (pp, "pop_mapper");
break;
+ case GOMP_MAP_MAPPING_GROUP:
+ pp_string (pp, "mapping_group");
+ break;
default:
gcc_unreachable ();
}
diff --git a/include/gomp-constants.h b/include/gomp-constants.h
index 6b476ef621f..39691ed83f5 100644
--- a/include/gomp-constants.h
+++ b/include/gomp-constants.h
@@ -188,7 +188,10 @@ enum gomp_map_kind
GOMP_MAP_UNSET = (GOMP_MAP_LAST | 4),
/* Used to record the name of a named mapper. */
GOMP_MAP_PUSH_MAPPER_NAME = (GOMP_MAP_LAST | 5),
- GOMP_MAP_POP_MAPPER_NAME = (GOMP_MAP_LAST | 6)
+ GOMP_MAP_POP_MAPPER_NAME = (GOMP_MAP_LAST | 6),
+ /* Used to hold a TREE_LIST of grouped nodes in an 'omp declare mapper'
+ definition (only for Fortran at present). */
+ GOMP_MAP_MAPPING_GROUP = (GOMP_MAP_LAST | 7)
};
#define GOMP_MAP_COPY_TO_P(X) \
diff --git a/libgomp/testsuite/libgomp.fortran/declare-mapper-10.f90 b/libgomp/testsuite/libgomp.fortran/declare-mapper-10.f90
new file mode 100644
index 00000000000..801becc7d7d
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/declare-mapper-10.f90
@@ -0,0 +1,40 @@
+! { dg-do run }
+
+program myprog
+type t
+ integer, dimension (8) :: arr1
+end type t
+type u
+ type(t), dimension (:), pointer :: tarr
+end type u
+
+type(u) :: myu
+type(t), dimension (12), target :: myarray
+
+!$omp declare mapper (t :: x) map(x%arr1(1:4))
+!$omp declare mapper (u :: x) map(to: x%tarr) map(x%tarr(1))
+
+myu%tarr => myarray
+
+myu%tarr(1)%arr1(1) = 1
+
+! We can't do this: we have a mapper for "t" elements, and this implicitly maps
+! the whole array.
+!!$omp target map(tofrom:myu%tarr)
+!myu%tarr(1)%arr1(1) = myu%tarr(1)%arr1(1) + 1
+!!$omp end target
+
+! ...but we can do this, because we're just mapping an element of the "t"
+! array. We still need to map the actual "myu%tarr" descriptor.
+!$omp target map(to:myu%tarr) map(myu%tarr(1)%arr1(1:4))
+myu%tarr(1)%arr1(1) = myu%tarr(1)%arr1(1) + 1
+!$omp end target
+
+!$omp target
+myu%tarr(1)%arr1(1) = myu%tarr(1)%arr1(1) + 1
+!$omp end target
+
+if (myu%tarr(1)%arr1(1).ne.3) stop 1
+
+end program myprog
+
diff --git a/libgomp/testsuite/libgomp.fortran/declare-mapper-11.f90 b/libgomp/testsuite/libgomp.fortran/declare-mapper-11.f90
new file mode 100644
index 00000000000..0fc424a7ba4
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/declare-mapper-11.f90
@@ -0,0 +1,38 @@
+! { dg-do run }
+
+program myprog
+type t
+ integer, dimension (8) :: arr1
+end type t
+type u
+ type(t) :: t_elem
+end type u
+
+type(u) :: myu
+
+!$omp declare mapper (t :: x) map(x%arr1(5:8))
+!$omp declare mapper (tmapper: t :: x) map(x%arr1(1:4))
+!$omp declare mapper (u :: x) map(mapper(tmapper), tofrom: x%t_elem)
+
+myu%t_elem%arr1(1) = 1
+myu%t_elem%arr1(5) = 1
+
+! Different ways of invoking nested mappers, named vs. unnamed
+
+!$omp target map(tofrom:myu%t_elem)
+myu%t_elem%arr1(5) = myu%t_elem%arr1(5) + 1
+!$omp end target
+
+!$omp target map(tofrom:myu)
+myu%t_elem%arr1(1) = myu%t_elem%arr1(1) + 1
+!$omp end target
+
+!$omp target
+myu%t_elem%arr1(1) = myu%t_elem%arr1(1) + 1
+!$omp end target
+
+if (myu%t_elem%arr1(1).ne.3) stop 1
+if (myu%t_elem%arr1(5).ne.2) stop 2
+
+end program myprog
+
diff --git a/libgomp/testsuite/libgomp.fortran/declare-mapper-12.f90 b/libgomp/testsuite/libgomp.fortran/declare-mapper-12.f90
new file mode 100644
index 00000000000..a475501d014
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/declare-mapper-12.f90
@@ -0,0 +1,33 @@
+! { dg-do run }
+
+program myprog
+type t
+ integer, dimension (8) :: arr1
+end type t
+type u
+ type(t) :: t_elem
+end type u
+
+type(u) :: myu
+
+!$omp declare mapper (tmapper: t :: x) map(x%arr1(1:4))
+!$omp declare mapper (u :: x) map(mapper(tmapper), tofrom: x%t_elem)
+
+myu%t_elem%arr1(1) = 1
+
+!$omp target map(tofrom:myu%t_elem)
+myu%t_elem%arr1(1) = myu%t_elem%arr1(1) + 1
+!$omp end target
+
+!$omp target map(tofrom:myu)
+myu%t_elem%arr1(1) = myu%t_elem%arr1(1) + 1
+!$omp end target
+
+!$omp target
+myu%t_elem%arr1(1) = myu%t_elem%arr1(1) + 1
+!$omp end target
+
+if (myu%t_elem%arr1(1).ne.4) stop 1
+
+end program myprog
+
diff --git a/libgomp/testsuite/libgomp.fortran/declare-mapper-13.f90 b/libgomp/testsuite/libgomp.fortran/declare-mapper-13.f90
new file mode 100644
index 00000000000..3cae0fe7c26
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/declare-mapper-13.f90
@@ -0,0 +1,49 @@
+! { dg-do run }
+
+module mymod
+type S
+integer :: a
+integer :: b
+integer :: c
+end type S
+
+!$omp declare mapper (S :: x) map(x%c)
+end module mymod
+
+program myprog
+use mymod
+type T
+integer :: a
+integer :: b
+integer :: c
+end type T
+
+type(S) :: mys
+type(T) :: myt
+
+!$omp declare mapper (T :: x) map(x%b)
+
+myt%a = 0
+myt%b = 0
+myt%c = 0
+mys%a = 0
+mys%b = 0
+mys%c = 0
+
+!$omp target
+myt%b = myt%b + 1
+!$omp end target
+
+!$omp target
+mys%c = mys%c + 1
+!$omp end target
+
+!$omp target
+myt%b = myt%b + 2
+mys%c = mys%c + 3
+!$omp end target
+
+if (myt%b.ne.3) stop 1
+if (mys%c.ne.4) stop 2
+
+end program myprog
diff --git a/libgomp/testsuite/libgomp.fortran/declare-mapper-15.f90 b/libgomp/testsuite/libgomp.fortran/declare-mapper-15.f90
new file mode 100644
index 00000000000..eb0dd5f1027
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/declare-mapper-15.f90
@@ -0,0 +1,24 @@
+! { dg-do run }
+
+program myprog
+
+type A
+character(len=20) :: string1
+character(len=:), pointer :: string2
+end type A
+
+!$omp declare mapper (A :: x) map(to:x%string1) map(from:x%string2)
+
+type(A) :: var
+
+allocate(character(len=20) :: var%string2)
+
+var%string1 = "hello world"
+
+!$omp target map(to:var%string1) map(from:var%string2)
+var%string2 = var%string1
+!$omp end target
+
+if (var%string2.ne."hello world") stop 1
+
+end program myprog
diff --git a/libgomp/testsuite/libgomp.fortran/declare-mapper-17.f90 b/libgomp/testsuite/libgomp.fortran/declare-mapper-17.f90
new file mode 100644
index 00000000000..c21597145dd
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/declare-mapper-17.f90
@@ -0,0 +1,92 @@
+! { dg-do run }
+
+program myprog
+
+type A
+integer :: x
+integer :: y(20)
+integer, dimension(:), pointer :: z
+end type A
+
+integer, target :: arr1(20), arr2(20)
+type(A) :: p, q
+
+p%y = 0
+q%y = 0
+
+p%z => arr1
+q%z => arr2
+
+call mysub (p, q)
+
+if (p%z(1).ne.1) stop 1
+if (q%z(1).ne.1) stop 2
+
+p%y = 0
+q%y = 0
+p%z = 0
+q%z = 0
+
+call mysub2 (p, q)
+
+if (p%z(1).ne.1) stop 3
+if (q%z(1).ne.1) stop 4
+
+p%y = 0
+q%y = 0
+p%z = 0
+q%z = 0
+
+call mysub3 (p, q)
+
+if (p%z(1).ne.1) stop 5
+if (q%z(1).ne.1) stop 6
+
+contains
+
+subroutine mysub(arg1, arg2)
+implicit none
+type(A), intent(inout) :: arg1
+type(A), intent(inout) :: arg2
+
+!$omp declare mapper (A :: x) map(always, to:x) map(tofrom:x%z(:))
+
+!$omp target
+arg1%y(1) = arg1%y(1) + 1
+arg1%z = arg1%y
+arg2%y(1) = arg2%y(1) + 1
+arg2%z = arg2%y
+!$omp end target
+end subroutine mysub
+
+subroutine mysub2(arg1, arg2)
+implicit none
+type(A), intent(inout) :: arg1
+type(A), intent(inout) :: arg2
+
+!$omp declare mapper (A :: x) map(to:x) map(from:x%z(:))
+
+!$omp target
+arg1%y(1) = arg1%y(1) + 1
+arg1%z = arg1%y
+arg2%y(1) = arg2%y(1) + 1
+arg2%z = arg2%y
+!$omp end target
+end subroutine mysub2
+
+subroutine mysub3(arg1, arg2)
+implicit none
+type(A), intent(inout) :: arg1
+type(A), intent(inout) :: arg2
+
+!$omp declare mapper (A :: x) map(to:x) map(from:x%z(:))
+
+!$omp target map(arg1, arg2)
+arg1%y(1) = arg1%y(1) + 1
+arg1%z = arg1%y
+arg2%y(1) = arg2%y(1) + 1
+arg2%z = arg2%y
+!$omp end target
+end subroutine mysub3
+
+end program myprog
diff --git a/libgomp/testsuite/libgomp.fortran/declare-mapper-18.f90 b/libgomp/testsuite/libgomp.fortran/declare-mapper-18.f90
new file mode 100644
index 00000000000..a333b6844f1
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/declare-mapper-18.f90
@@ -0,0 +1,46 @@
+! { dg-do run }
+
+module mymod
+type F
+integer :: a, b, c
+integer, dimension(10) :: d
+end type F
+
+type G
+integer :: x, y
+type(F), pointer :: myf
+integer :: z
+end type G
+
+! Check that nested mappers work inside modules.
+
+!$omp declare mapper (F :: f) map(to: f%b) map(f%d)
+!$omp declare mapper (G :: g) map(tofrom: g%myf)
+
+end module mymod
+
+program myprog
+use mymod
+
+type(F), target :: ftmp
+type(G) :: gvar
+
+gvar%myf => ftmp
+
+gvar%myf%d = 0
+
+!$omp target map(gvar%myf)
+gvar%myf%d(1) = gvar%myf%d(1) + 1
+!$omp end target
+
+!$omp target map(gvar)
+gvar%myf%d(1) = gvar%myf%d(1) + 1
+!$omp end target
+
+!$omp target
+gvar%myf%d(1) = gvar%myf%d(1) + 1
+!$omp end target
+
+if (gvar%myf%d(1).ne.3) stop 1
+
+end program myprog
diff --git a/libgomp/testsuite/libgomp.fortran/declare-mapper-19.f90 b/libgomp/testsuite/libgomp.fortran/declare-mapper-19.f90
new file mode 100644
index 00000000000..d86497524f9
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/declare-mapper-19.f90
@@ -0,0 +1,29 @@
+! { dg-do run }
+
+program myprog
+type F
+integer :: a, b, c
+integer, dimension(10) :: d
+end type F
+
+type(F), pointer :: myf
+
+!$omp declare mapper (F :: f) map(f%d)
+
+allocate(myf)
+
+myf%d = 0
+
+!$omp target map(myf)
+myf%d(1) = myf%d(1) + 1
+!$omp end target
+
+!$omp target
+myf%d(1) = myf%d(1) + 1
+!$omp end target
+
+if (myf%d(1).ne.2) stop 1
+
+deallocate(myf)
+
+end program myprog
diff --git a/libgomp/testsuite/libgomp.fortran/declare-mapper-2.f90 b/libgomp/testsuite/libgomp.fortran/declare-mapper-2.f90
new file mode 100644
index 00000000000..ec1c0ec2a15
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/declare-mapper-2.f90
@@ -0,0 +1,32 @@
+! { dg-do run }
+
+program myprog
+type s
+ integer :: c
+ integer :: d(99)
+end type s
+
+type t
+ type(s) :: mys
+end type t
+
+type u
+ type(t) :: myt
+end type u
+
+type(u) :: myu
+
+!$omp declare mapper (t :: x) map(tofrom: x%mys%c) map(x%mys%d(1:x%mys%c))
+
+myu%myt%mys%c = 1
+myu%myt%mys%d = 0
+
+!$omp target map(tofrom: myu%myt)
+myu%myt%mys%d(1) = myu%myt%mys%d(1) + 1
+myu%myt%mys%c = myu%myt%mys%c + 2
+!$omp end target
+
+if (myu%myt%mys%d(1).ne.1) stop 1
+if (myu%myt%mys%c.ne.3) stop 2
+
+end program myprog
diff --git a/libgomp/testsuite/libgomp.fortran/declare-mapper-20.f90 b/libgomp/testsuite/libgomp.fortran/declare-mapper-20.f90
new file mode 100644
index 00000000000..20688289ecf
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/declare-mapper-20.f90
@@ -0,0 +1,29 @@
+! { dg-do run }
+
+program myprog
+type F
+integer :: a, b, c
+integer, dimension(10) :: d
+end type F
+
+type(F), allocatable :: myf
+
+!$omp declare mapper (F :: f) map(f)
+
+allocate(myf)
+
+myf%d = 0
+
+!$omp target map(myf)
+myf%d(1) = myf%d(1) + 1
+!$omp end target
+
+!$omp target
+myf%d(1) = myf%d(1) + 1
+!$omp end target
+
+if (myf%d(1).ne.2) stop 1
+
+deallocate(myf)
+
+end program myprog
diff --git a/libgomp/testsuite/libgomp.fortran/declare-mapper-3.f90 b/libgomp/testsuite/libgomp.fortran/declare-mapper-3.f90
new file mode 100644
index 00000000000..517096db51c
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/declare-mapper-3.f90
@@ -0,0 +1,33 @@
+program myprog
+type s
+ integer :: c
+ integer :: d(99)
+end type s
+
+type t
+ type(s) :: mys
+end type t
+
+type u
+ type(t) :: myt
+end type u
+
+type(u) :: myu
+
+!$omp declare mapper (s :: x) map(tofrom: x%c, x%d(1:x%c))
+!$omp declare mapper (t :: x) map(tofrom: x%mys)
+!$omp declare mapper (u :: x) map(tofrom: x%myt)
+
+myu%myt%mys%c = 1
+myu%myt%mys%d = 0
+
+! Nested mappers.
+
+!$omp target map(tofrom: myu)
+myu%myt%mys%d(1) = myu%myt%mys%d(1) + 1
+!$omp end target
+
+if (myu%myt%mys%c.ne.1) stop 1
+if (myu%myt%mys%d(1).ne.1) stop 2
+
+end program myprog
diff --git a/libgomp/testsuite/libgomp.fortran/declare-mapper-4.f90 b/libgomp/testsuite/libgomp.fortran/declare-mapper-4.f90
new file mode 100644
index 00000000000..e95dbbd6f96
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/declare-mapper-4.f90
@@ -0,0 +1,36 @@
+! { dg-do run }
+
+program myprog
+type s
+ integer :: c
+ integer :: d(99)
+end type s
+
+type t
+ type(s) :: mys
+end type t
+
+type u
+ type(t) :: myt
+end type u
+
+type(u) :: myu
+
+! Here, the mappers are declared out of order, so later ones are not 'seen' by
+! earlier ones. Is that right?
+!$omp declare mapper (u :: x) map(tofrom: x%myt)
+!$omp declare mapper (t :: x) map(tofrom: x%mys)
+!$omp declare mapper (s :: x) map(tofrom: x%c, x%d(1:x%c))
+
+myu%myt%mys%c = 1
+myu%myt%mys%d = 0
+
+!$omp target map(tofrom: myu)
+myu%myt%mys%d(5) = myu%myt%mys%d(5) + 1
+!$omp end target
+
+! Note: we used the default mapper, not the 's' mapper, so we mapped the
+! whole array 'd'.
+if (myu%myt%mys%d(5).ne.1) stop 1
+
+end program myprog
diff --git a/libgomp/testsuite/libgomp.fortran/declare-mapper-6.f90 b/libgomp/testsuite/libgomp.fortran/declare-mapper-6.f90
new file mode 100644
index 00000000000..9ebf8da6d8b
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/declare-mapper-6.f90
@@ -0,0 +1,28 @@
+! { dg-do run }
+
+program myprog
+type bounds
+ integer :: lo
+ integer :: hi
+end type bounds
+
+integer, allocatable :: myarr(:)
+type(bounds) :: b
+
+! Use the placeholder variable, but not at the top level.
+!$omp declare mapper (bounds :: x) map(tofrom: myarr(x%lo:x%hi))
+
+allocate (myarr(1:100))
+
+b%lo = 4
+b%hi = 6
+
+myarr = 0
+
+!$omp target map(tofrom: b)
+myarr(5) = myarr(5) + 1
+!$omp end target
+
+if (myarr(5).ne.1) stop 1
+
+end program myprog
diff --git a/libgomp/testsuite/libgomp.fortran/declare-mapper-7.f90 b/libgomp/testsuite/libgomp.fortran/declare-mapper-7.f90
new file mode 100644
index 00000000000..6297c8e99cb
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/declare-mapper-7.f90
@@ -0,0 +1,29 @@
+! { dg-do run }
+
+program myprog
+type s
+ integer :: a
+ integer :: b
+end type s
+
+type t
+ type(s) :: mys
+end type t
+
+type(t) :: myt
+
+! Identity mapper
+
+!$omp declare mapper (s :: x) map(tofrom: x)
+!$omp declare mapper (t :: x) map(tofrom: x%mys)
+
+myt%mys%a = 0
+myt%mys%b = 0
+
+!$omp target map(tofrom: myt)
+myt%mys%a = myt%mys%a + 1
+!$omp end target
+
+if (myt%mys%a.ne.1) stop 1
+
+end program myprog
diff --git a/libgomp/testsuite/libgomp.fortran/declare-mapper-8.f90 b/libgomp/testsuite/libgomp.fortran/declare-mapper-8.f90
new file mode 100644
index 00000000000..bb9ccae784a
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/declare-mapper-8.f90
@@ -0,0 +1,115 @@
+! { dg-do run }
+
+program myprog
+type t
+ integer, dimension (8) :: arr1
+end type t
+type u
+ integer, dimension (9) :: arr1
+end type u
+type v
+ integer, dimension (10) :: arr1
+end type v
+type w
+ integer, dimension (11) :: arr1
+end type w
+type y
+ integer, dimension(:), pointer :: ptr1
+end type y
+type z
+ integer, dimension(:), pointer :: ptr1
+end type z
+
+!$omp declare mapper (t::x) map(tofrom:x%arr1)
+!$omp declare mapper (u::x) map(tofrom:x%arr1(:))
+!$omp declare mapper (v::x) map(always,tofrom:x%arr1(1:3))
+!$omp declare mapper (w::x) map(tofrom:x%arr1(1))
+!$omp declare mapper (y::x) map(tofrom:x%ptr1)
+!$omp declare mapper (z::x) map(tofrom:x%ptr1(1:3))
+
+type(t) :: myt
+type(u) :: myu
+type(v) :: myv
+type(w) :: myw
+type(y) :: myy
+integer, target, dimension(8) :: arrtgt
+type(z) :: myz
+integer, target, dimension(8) :: arrtgt2
+
+myy%ptr1 => arrtgt
+myz%ptr1 => arrtgt2
+
+myt%arr1 = 0
+
+!$omp target map(myt)
+myt%arr1(1) = myt%arr1(1) + 1
+!$omp end target
+
+!$omp target
+myt%arr1(1) = myt%arr1(1) + 1
+!$omp end target
+
+if (myt%arr1(1).ne.2) stop 1
+
+myu%arr1 = 0
+
+!$omp target map(tofrom:myu%arr1(:))
+myu%arr1(1) = myu%arr1(1) + 1
+!$omp end target
+
+!$omp target
+myu%arr1(1) = myu%arr1(1) + 1
+!$omp end target
+
+if (myu%arr1(1).ne.2) stop 2
+
+myv%arr1 = 0
+
+!$omp target map(always,tofrom:myv%arr1(1:3))
+myv%arr1(1) = myv%arr1(1) + 1
+!$omp end target
+
+!$omp target
+myv%arr1(1) = myv%arr1(1) + 1
+!$omp end target
+
+if (myv%arr1(1).ne.2) stop 3
+
+myw%arr1 = 0
+
+!$omp target map(tofrom:myw%arr1(1))
+myw%arr1(1) = myw%arr1(1) + 1
+!$omp end target
+
+!$omp target
+myw%arr1(1) = myw%arr1(1) + 1
+!$omp end target
+
+if (myw%arr1(1).ne.2) stop 4
+
+myy%ptr1 = 0
+
+!$omp target map(tofrom:myy%ptr1)
+myy%ptr1(1) = myy%ptr1(1) + 1
+!$omp end target
+
+!$omp target map(tofrom:myy%ptr1(1:2))
+myy%ptr1(1) = myy%ptr1(1) + 1
+!$omp end target
+
+!$omp target
+myy%ptr1(1) = myy%ptr1(1) + 1
+!$omp end target
+
+if (myy%ptr1(1).ne.3) stop 5
+
+myz%ptr1(1) = 0
+
+!$omp target
+myz%ptr1(1) = myz%ptr1(1) + 1
+!$omp end target
+
+if (myz%ptr1(1).ne.1) stop 6
+
+end program myprog
+
diff --git a/libgomp/testsuite/libgomp.fortran/declare-mapper-9.f90 b/libgomp/testsuite/libgomp.fortran/declare-mapper-9.f90
new file mode 100644
index 00000000000..deaf30b9575
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/declare-mapper-9.f90
@@ -0,0 +1,27 @@
+! { dg-do run }
+
+type t
+ integer, dimension (8) :: arr1
+end type t
+type u
+ type(t), dimension (:), pointer :: tarr
+end type u
+
+type(u) :: myu
+type(t), dimension (1), target :: myarray
+
+!$omp declare mapper (named: t :: x) map(x%arr1(1:4))
+!$omp declare mapper (u :: x) map(to: x%tarr) map(mapper(named), tofrom: x%tarr(1))
+
+myu%tarr => myarray
+myu%tarr(1)%arr1 = 0
+
+! Unnamed mapper invoking named mapper
+
+!$omp target
+myu%tarr(1)%arr1(1) = myu%tarr(1)%arr1(1) + 1
+!$omp end target
+
+if (myu%tarr(1)%arr1(1).ne.1) stop 1
+
+end
--
2.29.2
^ permalink raw reply [flat|nested] 8+ messages in thread