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.

6 files changed, 81 insertions, 71 deletions

diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc
index 4b97a71..debca53 100644
--- a/gcc/fortran/trans-openmp.cc
+++ b/gcc/fortran/trans-openmp.cc
@@ -1880,7 +1880,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);
 
@@ -1907,6 +1908,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, target_stmt);
       data_expr = OMP_ITERATORS_ELEMS (data_iter);
       if (TREE_CODE (TREE_TYPE (data_expr)) == ARRAY_TYPE)
@@ -1927,6 +1929,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,
 				      target_stmt);
       data_addr_expr = OMP_ITERATORS_ELEMS (data_addr_iter);
@@ -2018,7 +2021,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
@@ -2027,7 +2030,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)
@@ -2045,7 +2049,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))
@@ -2058,12 +2063,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);
 	}
     }
 }
@@ -2207,7 +2213,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);
@@ -2314,7 +2320,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;
@@ -2354,7 +2361,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)
@@ -2506,7 +2513,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);
@@ -2602,14 +2609,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,
@@ -2625,7 +2633,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);
 }
 
 /* Does the actual deep mapping. */
@@ -2633,10 +2641,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 b9f89f3..f327e01 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -845,7 +845,8 @@ tree gfc_omp_map_array_section (location_t, tree);
 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 642eba8..c80a8ee 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_finish_mapper_clauses (tree);
 extern tree lhd_omp_mapper_lookup (tree, tree);
 extern tree lhd_omp_extract_mapper_directive (tree);
diff --git a/gcc/langhooks.cc b/gcc/langhooks.cc
index 88450d8..3db87bd 100644
--- a/gcc/langhooks.cc
+++ b/gcc/langhooks.cc
@@ -665,7 +665,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 d6b5126..d95e5cb 100644
--- a/gcc/langhooks.h
+++ b/gcc/langhooks.h
@@ -326,7 +326,8 @@ struct lang_hooks_for_decls
   void (*omp_deep_mapping) (gimple *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 0650155..2141b4a 100644
--- a/gcc/omp-low.cc
+++ b/gcc/omp-low.cc
@@ -13627,60 +13627,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_ITERATORS_ELEMS (iters);
-      if (!POINTER_TYPE_P (TREE_TYPE (elems)))
-	continue;
-      tree arr_length
-	= omp_iterator_elems_length (OMP_ITERATORS_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_ITERATORS_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_ITERATORS_ELEMS (iters);
+  if (!POINTER_TYPE_P (TREE_TYPE (elems)))
+    return;
+  tree arr_length = omp_iterator_elems_length (OMP_ITERATORS_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_ITERATORS_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_ITERATORS_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_ITERATORS_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
@@ -14147,6 +14133,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)
@@ -14284,7 +14272,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 (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_MAP
 		&& (OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_TO_GRID
@@ -15843,12 +15832,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)