https://gcc.gnu.org/g:12127f61f7ba86464aedb1eac82e94dd65897527
commit 12127f61f7ba86464aedb1eac82e94dd65897527 Author: Julian Brown <[email protected]> Date: Thu Jul 2 17:05:57 2026 +0000 OpenMP: Look up 'declare mapper' definitions at resolution time not parse time This patch moves 'declare mapper' lookup for OpenMP clauses from parse time to resolution time for Fortran, and adds diagnostics for missing named mappers. This changes clause lookup in a particular case -- where several 'declare mapper's are defined in a context, mappers declared earlier may now instantiate mappers declared later, whereas previously they would not. I think the new behaviour makes more sense -- at an invocation site, all mappers are visible no matter the declaration order in some particular block. I've adjusted tests to account for this. I think the new arrangement better matches the Fortran FE's usual way of doing things -- mapper lookup is a semantic concept, not a syntactical one, so shouldn't be handled in the syntax-handling code. The patch also fixes a case where the user explicitly writes 'default' as the name on the mapper modifier for a clause. 2023-08-10 Julian Brown <[email protected]> gcc/fortran/ * gfortran.h (gfc_omp_namelist_udm): Add MAPPER_ID field to store the mapper name to use for lookup during resolution. * module.cc (load_omp_udms, write_omp_udm): Handle MAPPER_ID field. * openmp.cc (gfc_match_omp_clauses): Handle explicitly-specified 'default' name. Don't do mapper lookup here, but record mapper name if the user specifies one. (resolve_omp_clauses): Do mapper lookup here instead. Report error for missing named mapper. gcc/testsuite/ * gfortran.dg/gomp/declare-mapper-31.f90: New test. libgomp/ * testsuite/libgomp.fortran/declare-mapper-30.f90: New test. * testsuite/libgomp.fortran/declare-mapper-4.f90: Adjust test for new lookup behaviour. Diff: --- gcc/fortran/gfortran.h | 3 ++ gcc/fortran/module.cc | 6 +++ gcc/fortran/openmp.cc | 52 ++++++++++++++++------ .../gfortran.dg/gomp/declare-mapper-31.f90 | 34 ++++++++++++++ .../libgomp.fortran/declare-mapper-30.f90 | 24 ++++++++++ .../testsuite/libgomp.fortran/declare-mapper-4.f90 | 18 +++++--- 6 files changed, 117 insertions(+), 20 deletions(-) diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 4b4284ab577a..fca16b563286 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -1886,6 +1886,9 @@ gfc_omp_udm; typedef struct gfc_omp_namelist_udm { + /* Used to store mapper_id before resolution. */ + const char *mapper_id; + bool multiple_elems_p; struct gfc_omp_udm *udm; } diff --git a/gcc/fortran/module.cc b/gcc/fortran/module.cc index 3ea35574d876..4fd191f76dc3 100644 --- a/gcc/fortran/module.cc +++ b/gcc/fortran/module.cc @@ -5590,6 +5590,11 @@ load_omp_udms (void) 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", ""); + n->u3.udm->multiple_elems_p = mio_name (0, omp_map_cardinality); mio_pointer_ref (&n->u3.udm->udm); } @@ -6682,6 +6687,7 @@ write_omp_udm (gfc_omp_udm *udm) if (n->u3.udm) { + mio_pool_string (&n->u3.udm->mapper_id); mio_name (n->u3.udm->multiple_elems_p, omp_map_cardinality); mio_pointer_ref (&n->u3.udm->udm); } diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc index a7a449493be7..11ee8daedffc 100644 --- a/gcc/fortran/openmp.cc +++ b/gcc/fortran/openmp.cc @@ -3841,6 +3841,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,19 +3936,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 = gfc_get_omp_namelist_udm (); - n->u3.udm->udm = udm; + n->u3.udm->mapper_id + = gfc_get_string ("%s", mapper_id); } n->u2.ns = ns_iter; @@ -10480,8 +10474,40 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, case OMP_LIST_FROM: case OMP_LIST_CACHE: for (; n != NULL; n = n->next) - resolve_omp_clauses_aff_dep_map_cache (code, n, name, list, - omp_clauses, openacc); + { + resolve_omp_clauses_aff_dep_map_cache (code, n, name, list, + omp_clauses, openacc); + if (list == OMP_LIST_MAP + || list == OMP_LIST_TO + || list == OMP_LIST_FROM) + { + gfc_typespec *ts; + + if (n->expr) + ts = &n->expr->ts; + else + ts = &n->sym->ts; + + 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) + { + n->u3.udm = gfc_get_omp_namelist_udm (); + gcc_assert (mapper_id[0] == '\0'); + n->u3.udm->mapper_id = mapper_id; + } + n->u3.udm->udm = udm; + } + } + } break; case OMP_LIST_IS_DEVICE_PTR: last = NULL; 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..7145d51c1625 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-31.f90 @@ -0,0 +1,34 @@ +! { 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 } +var%arr(5) = 5 +!$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 } +var%arr(6) = 6 +!$omp end target +! { dg-error "Unexpected !.OMP END TARGET statement" "" { target *-*-* } .-1 } + +! ...but not for the specific name 'default'. +!$omp target map(mapper(default), tofrom: var) +var%arr(5) = 5 +!$omp end target + +end diff --git a/libgomp/testsuite/libgomp.fortran/declare-mapper-30.f90 b/libgomp/testsuite/libgomp.fortran/declare-mapper-30.f90 new file mode 100644 index 000000000000..bfac28cd45cf --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/declare-mapper-30.f90 @@ -0,0 +1,24 @@ +! { dg-do run } + +type t +integer :: x, y +integer, allocatable :: arr(:) +end type t + +!$omp declare mapper (t :: x) map(x%arr) + +type(t) :: var + +allocate(var%arr(1:20)) + +var%arr = 0 + +! The mapper named literally 'default' should be the default mapper, i.e. +! the same as the unnamed mapper defined above. +!$omp target map(mapper(default), tofrom: var) +var%arr(5) = 5 +!$omp end target + +if (var%arr(5).ne.5) stop 1 + +end diff --git a/libgomp/testsuite/libgomp.fortran/declare-mapper-4.f90 b/libgomp/testsuite/libgomp.fortran/declare-mapper-4.f90 index e95dbbd6f966..266845f35c7a 100644 --- a/libgomp/testsuite/libgomp.fortran/declare-mapper-4.f90 +++ b/libgomp/testsuite/libgomp.fortran/declare-mapper-4.f90 @@ -3,7 +3,7 @@ program myprog type s integer :: c - integer :: d(99) + integer, allocatable :: d(:) end type s type t @@ -16,21 +16,25 @@ 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? +! Here, the mappers are declared out of order, but earlier ones can still +! trigger mappers defined later. Implementation-wise, this happens during +! resolution, but from the user perspective it appears to happen at +! instantiation time -- at which point all mappers are visible. I think +! that makes sense. !$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)) +allocate(myu%myt%mys%d(1:20)) + 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 +myu%myt%mys%d(1) = myu%myt%mys%d(1) + 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 +! Note: we only mapped the first element of the array 'd'. +if (myu%myt%mys%d(1).ne.1) stop 1 end program myprog
