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.
---
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 ++++++++++
.../libgomp.fortran/declare-mapper-4.f90 | 18 +++++---
7 files changed, 116 insertions(+), 19 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/gomp/declare-mapper-31.f90
create mode 100644 libgomp/testsuite/libgomp.fortran/declare-mapper-30.f90
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index a98424b3263..3b854e14d47 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1784,6 +1784,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 53367ab2a0b..3db8e0f0969 100644
--- a/gcc/fortran/match.cc
+++ b/gcc/fortran/match.cc
@@ -5537,7 +5537,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 = (list == OMP_LIST_ALLOCATE);
gfc_omp_namelist *n;
diff --git a/gcc/fortran/module.cc b/gcc/fortran/module.cc
index 5cd52e7729b..acdbfa7924f 100644
--- a/gcc/fortran/module.cc
+++ b/gcc/fortran/module.cc
@@ -5238,6 +5238,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);
}
@@ -6314,6 +6319,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 0109df4dfce..ba2a8221b96 100644
--- a/gcc/fortran/openmp.cc
+++ b/gcc/fortran/openmp.cc
@@ -3615,6 +3615,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;
@@ -3689,19 +3691,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;
@@ -9155,6 +9149,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 00000000000..bcb0a6c5429
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-31.f90
@@ -0,0 +1,34 @@
+! { dg-do run }
+
+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 00000000000..bfac28cd45c
--- /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 e95dbbd6f96..266845f35c7 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
--
2.25.1
