[gcc/devel/omp/gcc-16] openmp, fortran: Add support for non-constant iterator bounds in Fortran deep-mapping iterator suppo

https://gcc.gnu.org/g:9973c07c58e97f017ddee756b8520cdf248af2a1

commit 9973c07c58e97f017ddee756b8520cdf248af2a1
Author: Kwok Cheung Yeung <[email protected]>
Date:   Sun May 24 17:25:41 2026 +0000

    openmp, fortran: Add support for non-constant iterator bounds in Fortran deep-mapping iterator support
    
    gcc/fortran/
    
            * trans-openmp.cc (gfc_omp_deep_mapping_map): Add new argument for
            vector of newly created iterators.  Push new iterators onto the
            vector.
            (gfc_omp_deep_mapping_comps): Add new argument for vector of new
            iterators.  Pass argument in calls to gfc_omp_deep_mapping_item and
            gfc_omp_deep_mapping_comps.
            (gfc_omp_deep_mapping_item): Add new argument for vector of new
            iterators.  Pass argument in calls to gfc_omp_deep_mapping_map and
            gfc_omp_deep_mapping_comps.
            (gfc_omp_deep_mapping_do): Add new argument for vector of new
            iterators.  Pass argument in calls to gfc_omp_deep_mapping_item.
            (gfc_omp_deep_mapping_cnt): Pass NULL to new argument for
            gfc_omp_deep_mapping_do.
            (gfc_omp_deep_mapping): Add new argument for vector of new
            iterators.  Pass argument in calls to gfc_omp_deep_mapping_do.
            * trans.h (gfc_omp_deep_mapping): Add new argument.
    
    gcc/
    
            * langhooks-def.h (lhd_omp_deep_mapping): Add new argument.
            * langhooks.cc (lhd_omp_deep_mapping): Likewise.
            * langhooks.h (omp_deep_mapping): Likewise.
            * omp-low.cc (allocate_omp_iterator_elems): Work on the supplied
            iterator set instead of the iterators in a supplied set of clauses.
            (free_omp_iterator_elems): Likewise.
            (lower_omp_target): Maintain vector of new iterators generated by
            deep-mapping.  Allocate and free iterator element arrays using
            iterators found in clauses and in the new iterator vector.
    
    libgomp/
    
            * testsuite/libgomp.fortran/allocatable-comp-iterators.f90: Add test
            for non-const iterator boundaries.

Diff:
---
 gcc/fortran/trans-openmp.cc                        |  38 +++++---
 gcc/fortran/trans.h                                |   3 +-
 gcc/langhooks-def.h                                |   3 +-
 gcc/langhooks.cc                                   |   2 +-
 gcc/langhooks.h                                    |   3 +-
 gcc/omp-low.cc                                     | 103 ++++++++++-----------
 .../libgomp.fortran/allocatable-comp-iterators.f90 |   3 +-
 7 files changed, 83 insertions(+), 72 deletions(-)

diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc
index 9ec06e99082a..7258d29455eb 100644
--- a/gcc/fortran/trans-openmp.cc
+++ b/gcc/fortran/trans-openmp.cc
@@ -1940,7 +1940,8 @@ gfc_omp_deep_mapping_map (tree data, tree size, unsigned HOST_WIDE_INT tkind,
 			  location_t loc, tree data_array, tree sizes_array,
 			  tree kinds_array, tree offset_data, tree offset,
 			  gimple_seq *seq, gimple *ctx,
-			  tree iterators, gimple_seq loops_pre_seq)
+			  tree iterators, gimple_seq loops_pre_seq,
+			  vec<tree> *new_iterators)
 {
   tree one = build_int_cst (size_type_node, 1);
 
@@ -1966,6 +1967,7 @@ gfc_omp_deep_mapping_map (tree data, tree size, unsigned HOST_WIDE_INT tkind,
   if (iterators)
     {
       data_iter = add_new_omp_iterators_entry (iterators, loops_seq_p);
+      new_iterators->safe_push (data_iter);
       assign_to_iterator_elems_array (data_expr, data_iter, ctx, false);
       data_expr = OMP_ITERATOR_ELEMS (data_iter);
       if (TREE_CODE (TREE_TYPE (data_expr)) == ARRAY_TYPE)
@@ -1986,6 +1988,7 @@ gfc_omp_deep_mapping_map (tree data, tree size, unsigned HOST_WIDE_INT tkind,
   if (iterators)
     {
       data_addr_iter = add_new_omp_iterators_entry (iterators, loops_seq_p);
+      new_iterators->safe_push (data_addr_iter);
       assign_to_iterator_elems_array (data_addr_expr, data_addr_iter, ctx,
 				      false);
       data_addr_expr = OMP_ITERATOR_ELEMS (data_addr_iter);
@@ -2077,7 +2080,7 @@ static void gfc_omp_deep_mapping_item (bool, bool, bool, location_t, tree,
 				       tree *, unsigned HOST_WIDE_INT, tree,
 				       tree, tree, tree, tree, tree,
 				       gimple_seq *, gimple *, bool *,
-				       tree);
+				       tree, vec <tree> *);
 
 /* Map allocatable components.  */
 static void
@@ -2086,7 +2089,8 @@ gfc_omp_deep_mapping_comps (bool is_cnt, location_t loc, tree decl,
 			    tree data_array, tree sizes_array, tree kinds_array,
 			    tree offset_data, tree offset, tree num,
 			    gimple_seq *seq, gimple *ctx,
-			    bool *poly_warned, tree iterators)
+			    bool *poly_warned, tree iterators,
+			    vec <tree> *new_iterators)
 {
   tree type = TREE_TYPE (decl);
   if (TREE_CODE (type) != RECORD_TYPE)
@@ -2104,7 +2108,8 @@ gfc_omp_deep_mapping_comps (bool is_cnt, location_t loc, tree decl,
 	  gfc_omp_deep_mapping_item (is_cnt, true, true, loc, tmp, token,
 				     tkind, data_array, sizes_array,
 				     kinds_array, offset_data, offset, num,
-				     seq, ctx, poly_warned, iterators);
+				     seq, ctx, poly_warned, iterators,
+				     new_iterators);
 	}
       else if (GFC_DECL_GET_SCALAR_POINTER (field)
 	       || GFC_DESCRIPTOR_TYPE_P (type))
@@ -2117,12 +2122,13 @@ gfc_omp_deep_mapping_comps (bool is_cnt, location_t loc, tree decl,
 	    gfc_omp_deep_mapping_item (is_cnt, false, false, loc, tmp,
 				       token, tkind, data_array, sizes_array,
 				       kinds_array, offset_data, offset, num,
-				       seq, ctx, poly_warned, iterators);
+				       seq, ctx, poly_warned, iterators,
+				       new_iterators);
 	  else
 	    gfc_omp_deep_mapping_comps (is_cnt, loc, tmp, token, tkind,
 					data_array, sizes_array, kinds_array,
 					offset_data, offset, num, seq, ctx,
-					poly_warned, iterators);
+					poly_warned, iterators, new_iterators);
 	}
     }
 }
@@ -2266,7 +2272,7 @@ gfc_omp_deep_mapping_item (bool is_cnt, bool do_copy, bool do_alloc_check,
 			   tree sizes_array, tree kinds_array, tree offset_data,
 			   tree offset, tree num, gimple_seq *seq,
 			   gimple *ctx, bool *poly_warned,
-			   tree iterators)
+			   tree iterators, vec<tree> *new_iterators)
 {
   tree tmp;
   tree type = TREE_TYPE (decl);
@@ -2373,7 +2379,8 @@ gfc_omp_deep_mapping_item (bool is_cnt, bool do_copy, bool do_alloc_check,
 
       gfc_omp_deep_mapping_map (tmp, bytesize, tkind2, loc, data_array,
 				sizes_array, kinds_array, offset_data,
-				offset, seq, ctx, iterators, loops_pre_seq);
+				offset, seq, ctx, iterators, loops_pre_seq,
+				new_iterators);
     }
 
   tmp = decl;
@@ -2413,7 +2420,7 @@ gfc_omp_deep_mapping_item (bool is_cnt, bool do_copy, bool do_alloc_check,
       gfc_omp_deep_mapping_comps (is_cnt, loc, decl, token, tkind,
 				  data_array, sizes_array, kinds_array,
 				  offset_data, offset, num, seq, ctx,
-				  poly_warned, iterators);
+				  poly_warned, iterators, new_iterators);
       gimple_seq_add_seq (seq, seq2);
     }
   if (end_label)
@@ -2564,7 +2571,7 @@ static tree
 gfc_omp_deep_mapping_do (bool is_cnt, gimple *ctx, tree clause,
 			 unsigned HOST_WIDE_INT tkind, tree data, tree sizes,
 			 tree kinds, tree offset_data, tree offset,
-			 gimple_seq *seq)
+			 gimple_seq *seq, vec<tree> *new_iterators)
 {
   tree num = NULL_TREE;
   location_t loc = OMP_CLAUSE_LOCATION (clause);
@@ -2680,14 +2687,15 @@ gfc_omp_deep_mapping_do (bool is_cnt, gimple *ctx, tree clause,
 				 &token, tkind, data, sizes, kinds,
 				 offset_data, offset, num, seq, ctx,
 				 &poly_warned,
-				 OMP_CLAUSE_ITERATORS (clause));
+				 OMP_CLAUSE_ITERATORS (clause),
+				 new_iterators);
       gimple_seq_add_stmt (seq, gimple_build_label (end_label));
     }
   else
     gfc_omp_deep_mapping_item (is_cnt, do_copy, do_alloc_check, loc, decl,
 			       &token, tkind, data, sizes, kinds, offset_data,
 			       offset, num, seq, ctx, &poly_warned,
-			       OMP_CLAUSE_ITERATORS (clause));
+			       OMP_CLAUSE_ITERATORS (clause), new_iterators);
   /* Multiply by 2 as there are two mappings: data + pointer assign.  */
   if (is_cnt)
     gimplify_assign (num,
@@ -2709,7 +2717,7 @@ tree
 gfc_omp_deep_mapping_cnt (gimple *ctx, tree clause, gimple_seq *seq)
 {
   return gfc_omp_deep_mapping_do (true, ctx, clause, 0, NULL_TREE, NULL_TREE,
-				  NULL_TREE, NULL_TREE, NULL_TREE, seq);
+				  NULL_TREE, NULL_TREE, NULL_TREE, seq, NULL);
 }
 
 /* Handle the deep mapping for the passed map CLAUSE that is part of
@@ -2726,10 +2734,10 @@ void
 gfc_omp_deep_mapping (gimple *ctx, tree clause,
 		      unsigned HOST_WIDE_INT tkind, tree data,
 		      tree sizes, tree kinds, tree offset_data, tree offset,
-		      gimple_seq *seq)
+		      gimple_seq *seq, vec<tree> *new_iterators)
 {
   (void) gfc_omp_deep_mapping_do (false, ctx, clause, tkind, data, sizes, kinds,
-				  offset_data, offset, seq);
+				  offset_data, offset, seq, new_iterators);
 }
 
 /* Return true if DECL is a scalar variable (for the purpose of
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 58b03d6c6fa4..a25e4a469236 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -842,7 +842,8 @@ void gfc_omp_finish_clause (tree, gimple_seq *, bool);
 bool gfc_omp_deep_mapping_p (const gimple *, tree);
 tree gfc_omp_deep_mapping_cnt (gimple *, tree, gimple_seq *);
 void gfc_omp_deep_mapping (gimple *, tree, unsigned HOST_WIDE_INT, tree,
-			   tree, tree, tree, tree, gimple_seq *);
+			   tree, tree, tree, tree, gimple_seq *,
+			   vec<tree> *);
 bool gfc_omp_allocatable_p (tree);
 bool gfc_omp_scalar_p (tree, bool);
 bool gfc_omp_scalar_target_p (tree);
diff --git a/gcc/langhooks-def.h b/gcc/langhooks-def.h
index 01bfab5011cb..af0913281c12 100644
--- a/gcc/langhooks-def.h
+++ b/gcc/langhooks-def.h
@@ -89,7 +89,8 @@ extern tree lhd_omp_array_size (tree, gimple_seq *);
 extern bool lhd_omp_deep_mapping_p (const gimple *, tree);
 extern tree lhd_omp_deep_mapping_cnt (gimple *, tree, gimple_seq *);
 extern void lhd_omp_deep_mapping (gimple *, tree, unsigned HOST_WIDE_INT,
-				  tree, tree, tree, tree, tree, gimple_seq *);
+				  tree, tree, tree, tree, tree, gimple_seq *,
+				  vec<tree> *);
 extern tree lhd_omp_mapper_lookup (tree, tree);
 extern tree lhd_omp_extract_mapper_directive (tree);
 extern tree lhd_omp_map_array_section (location_t, tree);
diff --git a/gcc/langhooks.cc b/gcc/langhooks.cc
index 87600af5fec8..c1e92fe3d5cc 100644
--- a/gcc/langhooks.cc
+++ b/gcc/langhooks.cc
@@ -669,7 +669,7 @@ lhd_omp_deep_mapping_cnt (gimple *, tree, gimple_seq *)
 
 void
 lhd_omp_deep_mapping (gimple *, tree, unsigned HOST_WIDE_INT, tree, tree,
-		      tree, tree, tree, gimple_seq *)
+		      tree, tree, tree, gimple_seq *, vec<tree> *)
 {
 }
 
diff --git a/gcc/langhooks.h b/gcc/langhooks.h
index 2ef8955b782b..5b7de98adf68 100644
--- a/gcc/langhooks.h
+++ b/gcc/langhooks.h
@@ -343,7 +343,8 @@ struct lang_hooks_for_decls
   void (*omp_deep_mapping) (gimple *ctx_stmt, tree clause,
 			    unsigned HOST_WIDE_INT tkind,
 			    tree data, tree sizes, tree kinds,
-			    tree offset_data, tree offset, gimple_seq *seq);
+			    tree offset_data, tree offset, gimple_seq *seq,
+			    vec<tree> *);
 
   /* Finish language-specific processing on mapping nodes after expanding
      user-defined mappers.  */
diff --git a/gcc/omp-low.cc b/gcc/omp-low.cc
index deb6f28356e7..55820cc85d75 100644
--- a/gcc/omp-low.cc
+++ b/gcc/omp-low.cc
@@ -12796,60 +12796,46 @@ lower_omp_map_iterator_size (tree size, tree c, gomp_target *stmt)
 }
 
 static void
-allocate_omp_iterator_elems (tree clauses, gimple_seq loops_seq)
+allocate_omp_iterator_elems (tree iters, gimple_seq loops_seq)
 {
-  for (tree c = clauses; c ; c = OMP_CLAUSE_CHAIN (c))
-    {
-      if (!OMP_CLAUSE_HAS_ITERATORS (c))
-	continue;
-      tree iters = OMP_CLAUSE_ITERATORS (c);
-      tree elems = OMP_ITERATOR_ELEMS (iters);
-      if (!POINTER_TYPE_P (TREE_TYPE (elems)))
-	continue;
-      tree arr_length
-	= omp_iterator_elems_length (OMP_ITERATOR_COUNT (iters));
-      tree call = builtin_decl_explicit (BUILT_IN_MALLOC);
-      tree size = fold_build2_loc (OMP_CLAUSE_LOCATION (c), MULT_EXPR,
-				   size_type_node, arr_length,
-				   TYPE_SIZE_UNIT (ptr_type_node));
-      tree tmp = build_call_expr_loc (OMP_CLAUSE_LOCATION (c), call, 1,
-				      size);
-
-      /* Find the first statement '<index> = -1' in the pre-loop statements.  */
-      tree index = OMP_ITERATOR_INDEX (iters);
-      gimple_stmt_iterator gsi;
-      for (gsi = gsi_start (loops_seq); !gsi_end_p (gsi); gsi_next (&gsi))
-	{
-	  gimple *stmt = gsi_stmt (gsi);
-	  if (gimple_code (stmt) == GIMPLE_ASSIGN
-	      && gimple_assign_lhs (stmt) == index
-	      && gimple_assign_rhs1 (stmt) == size_int (-1))
-	    break;
-	}
-      gcc_assert (!gsi_end_p (gsi));
+  tree elems = OMP_ITERATOR_ELEMS (iters);
+  if (!POINTER_TYPE_P (TREE_TYPE (elems)))
+    return;
+  tree arr_length = omp_iterator_elems_length (OMP_ITERATOR_COUNT (iters));
+  tree call = builtin_decl_explicit (BUILT_IN_MALLOC);
+  tree size = fold_build2 (MULT_EXPR, size_type_node, arr_length,
+			   TYPE_SIZE_UNIT (ptr_type_node));
+  tree tmp = build_call_expr (call, 1, size);
+
+  /* Find the first statement '<index> = -1' in the pre-loop statements.  */
+  tree index = OMP_ITERATOR_INDEX (iters);
+  gimple_stmt_iterator gsi;
+  for (gsi = gsi_start (loops_seq); !gsi_end_p (gsi); gsi_next (&gsi))
+  {
+    gimple *stmt = gsi_stmt (gsi);
+    if (gimple_code (stmt) == GIMPLE_ASSIGN
+	&& gimple_assign_lhs (stmt) == index
+	&& gimple_assign_rhs1 (stmt) == size_int (-1))
+      break;
+  }
+  gcc_assert (!gsi_end_p (gsi));
 
-      gimple_seq alloc_seq = NULL;
-      gimplify_assign (elems, tmp, &alloc_seq);
-      gsi_insert_seq_before (&gsi, alloc_seq, GSI_SAME_STMT);
-    }
+  gimple_seq alloc_seq = NULL;
+  gimplify_assign (elems, tmp, &alloc_seq);
+  gsi_insert_seq_before (&gsi, alloc_seq, GSI_SAME_STMT);
 }
 
 static void
-free_omp_iterator_elems (tree clauses, gimple_seq *seq)
+free_omp_iterator_elems (tree iters, gimple_seq *seq)
 {
-  for (tree c = clauses; c ; c = OMP_CLAUSE_CHAIN (c))
-    {
-      if (!OMP_CLAUSE_HAS_ITERATORS (c))
-	continue;
-      tree elems = OMP_ITERATOR_ELEMS (OMP_CLAUSE_ITERATORS (c));
-      if (!POINTER_TYPE_P (TREE_TYPE (elems)))
-	continue;
-      tree call = builtin_decl_explicit (BUILT_IN_FREE);
-      call = build_call_expr_loc (OMP_CLAUSE_LOCATION (c), call, 1, elems);
-      gimplify_and_add (call, seq);
-      tree clobber = build_clobber (TREE_TYPE (elems));
-      gimple_seq_add_stmt (seq, gimple_build_assign (elems, clobber));
-    }
+  tree elems = OMP_ITERATOR_ELEMS (iters);
+  if (!POINTER_TYPE_P (TREE_TYPE (elems)))
+    return;
+  tree call = builtin_decl_explicit (BUILT_IN_FREE);
+  call = build_call_expr (call, 1, elems);
+  gimplify_and_add (call, seq);
+  tree clobber = build_clobber (TREE_TYPE (elems));
+  gimple_seq_add_stmt (seq, gimple_build_assign (elems, clobber));
 }
 
 /* Lower the GIMPLE_OMP_TARGET in the current statement
@@ -13333,6 +13319,8 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx)
       record_vars_into (gimple_bind_vars (tgt_bind), child_fn);
     }
 
+  auto_vec<tree> new_iterators;
+
   if (ctx->record_type)
     {
       if (deep_map_cnt && TREE_CODE (deep_map_cnt) == INTEGER_CST)
@@ -13479,7 +13467,8 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx)
 						   TREE_VEC_ELT (t, 1),
 						   TREE_VEC_ELT (t, 2),
 						   deep_map_offset_data,
-						   deep_map_offset, &ilist);
+						   deep_map_offset, &ilist,
+						   &new_iterators);
 	      }
 	    if (!DECL_P (ovar))
 	      {
@@ -14785,12 +14774,22 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx)
       gimple_omp_set_body (stmt, new_body);
     }
 
-  allocate_omp_iterator_elems (clauses,
-			       gimple_omp_target_iterator_loops (stmt));
+  for (c = clauses; c ; c = OMP_CLAUSE_CHAIN (c))
+    if (OMP_CLAUSE_HAS_ITERATORS (c))
+      allocate_omp_iterator_elems (OMP_CLAUSE_ITERATORS (c),
+				   gimple_omp_target_iterator_loops (stmt));
+  unsigned i;
+  tree it;
+  FOR_EACH_VEC_ELT (new_iterators, i, it)
+    allocate_omp_iterator_elems (it, gimple_omp_target_iterator_loops (stmt));
   gsi_insert_seq_before (gsi_p, gimple_omp_target_iterator_loops (stmt),
 			 GSI_SAME_STMT);
   gimple_omp_target_set_iterator_loops (stmt, NULL);
-  free_omp_iterator_elems (clauses, &olist);
+  for (c = clauses; c ; c = OMP_CLAUSE_CHAIN (c))
+    if (OMP_CLAUSE_HAS_ITERATORS (c))
+      free_omp_iterator_elems (OMP_CLAUSE_ITERATORS (c), &olist);
+  FOR_EACH_VEC_ELT (new_iterators, i, it)
+    free_omp_iterator_elems (it, &olist);
 
   bind = gimple_build_bind (NULL, NULL,
 			    tgt_bind ? gimple_bind_block (tgt_bind)
diff --git a/libgomp/testsuite/libgomp.fortran/allocatable-comp-iterators.f90 b/libgomp/testsuite/libgomp.fortran/allocatable-comp-iterators.f90
index 483ab0c335b8..120236ac3dea 100644
--- a/libgomp/testsuite/libgomp.fortran/allocatable-comp-iterators.f90
+++ b/libgomp/testsuite/libgomp.fortran/allocatable-comp-iterators.f90
@@ -5,6 +5,7 @@ type t
 end type t
 type(t) :: x(N), y(N), z(N)
 integer :: i, j
+integer :: lo = 3, hi = N
 
 !$omp target map(iterator (it=1:N), to: x(it))
   do i = 1, N
@@ -50,7 +51,7 @@ end do
   end do
 !$omp end target
 
-!$omp target map(iterator (it=3:N), always, tofrom: z(it))
+!$omp target map(iterator (it=lo:hi), always, tofrom: z(it))
   do i = 3, N
     if (.not.allocated(z(i)%b)) stop 12
     if (any (z(i)%b /= 99)) stop 13