[v3,4/5] openmp, fortran: Add support for map iterators in OpenMP target construct (Fortran)

diff --git a/gcc/fortran/dump-parse-tree.cc b/gcc/fortran/dump-parse-tree.cc
index 3547d7f8aca..3ee6ed1ea7f 100644
--- a/gcc/fortran/dump-parse-tree.cc
+++ b/gcc/fortran/dump-parse-tree.cc
@@ -1359,7 +1359,8 @@  show_omp_namelist (int list_type, gfc_omp_namelist *n)
   for (; n; n = n->next)
     {
       gfc_current_ns = ns_curr;
-      if (list_type == OMP_LIST_AFFINITY || list_type == OMP_LIST_DEPEND)
+      if (list_type == OMP_LIST_AFFINITY || list_type == OMP_LIST_DEPEND
+	  || list_type == OMP_LIST_MAP)
 	{
 	  gfc_current_ns = n->u2.ns ? n->u2.ns : ns_curr;
 	  if (n->u2.ns != ns_iter)
@@ -1371,8 +1372,12 @@  show_omp_namelist (int list_type, gfc_omp_namelist *n)
 		    fputs ("AFFINITY (", dumpfile);
 		  else if (n->u.depend_doacross_op == OMP_DOACROSS_SINK_FIRST)
 		    fputs ("DOACROSS (", dumpfile);
-		  else
+		  else if (list_type == OMP_LIST_DEPEND)
 		    fputs ("DEPEND (", dumpfile);
+		  else if (list_type == OMP_LIST_MAP)
+		    fputs ("MAP (", dumpfile);
+		  else
+		    gcc_unreachable ();
 		}
 	      if (n->u2.ns)
 		{
diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc
index 2d5c4305d2a..3003ba605cf 100644
--- a/gcc/fortran/openmp.cc
+++ b/gcc/fortran/openmp.cc
@@ -193,7 +193,8 @@  gfc_free_omp_clauses (gfc_omp_clauses *c)
   gfc_free_expr (c->vector_length_expr);
   for (i = 0; i < OMP_LIST_NUM; i++)
     gfc_free_omp_namelist (c->lists[i],
-			   i == OMP_LIST_AFFINITY || i == OMP_LIST_DEPEND,
+			   i == OMP_LIST_AFFINITY || i == OMP_LIST_DEPEND
+			   || i == OMP_LIST_MAP,
 			   i == OMP_LIST_ALLOCATE,
 			   i == OMP_LIST_USES_ALLOCATORS,
 			   i == OMP_LIST_INIT);
@@ -3477,9 +3478,12 @@  gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 	      int always_modifier = 0;
 	      int close_modifier = 0;
 	      int present_modifier = 0;
+	      int iterator_modifier = 0;
+	      gfc_namespace *ns_iter = NULL, *ns_curr = gfc_current_ns;
 	      locus second_always_locus = old_loc2;
 	      locus second_close_locus = old_loc2;
 	      locus second_present_locus = old_loc2;
+	      locus second_iterator_locus = old_loc2;
 
 	      for (;;)
 		{
@@ -3499,6 +3503,11 @@  gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 		      if (present_modifier++ == 1)
 			second_present_locus = current_locus;
 		    }
+		  else if (gfc_match_iterator (&ns_iter, true) == MATCH_YES)
+		    {
+		      if (iterator_modifier++ == 1)
+		      second_iterator_locus = current_locus;
+		    }
 		  else
 		    break;
 		  gfc_match (", ");
@@ -3555,15 +3564,30 @@  gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 			     &second_present_locus);
 		  break;
 		}
+	      if (iterator_modifier > 1)
+		{
+		  gfc_error ("too many %<iterator%> modifiers at %L",
+			     &second_iterator_locus);
+		  break;
+		}
 
 	      head = NULL;
-	      if (gfc_match_omp_variable_list ("", &c->lists[OMP_LIST_MAP],
+	      if (ns_iter)
+		gfc_current_ns = ns_iter;
+	      m = gfc_match_omp_variable_list ("", &c->lists[OMP_LIST_MAP],
 					       false, NULL, &head,
-					       true, true) == MATCH_YES)
+					       true, true);
+	      gfc_current_ns = ns_curr;
+	      if (m == MATCH_YES)
 		{
 		  gfc_omp_namelist *n;
 		  for (n = *head; n; n = n->next)
-		    n->u.map.op = map_op;
+		    {
+		      n->u.map.op = map_op;
+		      n->u2.ns = ns_iter;
+		      if (ns_iter)
+			ns_iter->refs++;
+		    }
 		  continue;
 		}
 	      gfc_current_locus = old_loc;
@@ -8856,7 +8880,8 @@  resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
 	  case OMP_LIST_CACHE:
 	    for (; n != NULL; n = n->next)
 	      {
-		if ((list == OMP_LIST_DEPEND || list == OMP_LIST_AFFINITY)
+		if ((list == OMP_LIST_DEPEND || list == OMP_LIST_AFFINITY
+		     || list == OMP_LIST_MAP)
 		    && n->u2.ns && !n->u2.ns->resolved)
 		  {
 		    n->u2.ns->resolved = 1;
diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc
index 3a335ade0f7..c154975fb0b 100644
--- a/gcc/fortran/trans-openmp.cc
+++ b/gcc/fortran/trans-openmp.cc
@@ -2694,7 +2694,7 @@  gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 		       locus where, bool declare_simd = false,
 		       bool openacc = false, gfc_exec_op op = EXEC_NOP)
 {
-  tree omp_clauses = NULL_TREE, prev_clauses, chunk_size, c;
+  tree omp_clauses = NULL_TREE, prev_clauses = NULL_TREE, chunk_size, c;
   tree iterator = NULL_TREE;
   tree tree_block = NULL_TREE;
   stmtblock_t iter_block;
@@ -3129,11 +3129,39 @@  gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 	    }
 	  break;
 	case OMP_LIST_MAP:
+	  iterator = NULL_TREE;
+	  prev = NULL;
+	  prev_clauses = omp_clauses;
 	  for (; n != NULL; n = n->next)
 	    {
 	      if (!n->sym->attr.referenced)
 		continue;
 
+	      if (iterator && prev->u2.ns != n->u2.ns)
+		{
+		  /* Finish previous iterator group.  */
+		  BLOCK_SUBBLOCKS (tree_block) = gfc_finish_block (&iter_block);
+		  TREE_VEC_ELT (iterator, 5) = tree_block;
+		  for (tree c = omp_clauses; c != prev_clauses;
+		       c = OMP_CLAUSE_CHAIN (c))
+		    OMP_CLAUSE_ITERATORS (c) = iterator;
+		  prev_clauses = omp_clauses;
+		  iterator = NULL_TREE;
+		}
+	      if (n->u2.ns && (!prev || prev->u2.ns != n->u2.ns))
+		{
+		  /* Start a new iterator group.  */
+		  gfc_init_block (&iter_block);
+		  tree_block = make_node (BLOCK);
+		  TREE_USED (tree_block) = 1;
+		  BLOCK_VARS (tree_block) = NULL_TREE;
+		  prev_clauses = omp_clauses;
+		  iterator = handle_iterator (n->u2.ns, block, tree_block);
+		}
+	      if (!iterator)
+		gfc_init_block (&iter_block);
+	      prev = n;
+
 	      bool always_modifier = false;
 	      tree node = build_omp_clause (input_location, OMP_CLAUSE_MAP);
 	      tree node2 = NULL_TREE;
@@ -3332,7 +3360,7 @@  gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 						       TRUTH_NOT_EXPR,
 						       boolean_type_node,
 						       present);
-			  gfc_add_expr_to_block (block,
+			  gfc_add_expr_to_block (&iter_block,
 						 build3_loc (input_location,
 							     COND_EXPR,
 							     void_type_node,
@@ -3392,7 +3420,8 @@  gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 		      tree type = TREE_TYPE (decl);
 		      tree ptr = gfc_conv_descriptor_data_get (decl);
 		      if (present)
-			ptr = gfc_build_cond_assign_expr (block, present, ptr,
+			ptr = gfc_build_cond_assign_expr (&iter_block,
+							  present, ptr,
 							  null_pointer_node);
 		      gcc_assert (POINTER_TYPE_P (TREE_TYPE (ptr)));
 		      ptr = build_fold_indirect_ref (ptr);
@@ -3420,7 +3449,7 @@  gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 			      ptr = gfc_conv_descriptor_data_get (decl);
 			      ptr = gfc_build_addr_expr (NULL, ptr);
 			      ptr = gfc_build_cond_assign_expr (
-				      block, present, ptr, null_pointer_node);
+				&iter_block, present, ptr, null_pointer_node);
 			      ptr = build_fold_indirect_ref (ptr);
 			      OMP_CLAUSE_DECL (node3) = ptr;
 			    }
@@ -3509,7 +3538,7 @@  gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 						    TRUTH_ANDIF_EXPR,
 						    boolean_type_node,
 						    present, cond);
-			  gfc_add_expr_to_block (block,
+			  gfc_add_expr_to_block (&iter_block,
 						 build3_loc (input_location,
 							     COND_EXPR,
 							     void_type_node,
@@ -3538,12 +3567,12 @@  gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 			      tree cond = build3_loc (input_location, COND_EXPR,
 						      void_type_node, present,
 						      cond_body, NULL_TREE);
-			      gfc_add_expr_to_block (block, cond);
+			      gfc_add_expr_to_block (&iter_block, cond);
 			      OMP_CLAUSE_SIZE (node) = var;
 			    }
 			  else
 			    {
-			      gfc_add_block_to_block (block, &cond_block);
+			      gfc_add_block_to_block (&iter_block, &cond_block);
 			      OMP_CLAUSE_SIZE (node) = size;
 			    }
 			}
@@ -3555,7 +3584,8 @@  gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 		      /* A single indirectref is handled by the middle end.  */
 		      gcc_assert (!POINTER_TYPE_P (TREE_TYPE (decl)));
 		      decl = TREE_OPERAND (decl, 0);
-		      decl = gfc_build_cond_assign_expr (block, present, decl,
+		      decl = gfc_build_cond_assign_expr (&iter_block,
+							 present, decl,
 							 null_pointer_node);
 		      OMP_CLAUSE_DECL (node) = build_fold_indirect_ref (decl);
 		    }
@@ -3589,7 +3619,7 @@  gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 							 size_type_node,
 							 cond, size,
 							 size_zero_node);
-		      size = gfc_evaluate_now (size, block);
+		      size = gfc_evaluate_now (size, &iter_block);
 		      OMP_CLAUSE_SIZE (node) = size;
 		    }
 		}
@@ -3608,7 +3638,8 @@  gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 		      && !(POINTER_TYPE_P (type)
 			   && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (type))))
 		    k = GOMP_MAP_FIRSTPRIVATE_POINTER;
-		  gfc_trans_omp_array_section (block, op, n, decl, element,
+		  gfc_trans_omp_array_section (&iter_block,
+					       op, n, decl, element,
 					       !openacc, k, node, node2,
 					       node3, node4);
 		}
@@ -3626,12 +3657,12 @@  gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 		  gfc_init_se (&se, NULL);
 
 		  gfc_conv_expr (&se, n->expr);
-		  gfc_add_block_to_block (block, &se.pre);
+		  gfc_add_block_to_block (&iter_block, &se.pre);
 		  /* For BT_CHARACTER a pointer is returned.  */
 		  OMP_CLAUSE_DECL (node)
 		    = POINTER_TYPE_P (TREE_TYPE (se.expr))
 		      ? build_fold_indirect_ref (se.expr) : se.expr;
-		  gfc_add_block_to_block (block, &se.post);
+		  gfc_add_block_to_block (&iter_block, &se.post);
 		  if (pointer || allocatable)
 		    {
 		      /* If it's a bare attach/detach clause, we just want
@@ -3843,7 +3874,7 @@  gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 			  OMP_CLAUSE_DECL (node) = ptr;
 			  int rank = GFC_TYPE_ARRAY_RANK (type);
 			  OMP_CLAUSE_SIZE (node)
-			    = gfc_full_array_size (block, inner, rank);
+			    = gfc_full_array_size (&iter_block, inner, rank);
 			  tree elemsz
 			    = TYPE_SIZE_UNIT (gfc_get_element_type (type));
 			  map_kind = OMP_CLAUSE_MAP_KIND (node);
@@ -3981,7 +4012,8 @@  gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 		      /* An array element or section.  */
 		      bool element = lastref->u.ar.type == AR_ELEMENT;
 		      gomp_map_kind kind = GOMP_MAP_ATTACH_DETACH;
-		      gfc_trans_omp_array_section (block, op, n, inner, element,
+		      gfc_trans_omp_array_section (&iter_block,
+						   op, n, inner, element,
 						   !openacc, kind, node, node2,
 						   node3, node4);
 		    }
@@ -3993,6 +4025,8 @@  gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 
 	      finalize_map_clause:
 
+	      if (!iterator)
+		gfc_add_block_to_block (block, &iter_block);
 	      omp_clauses = gfc_trans_add_clause (node, omp_clauses);
 	      if (node2)
 		omp_clauses = gfc_trans_add_clause (node2, omp_clauses);
@@ -4003,6 +4037,15 @@  gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 	      if (node5)
 		omp_clauses = gfc_trans_add_clause (node5, omp_clauses);
 	    }
+	  if (iterator)
+	    {
+	      /* Finish last iterator group.  */
+	      BLOCK_SUBBLOCKS (tree_block) = gfc_finish_block (&iter_block);
+	      TREE_VEC_ELT (iterator, 5) = tree_block;
+	      for (tree c = omp_clauses; c != prev_clauses;
+		   c = OMP_CLAUSE_CHAIN (c))
+		OMP_CLAUSE_ITERATORS (c) = iterator;
+	    }
 	  break;
 	case OMP_LIST_TO:
 	case OMP_LIST_FROM:
diff --git a/gcc/gimplify.cc b/gcc/gimplify.cc
index ba972a2892a..4e30d335324 100644
--- a/gcc/gimplify.cc
+++ b/gcc/gimplify.cc
@@ -8858,10 +8858,17 @@  compute_iterator_count (tree it, gimple_seq *pre_p)
 	endmbegin = fold_build2_loc (loc, POINTER_DIFF_EXPR, stype, end, begin);
       else
 	endmbegin = fold_build2_loc (loc, MINUS_EXPR, type, end, begin);
-      tree stepm1 = fold_build2_loc (loc, MINUS_EXPR, stype, step,
-				     build_int_cst (stype, 1));
-      tree stepp1 = fold_build2_loc (loc, PLUS_EXPR, stype, step,
-				     build_int_cst (stype, 1));
+      /* Account for iteration stopping on the end value in Fortran rather
+	 than before it.  */
+      tree stepm1 = step;
+      tree stepp1 = step;
+      if (!lang_GNU_Fortran ())
+	{
+	  stepm1 = fold_build2_loc (loc, MINUS_EXPR, stype, step,
+				    build_int_cst (stype, 1));
+	  stepp1 = fold_build2_loc (loc, PLUS_EXPR, stype, step,
+				    build_int_cst (stype, 1));
+	}
       tree pos = fold_build2_loc (loc, PLUS_EXPR, stype,
 				  unshare_expr (endmbegin), stepm1);
       pos = fold_build2_loc (loc, TRUNC_DIV_EXPR, stype, pos, step);
@@ -8905,6 +8912,7 @@  build_iterator_loop (tree it, gimple_seq *pre_p, tree *last_bind)
   if (*last_bind)
     gimplify_and_add (*last_bind, pre_p);
   tree block = TREE_VEC_ELT (it, 5);
+  tree block_stmts = lang_GNU_Fortran () ? BLOCK_SUBBLOCKS (block) : NULL_TREE;
   *last_bind = build3 (BIND_EXPR, void_type_node,
 		       BLOCK_VARS (block), NULL, block);
   TREE_SIDE_EFFECTS (*last_bind) = 1;
@@ -8916,6 +8924,7 @@  build_iterator_loop (tree it, gimple_seq *pre_p, tree *last_bind)
       tree end = TREE_VEC_ELT (it, 2);
       tree step = TREE_VEC_ELT (it, 3);
       tree orig_step = TREE_VEC_ELT (it, 4);
+      block = TREE_VEC_ELT (it, 5);
       tree type = TREE_TYPE (var);
       location_t loc = DECL_SOURCE_LOCATION (var);
       /* Emit:
@@ -8926,9 +8935,9 @@  build_iterator_loop (tree it, gimple_seq *pre_p, tree *last_bind)
 	 var = var + step;
 	 cond_label:
 	 if (orig_step > 0) {
-	   if (var < end) goto beg_label;
+	   if (var < end) goto beg_label;  // <= for Fortran
 	 } else {
-	   if (var > end) goto beg_label;
+	   if (var > end) goto beg_label;  // >= for Fortran
 	 }
 	 for each iterator, with inner iterators added to
 	 the ... above.  */
@@ -8954,10 +8963,12 @@  build_iterator_loop (tree it, gimple_seq *pre_p, tree *last_bind)
       append_to_statement_list_force (tem, p);
       tem = build1 (LABEL_EXPR, void_type_node, cond_label);
       append_to_statement_list (tem, p);
-      tree cond = fold_build2_loc (loc, LT_EXPR, boolean_type_node, var, end);
+      tree cond = fold_build2_loc (loc, lang_GNU_Fortran () ? LE_EXPR : LT_EXPR,
+				   boolean_type_node, var, end);
       tree pos = fold_build3_loc (loc, COND_EXPR, void_type_node, cond,
 				  build_and_jump (&beg_label), void_node);
-      cond = fold_build2_loc (loc, GT_EXPR, boolean_type_node, var, end);
+      cond = fold_build2_loc (loc, lang_GNU_Fortran () ? GE_EXPR : GT_EXPR,
+			      boolean_type_node, var, end);
       tree neg = fold_build3_loc (loc, COND_EXPR, void_type_node, cond,
 				  build_and_jump (&beg_label), void_node);
       tree osteptype = TREE_TYPE (orig_step);
@@ -8966,6 +8977,11 @@  build_iterator_loop (tree it, gimple_seq *pre_p, tree *last_bind)
       tem = fold_build3_loc (loc, COND_EXPR, void_type_node, cond, pos, neg);
       append_to_statement_list_force (tem, p);
       p = &BIND_EXPR_BODY (bind);
+      /* The Fortran front-end stashes statements into the BLOCK_SUBBLOCKS
+	 of the last element of the first iterator.  These should go into the
+	 body of the innermost loop.  */
+      if (!TREE_CHAIN (it))
+	append_to_statement_list_force (block_stmts, p);
     }
 
   return p;
@@ -9406,6 +9422,34 @@  build_omp_struct_comp_nodes (enum tree_code code, tree grp_start, tree grp_end,
   return c2;
 }
 
+/* Callback for walk_tree.  Return any VAR_DECLS that are not found in the
+   iterators stored in DATA.  */
+
+static tree
+contains_only_iterator_vars_1 (tree* tp, int *, void *data)
+{
+  tree iterators = (tree) data;
+  tree t = *tp;
+
+  if (TREE_CODE (t) != VAR_DECL)
+    return NULL_TREE;
+
+  for (tree it = iterators; it; it = TREE_CHAIN (it))
+    if (t == TREE_VEC_ELT (it, 0))
+      return NULL_TREE;
+
+  return t;
+}
+
+/* Return true if the only variables present in EXPR are iterator variables in
+   ITERATORS.  */
+
+static bool
+contains_only_iterator_vars (tree expr, tree iterators)
+{
+  return !walk_tree (&expr, contains_only_iterator_vars_1, iterators, NULL);
+}
+
 /* Strip ARRAY_REFS or an indirect ref off BASE, find the containing object,
    and set *BITPOSP and *POFFSETP to the bit offset of the access.
    If BASE_REF is non-NULL and the containing object is a reference, set
@@ -9416,7 +9460,8 @@  build_omp_struct_comp_nodes (enum tree_code code, tree grp_start, tree grp_end,
 static tree
 extract_base_bit_offset (tree base, poly_int64 *bitposp,
 			 poly_offset_int *poffsetp,
-			 bool *variable_offset)
+			 bool *variable_offset,
+			 tree iterator)
 {
   tree offset;
   poly_int64 bitsize, bitpos;
@@ -9440,6 +9485,8 @@  extract_base_bit_offset (tree base, poly_int64 *bitposp,
     {
       poffset = 0;
       *variable_offset = (offset != NULL_TREE);
+      if (iterator && *variable_offset)
+	*variable_offset = !contains_only_iterator_vars (offset, iterator);
     }
 
   if (maybe_ne (bitpos, 0))
@@ -11245,8 +11292,11 @@  omp_accumulate_sibling_list (enum omp_region_type region_type,
     }
 
   bool variable_offset;
+  tree iterators = OMP_CLAUSE_HAS_ITERATORS (grp_end)
+		     ? OMP_CLAUSE_ITERATORS (grp_end) : NULL_TREE;
   tree base
-    = extract_base_bit_offset (ocd, &cbitpos, &coffset, &variable_offset);
+    = extract_base_bit_offset (ocd, &cbitpos, &coffset, &variable_offset,
+			       iterators);
 
   int base_token;
   for (base_token = addr_tokens.length () - 1; base_token >= 0; base_token--)
@@ -11579,8 +11629,12 @@  omp_accumulate_sibling_list (enum omp_region_type region_type,
 	      sc_decl = TREE_OPERAND (sc_decl, 0);
 
 	    bool variable_offset2;
+	    tree iterators2 = OMP_CLAUSE_HAS_ITERATORS (*sc)
+				? OMP_CLAUSE_ITERATORS (*sc) : NULL_TREE;
+
 	    tree base2 = extract_base_bit_offset (sc_decl, &bitpos, &offset,
-						  &variable_offset2);
+						  &variable_offset2,
+						  iterators2);
 	    if (!base2 || !operand_equal_p (base2, base, 0))
 	      break;
 	    if (scp)
diff --git a/gcc/omp-low.cc b/gcc/omp-low.cc
index a8b86889c66..46f40a14646 100644
--- a/gcc/omp-low.cc
+++ b/gcc/omp-low.cc
@@ -12938,6 +12938,11 @@  lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx)
 	    deep_map_cnt = extra;
 	}
 
+	if (deep_map_cnt
+	    && OMP_CLAUSE_HAS_ITERATORS (c) && OMP_CLAUSE_ITERATORS (c))
+	  sorry ("iterators used together with deep mapping are not "
+		 "supported yet");
+
 	if (!DECL_P (var))
 	  {
 	    if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_MAP
diff --git a/gcc/testsuite/gfortran.dg/gomp/target-map-iterators-1.f90 b/gcc/testsuite/gfortran.dg/gomp/target-map-iterators-1.f90
new file mode 100644
index 00000000000..25abbaf741e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/target-map-iterators-1.f90
@@ -0,0 +1,26 @@ 
+! { dg-do compile }
+! { dg-options "-fopenmp" }
+
+program main
+  implicit none
+
+  integer, parameter :: DIM1 = 17
+  integer, parameter :: DIM2 = 39
+  type :: array_ptr
+    integer, pointer :: ptr(:)
+  end type
+  
+  type (array_ptr) :: x(DIM1), y(DIM1)
+
+  !$omp target map (iterator(i=1:DIM1), to: x(i)%ptr(:))
+  !$omp end target
+
+  !$omp target map (iterator(i=1:DIM1), to: x(i)%ptr(:), y(i)%ptr(:))
+  !$omp end target
+
+  !$omp target map (iterator(i=1:DIM1), to: x(i)%ptr(:) + 3) ! { dg-error "Syntax error in OpenMP variable list at .1." }
+  !$omp end target ! { dg-error "Unexpected \\\!\\\$OMP END TARGET statement at .1." }
+
+  !$omp target map(iterator(i=1:DIM1), iterator(j=1:DIM2), to: x(i)%ptr(j)) ! { dg-error "too many 'iterator' modifiers at .1." }
+  !$omp end target ! { dg-error "Unexpected \\\!\\\$OMP END TARGET statement at .1." }
+end program
diff --git a/gcc/testsuite/gfortran.dg/gomp/target-map-iterators-2.f90 b/gcc/testsuite/gfortran.dg/gomp/target-map-iterators-2.f90
new file mode 100644
index 00000000000..b7d7501cf63
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/target-map-iterators-2.f90
@@ -0,0 +1,27 @@ 
+! { dg-do compile }
+! { dg-options "-fopenmp" }
+
+program main
+  implicit none
+
+  integer, parameter :: DIM = 40
+  type :: array_ptr
+    integer, pointer :: ptr(:)
+  end type
+  
+  type (array_ptr) :: x(DIM), y(DIM), z(DIM)
+
+  !$omp target map(iterator(i=1:10), to: x) ! { dg-error "iterator variable .i. not used in clause expression" }
+    ! Add a reference to x to ensure that the 'to' clause does not get dropped.
+    x(1)%ptr(1) = 0
+  !$omp end target
+
+  !$omp target map(iterator(i=1:10, j=1:20), to: x(i)) ! { dg-error "iterator variable .j. not used in clause expression" }
+  !$omp end target
+
+  !$omp target map(iterator(i=1:10, j=1:20, k=1:30), to: x(i), y(j), z(k))
+  !$omp end target
+  ! { dg-error "iterator variable .i. not used in clause expression" "" { target *-*-* } .-2 }
+  ! { dg-error "iterator variable .j. not used in clause expression" "" { target *-*-* } .-3 }
+  ! { dg-error "iterator variable .k. not used in clause expression" "" { target *-*-* } .-4 }
+end program
diff --git a/gcc/testsuite/gfortran.dg/gomp/target-map-iterators-3.f90 b/gcc/testsuite/gfortran.dg/gomp/target-map-iterators-3.f90
new file mode 100644
index 00000000000..785f149c0d8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/target-map-iterators-3.f90
@@ -0,0 +1,24 @@ 
+! { dg-do compile }
+! { dg-options "-fopenmp -fdump-tree-omplower" }
+
+program main
+  implicit none
+
+  integer, parameter :: DIM1 = 17
+  integer, parameter :: DIM2 = 27
+  type :: ptr_t
+    integer, pointer :: ptr(:)
+  end type
+  
+  type (ptr_t) :: x(DIM1), y(DIM2)
+
+  !$omp target map(iterator(i=1:DIM1), to: x(i)%ptr(:)) map(iterator(i=1:DIM2), from: y(i)%ptr(:))
+  !$omp end target
+end program
+
+! { dg-final { scan-tree-dump-times "if \\(i <= 17\\) goto <D\.\[0-9\]+>; else goto <D\.\[0-9\]+>;" 1 "omplower" } }
+! { dg-final { scan-tree-dump-times "if \\(i <= 27\\) goto <D\.\[0-9\]+>; else goto <D\.\[0-9\]+>;" 1 "omplower" } }
+! { dg-final { scan-tree-dump-times "map\\(iterator\\(integer\\(kind=4\\) i=1:17:1\\):to:D\.\[0-9\]+" 1 "omplower" } }
+! { dg-final { scan-tree-dump-times "map\\(iterator\\(integer\\(kind=4\\) i=1:27:1\\):from:D\.\[0-9\]+" 1 "omplower" } }
+! { dg-final { scan-tree-dump-times "map\\(iterator\\(integer\\(kind=4\\) i=1:17:1\\):attach:D\.\[0-9\]+" 1 "omplower" } }
+! { dg-final { scan-tree-dump-times "map\\(iterator\\(integer\\(kind=4\\) i=1:27:1\\):attach:D\.\[0-9\]+" 1 "omplower" } }
diff --git a/gcc/tree-pretty-print.cc b/gcc/tree-pretty-print.cc
index fa1b2dce27f..da6b757e212 100644
--- a/gcc/tree-pretty-print.cc
+++ b/gcc/tree-pretty-print.cc
@@ -1671,7 +1671,9 @@  dump_block_node (pretty_printer *pp, tree block, int spc, dump_flags_t flags)
       newline_and_indent (pp, spc + 2);
     }
 
-  if (BLOCK_SUBBLOCKS (block))
+  if (BLOCK_SUBBLOCKS (block)
+      && (!lang_GNU_Fortran ()
+	  || TREE_CODE (BLOCK_SUBBLOCKS (block)) != STATEMENT_LIST))
     {
       pp_string (pp, "SUBBLOCKS: ");
       for (t = BLOCK_SUBBLOCKS (block); t; t = BLOCK_CHAIN (t))
diff --git a/libgomp/target.c b/libgomp/target.c
index 60d57a19dd0..e8205f6c309 100644
--- a/libgomp/target.c
+++ b/libgomp/target.c
@@ -993,10 +993,48 @@  kind_to_name (unsigned short kind)
     case GOMP_MAP_POINTER: return "GOMP_MAP_POINTER";
     case GOMP_MAP_ATTACH: return "GOMP_MAP_ATTACH";
     case GOMP_MAP_DETACH: return "GOMP_MAP_DETACH";
+    case GOMP_MAP_STRUCT: return "GOMP_MAP_STRUCT";
+    case GOMP_MAP_STRUCT_UNORD: return "GOMP_MAP_STRUCT_UNORD";
     default: return "unknown";
     }
 }
 
+static void
+gomp_add_map (size_t idx, size_t *new_idx,
+	      void ***hostaddrs, size_t **sizes, unsigned short **skinds,
+	      void ***new_hostaddrs, size_t **new_sizes,
+	      unsigned short **new_kinds, size_t *iterator_count)
+{
+  if ((*sizes)[idx] == SIZE_MAX)
+    {
+      uintptr_t *iterator_array = (*hostaddrs)[idx];
+      size_t count = *iterator_array++;
+      for (size_t i = 0; i < count; i++)
+	{
+	  (*new_hostaddrs)[*new_idx] = (void *) *iterator_array++;
+	  (*new_sizes)[*new_idx] = *iterator_array++;
+	  (*new_kinds)[*new_idx] = (*skinds)[idx];
+	  iterator_count[*new_idx] = i + 1;
+	  gomp_debug (1,
+		      "Expanding map %u <%s>: "
+		      "hostaddrs[%u] = %p, sizes[%u] = %lu\n",
+		      (int) idx, kind_to_name ((*new_kinds)[*new_idx]),
+		      (int) *new_idx, (*new_hostaddrs)[*new_idx],
+		      (int) *new_idx, (unsigned long) (*new_sizes)[*new_idx]);
+	  (*new_idx)++;
+	}
+    }
+  else
+    {
+      (*new_hostaddrs)[*new_idx] = (*hostaddrs)[idx];
+      (*new_sizes)[*new_idx] = (*sizes)[idx];
+      (*new_kinds)[*new_idx] = (*skinds)[idx];
+      iterator_count[*new_idx] = 0;
+      (*new_idx)++;
+    }
+}
+
+
 /* Map entries containing expanded iterators will be flattened and merged into
    HOSTADDRS, SIZES and KINDS, and MAPNUM updated.  Returns true if there are
    any iterators found.  ITERATOR_COUNT holds the iteration count of the
@@ -1037,33 +1075,34 @@  gomp_merge_iterator_maps (size_t *mapnum, void ***hostaddrs, size_t **sizes,
 
   for (size_t i = 0; i < *mapnum; i++)
     {
-      if ((*sizes)[i] == SIZE_MAX)
+      int map_type = get_kind (true, *skinds, i) & 0xff;
+      if (map_type == GOMP_MAP_STRUCT || map_type == GOMP_MAP_STRUCT_UNORD)
 	{
-	  uintptr_t *iterator_array = (*hostaddrs)[i];
-	  size_t count = *iterator_array++;
-	  for (size_t j = 0; j < count; j++)
+	  size_t field_count = (*sizes)[i];
+
+	  gomp_add_map (i, &new_idx, hostaddrs, sizes, skinds,
+			&new_hostaddrs, &new_sizes, &new_kinds,
+			*iterator_count);
+
+	  for (size_t j = i + 1; j <= i + field_count; j++)
 	    {
-	      new_hostaddrs[new_idx] = (void *) *iterator_array++;
-	      new_sizes[new_idx] = *iterator_array++;
-	      new_kinds[new_idx] = (*skinds)[i];
-	      (*iterator_count)[new_idx] = j + 1;
-	      gomp_debug (1,
-			  "Expanding map %u <%s>: "
-			  "hostaddrs[%u] = %p, sizes[%u] = %lu\n",
-			  (int) i, kind_to_name (new_kinds[new_idx]),
-			  (int) new_idx, new_hostaddrs[new_idx],
-			  (int) new_idx, (unsigned long) new_sizes[new_idx]);
-	      new_idx++;
+	      if ((*sizes)[j] == SIZE_MAX)
+		{
+		  uintptr_t *iterator_array = (*hostaddrs)[j];
+		  size_t count = iterator_array[0];
+		  new_sizes[i] += count - 1;
+		}
+	      gomp_add_map (j, &new_idx, hostaddrs, sizes, skinds,
+			    &new_hostaddrs, &new_sizes, &new_kinds,
+			    *iterator_count);
 	    }
+	  gomp_debug (1, "Map %u: new field count = %lu\n",
+		      (int) i, (unsigned long) new_sizes[i]);
+	  i += field_count;
 	}
       else
-	{
-	  new_hostaddrs[new_idx] = (*hostaddrs)[i];
-	  new_sizes[new_idx] = (*sizes)[i];
-	  new_kinds[new_idx] = (*skinds)[i];
-	  (*iterator_count)[new_idx] = 0;
-	  new_idx++;
-	}
+	gomp_add_map (i, &new_idx, hostaddrs, sizes, skinds,
+		      &new_hostaddrs, &new_sizes, &new_kinds, *iterator_count);
     }
 
   *mapnum = map_count;
diff --git a/libgomp/testsuite/libgomp.fortran/target-map-iterators-1.f90 b/libgomp/testsuite/libgomp.fortran/target-map-iterators-1.f90
new file mode 100644
index 00000000000..80e077e69fd
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/target-map-iterators-1.f90
@@ -0,0 +1,45 @@ 
+! { dg-do run }
+
+! Test transfer of dynamically-allocated arrays to target using map
+! iterators.
+
+program test
+  implicit none
+
+  integer, parameter :: DIM1 = 8
+  integer, parameter :: DIM2 = 15
+
+  type :: array_ptr
+    integer, pointer :: arr(:)
+  end type
+
+  type (array_ptr) :: x(DIM1)
+  integer :: expected, sum, i, j
+
+  expected = mkarray ()
+
+  !$omp target map(iterator(i=1:DIM1), to: x(i)%arr(:)) map(from: sum)
+    sum = 0
+    do i = 1, DIM1
+      do j = 1, DIM2
+	sum = sum + x(i)%arr(j)
+      end do
+    end do
+  !$omp end target
+
+  if (sum .ne. expected) stop 1
+contains
+  integer function mkarray ()
+    integer :: exp = 0
+
+    do i = 1, DIM1
+      allocate (x(i)%arr(DIM2))
+      do j = 1, DIM2
+        x(i)%arr(j) = i * j
+	exp = exp + x(i)%arr(j)
+      end do
+    end do
+
+    mkarray = exp
+  end function
+end program
diff --git a/libgomp/testsuite/libgomp.fortran/target-map-iterators-2.f90 b/libgomp/testsuite/libgomp.fortran/target-map-iterators-2.f90
new file mode 100644
index 00000000000..cf0e7fbd9b3
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/target-map-iterators-2.f90
@@ -0,0 +1,45 @@ 
+! { dg-do run }
+
+! Test transfer of dynamically-allocated arrays from target using map
+! iterators.
+
+program test
+  implicit none
+
+  integer, parameter :: DIM1 = 8
+  integer, parameter :: DIM2 = 15
+
+  type :: array_ptr
+    integer, pointer :: arr(:)
+  end type
+
+  type (array_ptr) :: x(DIM1)
+  integer :: expected, sum, i, j
+
+  call mkarray
+
+  !$omp target map(iterator(i=1:DIM1), from: x(i)%arr(:)) map(from: expected)
+    expected = 0
+    do i = 1, DIM1
+      do j = 1, DIM2
+	x(i)%arr(j) = (i+1) * (j+1)
+	expected = expected + x(i)%arr(j)
+      end do
+    end do
+  !$omp end target
+
+  sum = 0
+  do i = 1, DIM1
+    do j = 1, DIM2
+      sum = sum + x(i)%arr(j)
+    end do
+  end do
+
+  if (sum .ne. expected) stop 1
+contains
+  subroutine mkarray
+    do i = 1, DIM1
+      allocate (x(i)%arr(DIM2))
+    end do
+  end subroutine
+end program
diff --git a/libgomp/testsuite/libgomp.fortran/target-map-iterators-3.f90 b/libgomp/testsuite/libgomp.fortran/target-map-iterators-3.f90
new file mode 100644
index 00000000000..8072c074557
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/target-map-iterators-3.f90
@@ -0,0 +1,57 @@ 
+! { dg-do run }
+
+! Test transfer of dynamically-allocated arrays to target using map
+! iterators, with multiple iterators and function calls in the iterator
+! expression.
+
+program test
+  implicit none
+
+  integer, parameter :: DIM1 = 16
+  integer, parameter :: DIM2 = 4
+
+  type :: array_ptr
+    integer, pointer :: arr(:)
+  end type
+
+  type (array_ptr) :: x(DIM1), y(DIM1)
+  integer :: expected, sum, i, j
+
+  expected = mkarrays ()
+
+  !$omp target map(iterator(i=0:DIM1/4-1, j=0:3), to: x(f (i, j))%arr(:)) &
+  !$omp        map(iterator(i=1:DIM1), to: y(i)%arr(:)) &
+  !$omp        map(from: sum)
+    sum = 0
+    do i = 1, DIM1
+      do j = 1, DIM2
+	sum = sum + x(i)%arr(j) * y(i)%arr(j)
+      end do
+    end do
+  !$omp end target
+
+  print *, sum, expected
+  if (sum .ne. expected) stop 1
+contains
+  integer function mkarrays ()
+    integer :: exp = 0
+
+    do i = 1, DIM1
+      allocate (x(i)%arr(DIM2))
+      allocate (y(i)%arr(DIM2))
+      do j = 1, DIM2
+	x(i)%arr(j) = i * j
+	y(i)%arr(j) = i + j
+	exp = exp + x(i)%arr(j) * y(i)%arr(j)
+      end do
+    end do
+
+    mkarrays = exp
+  end function
+
+  integer function f (i, j)
+    integer, intent(in) :: i, j
+
+    f = i * 4 + j + 1
+  end function
+end program