https://gcc.gnu.org/g:3377399b85df6a0f060df93c94a365273ebdf2fd
commit r17-1519-g3377399b85df6a0f060df93c94a365273ebdf2fd 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. Diff: --- 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 c8fb8e463dda..801dd856e1b7 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 ef6be2d24962..be376a8c0625 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 2bb116c79a4f..b95997fe672b 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 4fd681efecea..3d7d12de0c25 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 1259cdd9c918..281eede2f366 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 3fa011b13829..84f9ffb51297 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 ef79f91e3fe7..ee5d004c2621 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 000000000000..52e2170e0463 --- /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 000000000000..f0701d541946 --- /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 000000000000..9403dd589938 --- /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 000000000000..97a2f0b5b45a --- /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
