For the module version handling, cf. discussion at https://gcc.gnu.org/pipermail/gcc-patches/2026-June/719942.html
Committed as r17-1519-g3377399b85df6a. The current version doesn't touch the module version, i.e. it will work in all combination (old gcc vs. new gcc module read/write) as before the commit, except for printing "expected integer" as error if an older GCC reads a .mod file that contains a 'declare mapper'. Comments to the RFC (linked above) and to this patch are welcome! * * * This patch itself: Another step to have a working 'omp declare mapper' in Fortran, but still merging more of Julian's patches - including some bug fixes. This patch is mostly based on the OG14 (= OG13) commit 015cb4002d6c022b33234e6098303edf159fb19e OpenMP: Fortran "!$omp declare mapper" support https://gcc.gnu.org/g:015cb4002d6c022b33234e6098303edf159fb19e but I think some bits of later patch are included (and parts of this patch have been applied before - and more parts are missing). This patch moves the 'sorry' to explicit maps that have a mapper [explicitly or default]; hence, just 'declare mapper' or only using it via implicit maps will not trigger that message. (And leading to wrong code [intrinsic mapping not mapper] when the cod only has implicit maps.) By moving the 'sorry', the module handling could be added + tested and some resolving bits as well. There is also some prep work for 'target update' + 'to'/'from', but the parser support is part of a later patch (OG14 commit 8d4782a1d2ddbea28763e8767864eb56b2d1d12d) NOTE: As with declare reduction, the current code doesn't handle renaming of the derived-type name during module load. I decided that it makes most sense to handle it for declare mapper/reduction as a follow-up patch/commit. Tobias PS: Still missing: resolving the mapper + generating the 'tree' in trans-*.cc. That's part of the above mentioned commit plus the commits (all for Fortran): 4c94d35536cb3a7cb2a30dae3b8d01370f7a4bea OpenMP: Look up 'declare mapper' definitions at resolution time not parse time 628859fb41e9f21b9ee048efa5723b1ab4a39a63 OpenMP: Reprocess expanded clauses after 'declare mapper' instantiation d2ffdc33f61e889d29b53c82d8514835c6e626aa OpenMP: Move Fortran 'declare mapper' instantiation code PPS: Once applied, there are some additional bits, e.g. for patches that have been applied for C/C++ but wait for those changes before they can land for Fortran.
commit 3377399b85df6a0f060df93c94a365273ebdf2fd Author: Julian Brown <[email protected]> Date: Fri Jun 12 19:08:43 2026 +0200 Fortran/OpenMP: Add module support for 'declare mapper' This commits fixes some issues, moves resolution to the mapper_id from parsing to resolution stage and saves the mapper in the module file. As a side effect, there is no longer a 'sorry, unimplemented' for 'declare mapper'; the 'sorry' is now printed when using explicit map clauses that require a mapper. Note that no error is printed if the code only uses implicit maps, even though the mapper is ignored. Co-authored-by: Tobias Burnus <[email protected]> gcc/fortran/ChangeLog: * gfortran.h (gfc_omp_namelist): Change udm member into a pointer type. (gfc_omp_namelist_udm): Add mapper_id member and move down in the file below the related ..._udr struct. (gfc_get_omp_namelist_udm): New convenience macro. * match.cc (gfc_free_omp_namelist): Free udm. * module.cc (MOD_VERSION_NUMERIC): Add. (load_omp_udrs): Add diagnostic_group. (omp_map_clause_ops, load_omp_udms, check_omp_declare_mappers, write_omp_udm, write_omp_udms): New. (read_module, write_module): Support 'declare mapper'. * openmp.cc (gfc_find_omp_udm, gfc_match_omp_clauses, resolve_omp_clauses): Handle mapper_id and do later resolution. * resolve.cc (resolve_types): Remove 'declare mapper' sorry. * trans-openmp.cc (gfc_trans_omp_clauses): Add sorry for map clauses with mapper. gcc/testsuite/ChangeLog: * gfortran.dg/gomp/declare-mapper-1.f90: Remove no longer expect 'sorry, unimplemented'. * gfortran.dg/gomp/declare-mapper-3.f90: New test. * gfortran.dg/gomp/declare-mapper-31.f90: New test. * gfortran.dg/gomp/declare-mapper-4.f90: New test. * gfortran.dg/gomp/declare-mapper-5.f90: New test. --- gcc/fortran/gfortran.h | 20 +- gcc/fortran/match.cc | 8 +- gcc/fortran/module.cc | 262 ++++++++++++++++++++- gcc/fortran/openmp.cc | 46 +++- gcc/fortran/resolve.cc | 3 - gcc/fortran/trans-openmp.cc | 7 + .../gfortran.dg/gomp/declare-mapper-1.f90 | 5 +- .../gfortran.dg/gomp/declare-mapper-3.f90 | 29 +++ .../gfortran.dg/gomp/declare-mapper-31.f90 | 38 +++ .../gfortran.dg/gomp/declare-mapper-4.f90 | 20 ++ .../gfortran.dg/gomp/declare-mapper-5.f90 | 39 +++ 11 files changed, 445 insertions(+), 32 deletions(-) diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index c8fb8e463dd..801dd856e1b 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -1456,15 +1456,6 @@ enum gfc_omp_linear_op OMP_LINEAR_UVAL }; -typedef struct gfc_omp_namelist_udm -{ - /* When adding more struct members, change the struct use in gfc_omp_namelist - to a pointer and move the struct definition down, placing it after - '#define gfc_get_omp_udm'. */ - struct gfc_omp_udm *udm; -} -gfc_omp_namelist_udm; - /* For use in OpenMP clauses in case we need extra information (aligned clause alignment, linear clause step, etc.). */ @@ -1518,7 +1509,7 @@ typedef struct gfc_omp_namelist } u2; union { - struct gfc_omp_namelist_udm udm; + struct gfc_omp_namelist_udm *udm; } u3; struct gfc_omp_namelist *next; locus where; @@ -1931,6 +1922,15 @@ typedef struct gfc_omp_udm gfc_omp_udm; #define gfc_get_omp_udm() XCNEW (gfc_omp_udm) +typedef struct gfc_omp_namelist_udm +{ + const char *mapper_id; + struct gfc_omp_udm *udm; +} +gfc_omp_namelist_udm; +#define gfc_get_omp_namelist_udm() XCNEW (gfc_omp_namelist_udm) + + /* The gfc_st_label structure is a BBT attached to a namespace that records the usage of statement labels within that space. */ diff --git a/gcc/fortran/match.cc b/gcc/fortran/match.cc index ef6be2d2496..be376a8c062 100644 --- a/gcc/fortran/match.cc +++ b/gcc/fortran/match.cc @@ -6542,7 +6542,9 @@ gfc_free_omp_namelist (gfc_omp_namelist *name, enum gfc_omp_list_type list) bool free_align_allocator = (list == OMP_LIST_ALLOCATE); bool free_mem_traits_space = (list == OMP_LIST_USES_ALLOCATORS); bool free_init = (list == OMP_LIST_INIT); - bool free_mapper = (list == OMP_LIST_MAP); + bool free_mapper = (list == OMP_LIST_MAP + || list == OMP_LIST_TO + || list == OMP_LIST_FROM); gfc_omp_namelist *n; gfc_expr *last_allocator = NULL; @@ -6576,8 +6578,8 @@ gfc_free_omp_namelist (gfc_omp_namelist *name, enum gfc_omp_list_type list) free (name->u2.init_interop); } } - else if (free_mapper) - { } /* For now, u3.udm is not a pointer. */ + else if (free_mapper && name->u3.udm) + free (name->u3.udm); else if (!free_mapper && name->u2.udr) { if (name->u2.udr->combiner) diff --git a/gcc/fortran/module.cc b/gcc/fortran/module.cc index 2bb116c79a4..b95997fe672 100644 --- a/gcc/fortran/module.cc +++ b/gcc/fortran/module.cc @@ -86,6 +86,7 @@ along with GCC; see the file COPYING3. If not see /* Don't put any single quote (') in MOD_VERSION, if you want it to be recognized. */ #define MOD_VERSION "16" +#define MOD_VERSION_NUMERIC 16 /* Older mod versions we can still parse. */ #define COMPAT_MOD_VERSIONS { "15" } @@ -5444,6 +5445,8 @@ load_omp_udrs (void) pointer_info *p = get_integer (atom_int); if (strcmp (p->u.rsym.module, udr->omp_out->module)) { + gcc_assert (!gfc_buffered_p ()); /* Cf. PR80012 comment 15. */ + auto_diagnostic_group d; gfc_error ("Ambiguous !$OMP DECLARE REDUCTION %qs for type %qs " "from module %qs at %L", udr->name, gfc_typename (&ts), module_name, &gfc_current_locus); @@ -5486,6 +5489,120 @@ load_omp_udrs (void) } +/* In declare mapper, not all map types are permitted; hence, only + a subset is needed. */ + +static const mstring omp_map_clause_ops[] = +{ + minit ("ALLOC", OMP_MAP_ALLOC), + minit ("TO", OMP_MAP_TO), + minit ("FROM", OMP_MAP_FROM), + minit ("TOFROM", OMP_MAP_TOFROM), + minit ("ALWAYS_TO", OMP_MAP_ALWAYS_TO), + minit ("ALWAYS_FROM", OMP_MAP_ALWAYS_FROM), + minit ("ALWAYS_TOFROM", OMP_MAP_ALWAYS_TOFROM), + minit ("UNSET", OMP_MAP_UNSET), + minit (NULL, -1) +}; + +/* This function loads OpenMP user-defined mappers. */ + +static void +load_omp_udms (void) +{ + while (peek_atom () != ATOM_RPAREN) + { + const char *mapper_id = NULL; + gfc_symtree *st; + + mio_lparen (); + gfc_omp_udm *udm = gfc_get_omp_udm (); + + require_atom (ATOM_INTEGER); + pointer_info *udmpi = get_integer (atom_int); + associate_integer_pointer (udmpi, udm); + + mio_pool_string (&mapper_id); + + /* Note: for a derived-type typespec, we might not have loaded the + "u.derived" symbol yet. Defer checking duplicates until + check_omp_declare_mappers is called after loading all symbols. */ + mio_typespec (&udm->ts); + + if (mapper_id == NULL) + mapper_id = gfc_get_string ("%s", ""); + + st = gfc_find_symtree (gfc_current_ns->omp_udm_root, mapper_id); + + pointer_info *p = mio_symbol_ref (&udm->var_sym); + pointer_info *q = get_integer (p->u.rsym.ns); + + udm->where = gfc_current_locus; + udm->mapper_id = mapper_id; + udm->mapper_ns = gfc_get_namespace (gfc_current_ns, 1); + udm->mapper_ns->proc_name = gfc_current_ns->proc_name; + udm->mapper_ns->omp_udm_ns = 1; + + associate_integer_pointer (q, udm->mapper_ns); + + gfc_omp_namelist *clauses = NULL; + gfc_omp_namelist **clausep = &clauses; + + mio_lparen (); + while (peek_atom () != ATOM_RPAREN) + { + /* Read each map clause. */ + gfc_omp_namelist *n = gfc_get_omp_namelist (); + + mio_lparen (); + + n->u.map.op = (gfc_omp_map_op) mio_name (0, omp_map_clause_ops); + mio_symbol_ref (&n->sym); + mio_expr (&n->expr); + + mio_lparen (); + + if (peek_atom () != ATOM_RPAREN) + { + n->u3.udm = gfc_get_omp_namelist_udm (); + mio_pool_string (&n->u3.udm->mapper_id); + + if (n->u3.udm->mapper_id == NULL) + n->u3.udm->mapper_id = gfc_get_string ("%s", ""); + + mio_pointer_ref (&n->u3.udm->udm); + } + + mio_rparen (); + + n->where = gfc_current_locus; + + mio_rparen (); + + *clausep = n; + clausep = &n->next; + } + mio_rparen (); + + udm->clauses = gfc_get_omp_clauses (); + udm->clauses->lists[OMP_LIST_MAP] = clauses; + + if (st) + { + udm->next = st->n.omp_udm; + st->n.omp_udm = udm; + } + else + { + st = gfc_new_symtree (&gfc_current_ns->omp_udm_root, mapper_id); + st->n.omp_udm = udm; + } + + mio_rparen (); + } +} + + /* Recursive function to traverse the pointer_info tree and load a needed symbol. We return nonzero if we load a symbol and stop the traversal, because the act of loading can alter the tree. */ @@ -5676,12 +5793,52 @@ 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) + { + gcc_assert (!gfc_buffered_p ()); /* Cf. PR80012 comment 15. */ + auto_diagnostic_group d; + gfc_error ("Ambiguous !$OMP DECLARE MAPPER %qs for type %qs from " + "module %qs at %L", + st->n.omp_udm->mapper_id[0] != '\0' + ? st->n.omp_udm->mapper_id : "default", + udm->ts.u.derived->name, module_name, + &udm->where); + inform (gfc_get_location (&prev_udm->where), + "Previous !$OMP DECLARE MAPPER from module %qs", + prev_udm->var_sym->module); + /* Delete the duplicate. */ + *udmp = (*udmp)->next; + } + else + udmp = &(*udmp)->next; + } +} + + /* Read a module file. */ static void read_module (void) { - module_locus operator_interfaces, user_operators, omp_udrs; + module_locus operator_interfaces, user_operators, omp_udrs, omp_udms; + bool has_omp_udms = false; const char *p; char name[GFC_MAX_SYMBOL_LEN + 1]; int i; @@ -5708,6 +5865,20 @@ read_module (void) get_module_locus (&omp_udrs); skip_list (); + /* Skip OpenMP's user-defined 'declare mapper' (UDM); some extra code is + required to permit reading files without USM; see write_module for + details. */ + get_module_locus (&omp_udms); + if (peek_atom () == ATOM_LPAREN + && parse_atom () + && module_char () == 'U' + && module_char () == 'D' + && module_char () == 'M') + has_omp_udms = true; + set_module_locus (&omp_udms); + if (has_omp_udms) + skip_list (); + mio_lparen (); /* Create the fixup nodes for all the symbols. */ @@ -6057,6 +6228,19 @@ read_module (void) set_module_locus (&omp_udrs); load_omp_udrs (); + /* Load OpenMP user defined mappers. */ + if (has_omp_udms) + { + set_module_locus (&omp_udms); + mio_lparen (); + /* Skip 'UDM' marker, cf. above. */ + (void) module_char (); + (void) module_char (); + (void) module_char (); + load_omp_udms (); + mio_rparen (); + } + /* At this point, we read those symbols that are needed but haven't been loaded yet. If one symbol requires another, the other gets marked as NEEDED if its previous state was UNUSED. */ @@ -6089,6 +6273,9 @@ read_module (void) module_name); } + /* Check "omp declare mappers" for duplicates from different modules. */ + check_omp_declare_mappers (gfc_current_ns->omp_udm_root); + /* Clean up symbol nodes that were never loaded, create references to hidden symbols. */ @@ -6454,6 +6641,8 @@ write_omp_udr (gfc_omp_udr *udr) } +/* Write OpenMP's declare reduction (used defined reductions). */ + static void write_omp_udrs (gfc_symtree *st) { @@ -6468,6 +6657,63 @@ write_omp_udrs (gfc_symtree *st) } +/* Write OpenMP's declare mapper (used defined mapper). */ + +static void +write_omp_udm (gfc_omp_udm *udm) +{ + mio_lparen (); + /* We need this pointer ref to identify this mapper so that other mappers + can refer to it. */ + mio_pointer_ref (&udm); + mio_pool_string (&udm->mapper_id); + mio_typespec (&udm->ts); + + if (udm->var_sym->module == NULL) + udm->var_sym->module = module_name; + + mio_symbol_ref (&udm->var_sym); + mio_lparen (); + gfc_omp_namelist *n; + for (n = udm->clauses->lists[OMP_LIST_MAP]; n; n = n->next) + { + mio_lparen (); + + mio_name (n->u.map.op, omp_map_clause_ops); + mio_symbol_ref (&n->sym); + mio_expr (&n->expr); + + mio_lparen (); + + if (n->u3.udm) + { + mio_pool_string (&n->u3.udm->mapper_id); + mio_pointer_ref (&n->u3.udm->udm); + } + + mio_rparen (); + + mio_rparen (); + } + mio_rparen (); + mio_rparen (); +} + + +static void +write_omp_udms (gfc_symtree *st) +{ + if (st == NULL) + return; + + write_omp_udms (st->left); + gfc_omp_udm *udm; + for (udm = st->n.omp_udm; udm; udm = udm->next) + write_omp_udm (udm); + write_omp_udms (st->right); +} + + /* Type for the temporary tree used when writing secondary symbols. */ struct sorted_pointer_info @@ -6730,6 +6976,20 @@ write_module (void) write_char ('\n'); write_char ('\n'); + /* Condition can be removed if version is bumped. Note that + write_symbol0 starts with an integer. Keep in sync with read_module; + The 'UDM' tag can be only removed when changing COMPAT_MOD_VERSIONS. */ + STATIC_ASSERT (MOD_VERSION_NUMERIC == 16); + if (gfc_current_ns->omp_udm_root) + { + mio_lparen (); + write_atom (ATOM_NAME, "UDM"); /* Marker. */ + write_omp_udms (gfc_current_ns->omp_udm_root); + mio_rparen (); + write_char ('\n'); + write_char ('\n'); + } + /* Write symbol information. First we traverse all symbols in the primary namespace, writing those that need to be written. Sometimes writing one symbol will cause another to need to be diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc index 4fd681efece..3d7d12de0c2 100644 --- a/gcc/fortran/openmp.cc +++ b/gcc/fortran/openmp.cc @@ -2466,7 +2466,8 @@ gfc_match_dupl_atomic (bool not_dupl, const char *name) /* Search upwards though namespace NS and its parents to find an - !$omp declare mapper named MAPPER_ID, for typespec TS. */ + !$omp declare mapper named MAPPER_ID, for typespec TS. The default + mapper has mapper_id == "". */ gfc_omp_udm * gfc_find_omp_udm (gfc_namespace *ns, const char *mapper_id, gfc_typespec *ts) @@ -3841,6 +3842,8 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, m = gfc_match (" %n ) ", mapper_id); if (m != MATCH_YES) goto error; + if (strcmp (mapper_id, "default") == 0) + mapper_id[0] = '\0'; } else if (gfc_match_iterator (&ns_iter, true) == MATCH_YES) { @@ -3934,17 +3937,11 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, for (n = *head; n; n = n->next) { n->u.map.op = map_op; - gfc_typespec *ts; - if (n->expr) - ts = &n->expr->ts; - else - ts = &n->sym->ts; - - gfc_omp_udm *udm - = gfc_find_omp_udm (gfc_current_ns, mapper_id, ts); - if (udm) + if (mapper_id[0] != '\0') { - n->u3.udm.udm = udm; + n->u3.udm = gfc_get_omp_namelist_udm (); + n->u3.udm->mapper_id + = gfc_get_string ("%s", mapper_id); } n->u2.ns = ns_iter; if (ns_iter) @@ -10452,6 +10449,33 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, default: break; } + if (list == OMP_LIST_MAP + || list == OMP_LIST_TO + || list == OMP_LIST_FROM) + { + gfc_typespec *ts = n->expr ? &n->expr->ts : &n->sym->ts; + + if (ts->type == BT_DERIVED || ts->type == BT_CLASS) + { + const char *mapper_id = (n->u3.udm + ? n->u3.udm->mapper_id : ""); + gfc_omp_udm *udm = gfc_find_omp_udm (gfc_current_ns, + mapper_id, ts); + if (mapper_id[0] != '\0' && !udm) + gfc_error ("User-defined mapper %qs not found at %L", + mapper_id, &n->where); + else if (udm) + { + if (!n->u3.udm) + { + gcc_assert (mapper_id[0] == '\0'); + n->u3.udm = gfc_get_omp_namelist_udm (); + n->u3.udm->mapper_id = mapper_id; + } + n->u3.udm->udm = udm; + } + } + } } if (list != OMP_LIST_DEPEND) diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc index 1259cdd9c91..281eede2f36 100644 --- a/gcc/fortran/resolve.cc +++ b/gcc/fortran/resolve.cc @@ -20694,9 +20694,6 @@ resolve_types (gfc_namespace *ns) gfc_resolve_omp_udrs (ns->omp_udr_root); gfc_resolve_omp_udms (ns->omp_udm_root); - if (ns->omp_udm_root) - gfc_error ("Sorry, %<declare mapper%>, used at %L, is not yet implemented", - &ns->omp_udm_root->n.omp_udm->where); ns->types_resolved = 1; diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc index 3fa011b1382..84f9ffb5129 100644 --- a/gcc/fortran/trans-openmp.cc +++ b/gcc/fortran/trans-openmp.cc @@ -4340,6 +4340,13 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, { if (!openacc) { + if (n->u3.udm) + gfc_error ("Sorry, declared mapper %qs, used for %qs at %L, " + "is not yet supported", + n->u3.udm->mapper_id[0] != '\0' + ? n->u3.udm->mapper_id : "default", + n->sym->name, &n->where); + // Remove duplicates bool skip = false; for (gfc_omp_namelist *n2 = n->next; n2 != NULL; diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-mapper-1.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-1.f90 index ef79f91e3fe..ee5d004c262 100644 --- a/gcc/testsuite/gfortran.dg/gomp/declare-mapper-1.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-1.f90 @@ -8,7 +8,7 @@ end type integer :: q, z -!$omp declare mapper(t :: v) map(v%x(1:5)) ! { dg-error "Sorry, 'declare mapper', used at .1., is not yet implemented" } +!$omp declare mapper(t :: v) map(v%x(1:5)) !$omp declare mapper(my_name : t :: v2) map(q) map(v2) map(z) type(t) :: var(4) @@ -29,7 +29,6 @@ type t end type t integer :: y !$omp declare mapper( t :: var) map(to: y) ! { dg-error "At least one 'map' clause in !.OMP DECLARE MAPPER at .1. must map 'var' or an element of it" } -! { dg-error "Sorry, 'declare mapper', used at .1., is not yet implemented" "" { target *-*-* } .-1 } end @@ -39,7 +38,6 @@ type t end type t integer :: y !$omp declare mapper( t :: var) ! { dg-error "At least one 'map' clause in !.OMP DECLARE MAPPER at .1. must map 'var' or an element of it" } -! { dg-error "Sorry, 'declare mapper', used at .1., is not yet implemented" "" { target *-*-* } .-1 } end subroutine four @@ -50,6 +48,5 @@ subroutine four !$omp declare mapper(my_id : t :: v3) map(v3) ! { dg-error "Redefinition of !.OMP DECLARE MAPPER at .1. for type 'TYPE\\(t\\)' with id 'my_id'" } !$omp declare mapper(t :: v4) map(v4) ! { dg-note "Previous !.OMP DECLARE MAPPER here" } -! { dg-error "Sorry, 'declare mapper', used at .1., is not yet implemented" "" { target *-*-* } .-1 } !$omp declare mapper(t :: v5) map(v5) ! { dg-error "Redefinition of !.OMP DECLARE MAPPER at .1. for type 'TYPE\\(t\\)'" } end diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-mapper-3.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-3.f90 new file mode 100644 index 00000000000..52e2170e046 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-3.f90 @@ -0,0 +1,29 @@ +! { dg-do compile } + +! Simple module test. + +module m + implicit none + type t + integer :: x + end type t + !$omp declare mapper(t :: v) map(v) + !$omp declare mapper(only_x : t :: y) map(y%x) + +type(t) :: var2 +contains +subroutine s +!$omp target enter data map(mapper(default), to: var2) ! { dg-error "Sorry, declared mapper 'default', used for 'var2' at .1., is not yet supported" } +end +end module m + +use m +implicit none +type(t) :: var +!$omp target enter data map(mapper(default), to: var) ! { dg-error "Sorry, declared mapper 'default', used for 'var' at .1., is not yet supported" } + +!$omp target exit data map(mapper(only_x), release: var) ! { dg-error "Sorry, declared mapper 'only_x', used for 'var' at .1., is not yet supported" } + +!$omp target map(var) ! { dg-error "Sorry, declared mapper 'default', used for 'var' at .1., is not yet supported" } +!$omp end target +end diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-mapper-31.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-31.f90 new file mode 100644 index 00000000000..f0701d54194 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-31.f90 @@ -0,0 +1,38 @@ +! { dg-do compile } + +type t +integer :: x, y +integer, allocatable :: arr(:) +end type t + +type(t) :: var + +allocate(var%arr(1:20)) + +var%arr = 0 + +! If we ask for a named mapper that hasn't been defined, an error should be +! raised. This isn't a *syntax* error, so the !$omp target..!$omp end target +! block should still be parsed correctly. +!$omp target map(mapper(arraymapper), tofrom: var) +! { dg-error "User-defined mapper .arraymapper. not found" "" { target *-*-* } .-1 } +block +var%arr(5) = 5 +end block +!$omp end target + +! OTOH, this is a syntax error, and the offload block is not recognized. +!$omp target map( +! { dg-error "Syntax error in OpenMP variable list" "" { target *-*-* } .-1 } +block +var%arr(6) = 6 +end block + +! ...but not for the specific name 'default'. +!$omp target map(mapper(default), tofrom: var) +block +var%arr(5) = 5 +end block +!$omp end target + +end diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-mapper-4.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-4.f90 new file mode 100644 index 00000000000..9403dd58993 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-4.f90 @@ -0,0 +1,20 @@ +module m + implicit none + private + type t + integer :: x, z + end type t + type t2 + ! private + type(t) :: y + end type t2 + public :: t2 + !$omp declare mapper(t :: v) map(v%x) +end module m + +use m +implicit none +type(t2) :: var +! Shall honor mapper +!$omp target enter data map(var%y) ! { dg-error "Sorry, declared mapper 'default', used for 'var' at .1., is not yet supported" } +end diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-mapper-5.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-5.f90 new file mode 100644 index 00000000000..97a2f0b5b45 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-5.f90 @@ -0,0 +1,39 @@ +! { dg-do compile } + +! The following are two declare mapper. +! Technically, they aren't ambiguous as they are identical +! but still we expect an error. + +module one + implicit none + type t + integer, pointer :: x(:) + end type t +end module + +module two + use one + implicit none + !$omp declare mapper(t :: v) map(v, v%x) +end module two + +module three + use one + implicit none + !$omp declare mapper(t :: v) map(v, v%x) +end module three + +subroutine sub1 + use two ! { dg-note "Previous !.OMP DECLARE MAPPER from module 'two'" } + use three ! { dg-error "Ambiguous !.OMP DECLARE MAPPER 'default' for type 't' from module 'three' at .1." } + implicit none + type(t) :: var + + allocate(var%x(1:20)) + var%x = 0 + + !$omp target map(tofrom: var) + block + var%x = 1 + end block +end
