https://gcc.gnu.org/g:4c94d35536cb3a7cb2a30dae3b8d01370f7a4bea

commit 4c94d35536cb3a7cb2a30dae3b8d01370f7a4bea
Author: Julian Brown <jul...@codesourcery.com>
Date:   Wed Aug 9 10:49:15 2023 +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/ChangeLog.omp                          | 13 ++++++
 gcc/fortran/gfortran.h                             |  3 ++
 gcc/fortran/match.cc                               |  4 +-
 gcc/fortran/module.cc                              |  6 +++
 gcc/fortran/openmp.cc                              | 46 ++++++++++++++++------
 gcc/testsuite/ChangeLog.omp                        |  4 ++
 .../gfortran.dg/gomp/declare-mapper-31.f90         | 34 ++++++++++++++++
 libgomp/ChangeLog.omp                              |  6 +++
 .../libgomp.fortran/declare-mapper-30.f90          | 24 +++++++++++
 .../testsuite/libgomp.fortran/declare-mapper-4.f90 | 18 +++++----
 10 files changed, 139 insertions(+), 19 deletions(-)

diff --git a/gcc/fortran/ChangeLog.omp b/gcc/fortran/ChangeLog.omp
index 515a30cd557..30610d7e699 100644
--- a/gcc/fortran/ChangeLog.omp
+++ b/gcc/fortran/ChangeLog.omp
@@ -1,3 +1,16 @@
+2023-08-10  Julian Brown  <jul...@codesourcery.com>
+
+       * 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.
+
 2023-08-10  Julian Brown  <jul...@codesourcery.com>
 
        * gfortran.h (gfc_omp_clauses): Add NS field.
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 491a1498279..8289b98ca73 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1777,6 +1777,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 331a9c05f03..4e023856bf4 100644
--- a/gcc/fortran/match.cc
+++ b/gcc/fortran/match.cc
@@ -5540,7 +5540,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);
   gfc_omp_namelist *n;
diff --git a/gcc/fortran/module.cc b/gcc/fortran/module.cc
index de2077f288f..96867f889b4 100644
--- a/gcc/fortran/module.cc
+++ b/gcc/fortran/module.cc
@@ -5262,6 +5262,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);
            }
@@ -6338,6 +6343,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 574c1b2ba0c..ba7528aaefc 100644
--- a/gcc/fortran/openmp.cc
+++ b/gcc/fortran/openmp.cc
@@ -3160,6 +3160,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;
@@ -3234,19 +3236,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;
@@ -8990,6 +8984,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/ChangeLog.omp b/gcc/testsuite/ChangeLog.omp
index 49ea82ac86b..030645d70ba 100644
--- a/gcc/testsuite/ChangeLog.omp
+++ b/gcc/testsuite/ChangeLog.omp
@@ -1,3 +1,7 @@
+2023-08-10  Julian Brown  <jul...@codesourcery.com>
+
+       * gfortran.dg/gomp/declare-mapper-31.f90: New test.
+
 2023-08-10  Julian Brown  <jul...@codesourcery.com>
 
        * gfortran.dg/gomp/declare-mapper-26.f90: New test.
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/ChangeLog.omp b/libgomp/ChangeLog.omp
index 1294fe39c4c..662b4f507d3 100644
--- a/libgomp/ChangeLog.omp
+++ b/libgomp/ChangeLog.omp
@@ -1,3 +1,9 @@
+2023-08-10  Julian Brown  <jul...@codesourcery.com>
+
+       * testsuite/libgomp.fortran/declare-mapper-30.f90: New test.
+       * testsuite/libgomp.fortran/declare-mapper-4.f90: Adjust test for new
+       lookup behaviour.
+
 2023-07-12  Julian Brown  <jul...@codesourcery.com>
 
        * testsuite/libgomp.oacc-c-c++-common/implicit-mapping-1.c: Add
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

Reply via email to