[gcc/devel/omp/gcc-16] OpenMP, Fortran: Enable 'declare mapper' mappers for 'target update' directives

https://gcc.gnu.org/g:0ae115b2c2faa7cc98132d4369b456be21eb4a71

commit 0ae115b2c2faa7cc98132d4369b456be21eb4a71
Author: Julian Brown <[email protected]>
Date:   Tue Jul 7 17:43:08 2026 +0000

    OpenMP, Fortran: Enable 'declare mapper' mappers for 'target update' directives
    
    This patch enables use of 'declare mapper' for 'target update'
    directives for Fortran.  It is based on OG15 commit 6ffe14f3198;
    the C and C++ support was previously upstreamed as commit
    r17-680-g09e74059bdb12c, so only the Fortran parts are left here.
    
    2023-08-10  Julian Brown  <[email protected]>
    
    gcc/fortran/
            * openmp.cc (gfc_match_motion_var_list): Add parsing for mapper
            modifier.
            (gfc_match_omp_clauses): Adjust error handling for changes to
            gfc_match_motion_var_list.
            (gfc_omp_instantiate_mapper): Add code argument to get proper
            location for diagnostic.
            (gfc_omp_instantiate_mappers): Adjust for above change.
            * trans-openmp.cc (gfc_trans_omp_clauses): Use correct ref for update
            operations.
            (gfc_trans_omp_target_update): Instantiate mappers.
    
    gcc/testsuite/
            * gfortran.dg/gomp/declare-mapper-24.f90: New test.
            * gfortran.dg/gomp/declare-mapper-26.f90: Uncomment 'target update'
            part of test.
            * gfortran.dg/gomp/declare-mapper-27.f90: New test.
    
    libgomp/
            * testsuite/libgomp.fortran/declare-mapper-25.f90: New test.
            * testsuite/libgomp.fortran/declare-mapper-28.f90: New test.
    
    Co-Authored-By: Andrew Stubbs  <[email protected]>
    Co-Authored-By: Kwok Cheung Yeung <[email protected]>
    Co-Authored-By: Sandra Loosemore <[email protected]>

Diff:
---
 gcc/fortran/openmp.cc                              | 67 +++++++++++++++++-----
 gcc/fortran/trans-openmp.cc                        | 30 +++++++---
 .../gfortran.dg/gomp/declare-mapper-24.f90         | 43 ++++++++++++++
 .../gfortran.dg/gomp/declare-mapper-26.f90         |  4 +-
 .../gfortran.dg/gomp/declare-mapper-27.f90         | 25 ++++++++
 .../libgomp.fortran/declare-mapper-25.f90          | 44 ++++++++++++++
 .../libgomp.fortran/declare-mapper-28.f90          | 38 ++++++++++++
 7 files changed, 225 insertions(+), 26 deletions(-)

diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc
index ccc65dda7b79..a7a67814a93b 100644
--- a/gcc/fortran/openmp.cc
+++ b/gcc/fortran/openmp.cc
@@ -1441,12 +1441,15 @@ gfc_match_motion_var_list (const char *str, gfc_omp_namelist **list,
 
   gfc_namespace *ns_iter = NULL, *ns_curr = gfc_current_ns;
   locus old_loc = gfc_current_locus;
+  int mapper_modifier = 0;
   int present_modifier = 0;
   int iterator_modifier = 0;
+  locus second_mapper_locus = old_loc;
   locus second_present_locus = old_loc;
   locus second_iterator_locus = old_loc;
   bool saw_modifier = false;
-
+  char mapper_id[GFC_MAX_SYMBOL_LEN + 1] = { '\0' };
+ 
   for (;;)
     {
       locus current_locus = gfc_current_locus;
@@ -1455,6 +1458,16 @@ gfc_match_motion_var_list (const char *str, gfc_omp_namelist **list,
 	  if (present_modifier++ == 1)
 	    second_present_locus = current_locus;
 	}
+      else if (gfc_match ("mapper ( ") == MATCH_YES)
+	{
+	  if (mapper_modifier++ == 1)
+	    second_mapper_locus = current_locus;
+	  m = gfc_match (" %n ) ", mapper_id);
+	  if (m != MATCH_YES)
+	    return m;
+	  if (strcmp (mapper_id, "default") == 0)
+	    mapper_id[0] = '\0';
+	}
       else if (gfc_match_iterator (&ns_iter, true) == MATCH_YES)
 	{
 	  if (iterator_modifier++ == 1)
@@ -1489,6 +1502,7 @@ gfc_match_motion_var_list (const char *str, gfc_omp_namelist **list,
     {
       gfc_current_locus = old_loc;
       present_modifier = 0;
+      mapper_modifier = 0;
       iterator_modifier = 0;
     }
 
@@ -1497,6 +1511,11 @@ gfc_match_motion_var_list (const char *str, gfc_omp_namelist **list,
       gfc_error ("Too many %<present%> modifiers at %L", &second_present_locus);
       return MATCH_ERROR;
     }
+  if (mapper_modifier > 1)
+    {
+      gfc_error ("too many %<mapper%> modifiers at %L", &second_mapper_locus);
+      return MATCH_ERROR;
+    }
   if (iterator_modifier > 1)
     {
       gfc_error ("Too many %<iterator%> modifiers at %L",
@@ -1516,6 +1535,11 @@ gfc_match_motion_var_list (const char *str, gfc_omp_namelist **list,
     {
       if (present_modifier)
 	n->u.present_modifier = true;
+      if (mapper_id[0] != '\0')
+	{
+	  n->u3.udm = gfc_get_omp_namelist_udm ();
+	  n->u3.udm->mapper_id = gfc_get_string ("%s", mapper_id);
+	}
       if (iterator_modifier)
 	{
 	  n->u2.ns = ns_iter;
@@ -3343,10 +3367,15 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 					      &c->lists[OMP_LIST_FIRSTPRIVATE],
 					      true) == MATCH_YES)
 	    continue;
-	  if ((mask & OMP_CLAUSE_FROM)
-	      && gfc_match_motion_var_list ("from (", &c->lists[OMP_LIST_FROM],
-					     &head) == MATCH_YES)
-	    continue;
+	  if (mask & OMP_CLAUSE_FROM)
+	    {
+	      m = gfc_match_motion_var_list ("from (", &c->lists[OMP_LIST_FROM],
+					     &head);
+	      if (m == MATCH_YES)
+		continue;
+	      else if (m == MATCH_ERROR)
+		goto error;
+	    }
 	  if ((mask & OMP_CLAUSE_FULL)
 	      && (m = gfc_match_dupl_check (!c->full, "full")) != MATCH_NO)
 	    {
@@ -4558,10 +4587,15 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 		  continue;
 		}
 	    }
-	  else if ((mask & OMP_CLAUSE_TO)
-		   && gfc_match_motion_var_list ("to (", &c->lists[OMP_LIST_TO],
-						 &head) == MATCH_YES)
-	    continue;
+	  else if (mask & OMP_CLAUSE_TO)
+	    {
+	      m = gfc_match_motion_var_list ("to (", &c->lists[OMP_LIST_TO],
+						 &head);
+	      if (m == MATCH_YES)
+		continue;
+	      else if (m == MATCH_ERROR)
+		goto error;
+	    }
 	  break;
 	case 'u':
 	  if ((mask & OMP_CLAUSE_UNIFORM)
@@ -14471,7 +14505,7 @@ gfc_subst_mapper_var (gfc_symbol **out_sym, gfc_expr **out_expr,
 }
 
 static gfc_omp_namelist **
-gfc_omp_instantiate_mapper (gfc_omp_namelist **outlistp,
+gfc_omp_instantiate_mapper (gfc_code *code, gfc_omp_namelist **outlistp,
 			    gfc_omp_namelist *clause,
 			    gfc_omp_map_op outer_map_op, gfc_omp_udm *udm,
 			    toc_directive cd, int list)
@@ -14577,8 +14611,10 @@ gfc_omp_instantiate_mapper (gfc_omp_namelist **outlistp,
 		  = omp_split_map_op (map_clause_op, &force_p, &always_p,
 				      &present_p);
 		free (new_clause);
-		gfc_warning (0, "Dropping incompatible %qs mapper clause at %C",
-			     omp_basic_map_kind_name (basic_kind));
+		gfc_warning (OPT_Wopenmp,
+			     "Dropping incompatible %qs mapper clause at %L",
+			     omp_basic_map_kind_name (basic_kind),
+			     &code->loc);
 		inform (gfc_get_location (&mapper_clause->where),
 			"Defined here");
 		continue;
@@ -14594,7 +14630,7 @@ gfc_omp_instantiate_mapper (gfc_omp_namelist **outlistp,
 	  && mapper_clause->u3.udm->udm != udm)
 	{
 	  gfc_omp_udm *inner_udm = mapper_clause->u3.udm->udm;
-	  outlistp = gfc_omp_instantiate_mapper (outlistp, new_clause,
+	  outlistp = gfc_omp_instantiate_mapper (code, outlistp, new_clause,
 						 outer_map_op, inner_udm, cd,
 						 list);
 	}
@@ -14612,7 +14648,7 @@ gfc_omp_instantiate_mapper (gfc_omp_namelist **outlistp,
    false if errors were diagnosed.  This function is invoked from the
    translation phase so callers need to handle passing up the error.  */
 bool
-gfc_omp_instantiate_mappers (gfc_code *code ATTRIBUTE_UNUSED, gfc_omp_clauses *clauses,
+gfc_omp_instantiate_mappers (gfc_code *code, gfc_omp_clauses *clauses,
 			     toc_directive cd, int list)
 {
   gfc_omp_namelist *clause = clauses->lists[list];
@@ -14643,7 +14679,8 @@ gfc_omp_instantiate_mappers (gfc_code *code ATTRIBUTE_UNUSED, gfc_omp_clauses *c
 	    default:
 	      gcc_unreachable ();
 	    }
-	  clausep = gfc_omp_instantiate_mapper (clausep, clause, outer_map_op,
+	  clausep = gfc_omp_instantiate_mapper (code, clausep, clause,
+						outer_map_op,
 						clause->u3.udm->udm, cd, list);
 	  *clausep = clause->next;
 	  invoked_mappers = true;
diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc
index c517a22e0415..3549d2737379 100644
--- a/gcc/fortran/trans-openmp.cc
+++ b/gcc/fortran/trans-openmp.cc
@@ -6059,14 +6059,17 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 		  gcc_unreachable ();
 		}
 
+	      gfc_ref *lastref = NULL;
+	      if (n->expr)
+		for (gfc_ref *ref = n->expr->ref; ref; ref = ref->next)
+		  if (ref->type == REF_COMPONENT || ref->type == REF_ARRAY)
+		    lastref = ref;
+
 	      /* FIXME: Currently no support for strided target updates with
 		 iterators.  */
 	      if ((list == OMP_LIST_TO || list == OMP_LIST_FROM)
 		  && !iterator
-		  && (!n->expr
-		       || (n->expr
-			   && n->expr->ref
-			   && n->expr->ref->type == REF_ARRAY))
+		  && (!n->expr || (lastref && lastref->type == REF_ARRAY))
 		  && !gfc_omp_contiguous_update_p (n))
 		{
 		  int ndims;
@@ -6088,7 +6091,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 			 or other data between elements, e.g. of a derived-type
 			 array).  */
 		      span = gfc_get_array_span (desc, n->expr);
-		      ndims = n->expr->ref->u.ar.dimen;
+		      ndims = lastref->u.ar.dimen;
 		    }
 		  else
 		    {
@@ -10624,10 +10627,19 @@ gfc_trans_omp_target_update (gfc_code *code)
   tree stmt, omp_clauses;
 
   gfc_start_block (&block);
-  omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses,
-				       code->loc);
-  stmt = build1_loc (input_location, OMP_TARGET_UPDATE, void_type_node,
-		     omp_clauses);
+  gfc_omp_clauses *target_update_clauses = code->ext.omp_clauses;
+  if (gfc_omp_instantiate_mappers (code, target_update_clauses, TOC_OPENMP,
+				   OMP_LIST_TO)
+      && gfc_omp_instantiate_mappers (code, target_update_clauses, TOC_OPENMP,
+				      OMP_LIST_FROM))
+    {
+      omp_clauses = gfc_trans_omp_clauses (&block, target_update_clauses,
+					   code->loc);
+      stmt = build1_loc (input_location, OMP_TARGET_UPDATE, void_type_node,
+			 omp_clauses);
+    }
+  else
+    stmt = error_mark_node;
   gfc_add_expr_to_block (&block, stmt);
   return gfc_finish_block (&block);
 }
diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-mapper-24.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-24.f90
new file mode 100644
index 000000000000..9555a94badab
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-24.f90
@@ -0,0 +1,43 @@
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-original" }
+
+type t
+integer :: a, b, c, d
+end type t
+
+type(t) :: tvar
+
+!$omp declare mapper (T :: t) map(alloc: t%a) map(to: t%b) map(from: t%c) &
+!$omp & map(tofrom: t%d)
+
+!$omp declare mapper (updatey: T :: t) map(t%a) map(t%b) map(t%c) map(t%d)
+
+!$omp target update to(tvar)
+! { dg-warning "Dropping incompatible .ALLOC. mapper clause" "" { target *-*-* } .-1 }
+! { dg-warning "Dropping incompatible .FROM. mapper clause" "" { target *-*-* } .-2 }
+! { dg-final { scan-tree-dump-times {(?n)update to\(tvar\.b \[len: [0-9]+\]\) to\(tvar\.d \[len: [0-9]+\]\)$} 1 "original" } }
+!$omp target update from(tvar)
+! { dg-warning "Dropping incompatible .ALLOC. mapper clause" "" { target *-*-* } .-1 }
+! { dg-warning "Dropping incompatible .TO. mapper clause" "" { target *-*-* } .-2 }
+! { dg-final { scan-tree-dump-times {(?n)update from\(tvar\.c \[len: [0-9]+\]\) from\(tvar\.d \[len: [0-9]+\]\)$} 1 "original" } }
+
+!$omp target update to(present: tvar)
+! { dg-warning "Dropping incompatible .ALLOC. mapper clause" "" { target *-*-* } .-1 }
+! { dg-warning "Dropping incompatible .FROM. mapper clause" "" { target *-*-* } .-2 }
+! { dg-final { scan-tree-dump-times {(?n)update to\(present:tvar\.b \[len: [0-9]+\]\) to\(present:tvar\.d \[len: [0-9]+\]\)$} 1 "original" } }
+!$omp target update from(present: tvar)
+! { dg-warning "Dropping incompatible .ALLOC. mapper clause" "" { target *-*-* } .-1 }
+! { dg-warning "Dropping incompatible .TO. mapper clause" "" { target *-*-* } .-2 }
+! { dg-final { scan-tree-dump-times {(?n)update from\(present:tvar\.c \[len: [0-9]+\]\) from\(present:tvar\.d \[len: [0-9]+\]\)$} 1 "original" } }
+
+!$omp target update to(mapper(updatey): tvar)
+! { dg-final { scan-tree-dump-times {(?n)update to\(tvar\.a \[len: [0-9]+\]\) to\(tvar\.b \[len: [0-9]+\]\) to\(tvar\.c \[len: [0-9]+\]\) to\(tvar\.d \[len: [0-9]+\]\)$} 1 "original" } }
+!$omp target update from(mapper(updatey): tvar)
+! { dg-final { scan-tree-dump-times {(?n)update from\(tvar\.a \[len: [0-9]+\]\) from\(tvar\.b \[len: [0-9]+\]\) from\(tvar\.c \[len: [0-9]+\]\) from\(tvar\.d \[len: [0-9]+\]\)$} 1 "original" } }
+
+!$omp target update to(present, mapper(updatey): tvar)
+! { dg-final { scan-tree-dump-times {(?n)update to\(present:tvar\.a \[len: [0-9]+\]\) to\(present:tvar\.b \[len: [0-9]+\]\) to\(present:tvar\.c \[len: [0-9]+\]\) to\(present:tvar\.d \[len: [0-9]+\]\)$} 1 "original" } }
+!$omp target update from(present, mapper(updatey): tvar)
+! { dg-final { scan-tree-dump-times {(?n)update from\(present:tvar\.a \[len: [0-9]+\]\) from\(present:tvar\.b \[len: [0-9]+\]\) from\(present:tvar\.c \[len: [0-9]+\]\) from\(present:tvar\.d \[len: [0-9]+\]\)$} 1 "original" } }
+
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-mapper-26.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-26.f90
index c408b37f5a97..16afb51f48a5 100644
--- a/gcc/testsuite/gfortran.dg/gomp/declare-mapper-26.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-26.f90
@@ -18,8 +18,8 @@ var%arr = 0
 
 var%arr = 1
 
-! But this is fine.  (Re-enabled by later patch.)
-!!$omp target update to(mapper(even): var)
+! But this is fine.
+!$omp target update to(mapper(even): var)
 
 ! As 'enter data'.
 !$omp target exit data map(mapper(even), delete: var)
diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-mapper-27.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-27.f90
new file mode 100644
index 000000000000..6b3a181acaa5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-27.f90
@@ -0,0 +1,25 @@
+! { dg-do compile }
+
+type t
+integer :: x
+end type t
+
+type(t) :: var
+
+! Error on attempt to use missing named mapper.
+!$omp target update to(mapper(boo): var)
+! { dg-error {User-defined mapper .boo. not found} "" { target *-*-* } .-1 }
+
+var%x = 0
+
+!$omp target map(mapper(boo), tofrom: var)
+! { dg-error {User-defined mapper .boo. not found} "" { target *-*-* } .-1 }
+var%x = 5
+!$omp end target
+
+! These should be fine though...
+!$omp target enter data map(mapper(default), to: var)
+
+!$omp target exit data map(from: var)
+
+end
diff --git a/libgomp/testsuite/libgomp.fortran/declare-mapper-25.f90 b/libgomp/testsuite/libgomp.fortran/declare-mapper-25.f90
new file mode 100644
index 000000000000..dc1f5272a261
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/declare-mapper-25.f90
@@ -0,0 +1,44 @@
+! { dg-do run }
+! { dg-require-effective-target offload_device_nonshared_as }
+
+type t
+integer, allocatable :: arr(:)
+end type t
+
+!$omp declare mapper(odd: T :: tv) map(tv%arr(1::2))
+!$omp declare mapper(even: T :: tv) map(tv%arr(2::2))
+
+type(t) :: var
+integer :: i
+
+allocate(var%arr(100))
+
+var%arr = 0
+
+!$omp target enter data map(to: var)
+
+var%arr = 1
+
+!$omp target update to(mapper(odd): var)
+
+!$omp target
+do i=1,100
+  if (mod(i,2).eq.0.and.var%arr(i).ne.0) stop 1
+  if (mod(i,2).eq.1.and.var%arr(i).ne.1) stop 2
+end do
+!$omp end target
+
+var%arr = 2
+
+!$omp target update to(mapper(even): var)
+
+!$omp target
+do i=1,100
+  if (mod(i,2).eq.0.and.var%arr(i).ne.2) stop 3
+  if (mod(i,2).eq.1.and.var%arr(i).ne.1) stop 4
+end do
+!$omp end target
+
+!$omp target exit data map(delete: var)
+
+end
diff --git a/libgomp/testsuite/libgomp.fortran/declare-mapper-28.f90 b/libgomp/testsuite/libgomp.fortran/declare-mapper-28.f90
new file mode 100644
index 000000000000..6561decc49a9
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/declare-mapper-28.f90
@@ -0,0 +1,38 @@
+! { dg-do run }
+
+program p
+
+type t
+integer :: x, y
+end type t
+
+type(t) :: var
+
+var%x = 0
+var%y = 0
+
+var = sub(7)
+
+contains
+
+type(t) function sub(arg)
+integer :: arg
+
+!$omp declare mapper (t :: tvar) map(tvar%x, tvar%y)
+
+!$omp target enter data map(alloc: sub)
+
+sub%x = 5
+sub%y = arg
+
+!$omp target update to(sub)
+
+!$omp target
+if (sub%x.ne.5) stop 1
+if (sub%y.ne.7) stop 2
+!$omp end target
+
+!$omp target exit data map(release: sub)
+
+end function sub
+end program p