[PATCH 4/5] OpenMP: Look up 'declare mapper' definitions at resolution time not parse time
Julian Brown
julian@codesourcery.com
Thu Aug 10 13:33:05 GMT 2023
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 <julian@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
More information about the Gcc-patches
mailing list