diff mbox series

[4/5] OpenMP: Look up 'declare mapper' definitions at resolution time not parse time

Message ID d90c4df5a82eab4313b75f5e702f7bd0a613c304.1691672603.git.julian@codesourcery.com
State New
Headers show
Series OpenMP: Implement 'declare mapper' for 'target update' directives | expand

Commit Message

Julian Brown Aug. 10, 2023, 1:33 p.m. UTC 
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 mbox series

Patch

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