https://gcc.gnu.org/g:3ea1f835c3775431634ffe1ad44b0c742664a3dd
commit 3ea1f835c3775431634ffe1ad44b0c742664a3dd
Author: Julian Brown <jul...@codesourcery.com>
Date: Wed Apr 23 00:01:43 2025 +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 <jul...@codesourcery.com>
gcc/fortran/
* gfortran.h (gfc_omp_namelist_udm): Add MAPPER_ID field to store
the
mapper name to use for lookup during resolution.
* match.cc (gfc_free_omp_namelist): Handle OMP_LIST_TO and
OMP_LIST_FROM when freeing mapper references.
* 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/match.cc | 4 +-
gcc/fortran/module.cc | 6 +++
gcc/fortran/openmp.cc | 46 ++++++++++++++++------
.../gfortran.dg/gomp/declare-mapper-31.f90 | 34 ++++++++++++++++
.../libgomp.fortran/declare-mapper-30.f90 | 24 +++++++++++
.../testsuite/libgomp.fortran/declare-mapper-4.f90 | 18 +++++----
7 files changed, 116 insertions(+), 19 deletions(-)
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 3be828c960a7..67cf255fbd93 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1844,6 +1844,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/match.cc b/gcc/fortran/match.cc
index aa902f935e08..d1648fdf913c 100644
--- a/gcc/fortran/match.cc
+++ b/gcc/fortran/match.cc
@@ -5882,7 +5882,9 @@ void
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);
+ bool free_mapper = (list == OMP_LIST_MAP
+ || list == OMP_LIST_TO
+ || list == OMP_LIST_FROM);
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);
diff --git a/gcc/fortran/module.cc b/gcc/fortran/module.cc
index bad9b6948a2d..bf43ed59eb47 100644
--- a/gcc/fortran/module.cc
+++ b/gcc/fortran/module.cc
@@ -5562,6 +5562,11 @@ load_omp_udms (void)
if (peek_atom () != ATOM_RPAREN)
{
n->u2.udm = gfc_get_omp_namelist_udm ();
+ mio_pool_string (&n->u2.udm->mapper_id);
+
+ if (n->u2.udm->mapper_id == NULL)
+ n->u2.udm->mapper_id = gfc_get_string ("%s", "");
+
n->u2.udm->multiple_elems_p = mio_name (0, omp_map_cardinality);
mio_pointer_ref (&n->u2.udm->udm);
}
@@ -6638,6 +6643,7 @@ write_omp_udm (gfc_omp_udm *udm)
if (n->u2.udm)
{
+ mio_pool_string (&n->u2.udm->mapper_id);
mio_name (n->u2.udm->multiple_elems_p, omp_map_cardinality);
mio_pointer_ref (&n->u2.udm->udm);
}
diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc
index bcb54512943f..ea4e75edd700 100644
--- a/gcc/fortran/openmp.cc
+++ b/gcc/fortran/openmp.cc
@@ -3645,6 +3645,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
break;
@@ -3719,19 +3721,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->u2.udm = gfc_get_omp_namelist_udm ();
- n->u2.udm->udm = udm;
+ n->u2.udm->mapper_id
+ = gfc_get_string ("%s", mapper_id);
}
}
continue;
@@ -10039,6 +10033,36 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses
*omp_clauses,
if (!omp_verify_map_motion_clauses (code, list, name, n,
openacc))
break;
+ 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->u2.udm ? n->u2.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->u2.udm)
+ {
+ n->u2.udm = gfc_get_omp_namelist_udm ();
+ gcc_assert (mapper_id[0] == '\0');
+ n->u2.udm->mapper_id = mapper_id;
+ }
+ n->u2.udm->udm = udm;
+ }
+ }
}
if (list != OMP_LIST_DEPEND)
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
