v2: https://gcc.gnu.org/pipermail/gcc-patches/2024-September/662142.html
v3: https://gcc.gnu.org/pipermail/gcc-patches/2024-October/664546.html
v4: https://gcc.gnu.org/pipermail/gcc-patches/2024-November/670337.html
Again, largely the same as v4, with a couple of extra bug-fixes:
- When computing the bias of an array section, substitute iterator
variables with the value of the lower bound before computing the difference.
- Fixed a boundary condition for Fortran when computing the iterator
count, where the start equals the end value.
- Fix computation of base bit offset with iterators.
From 14469e4793899babf038afaac90b9f7721922573 Mon Sep 17 00:00:00 2001
From: Kwok Cheung Yeung <kcye...@baylibre.com>
Date: Sat, 3 May 2025 20:36:21 +0000
Subject: [PATCH 04/11] openmp, fortran: Add support for map iterators in
OpenMP target construct (Fortran)
This adds support for iterators in map clauses within OpenMP
'target' constructs in Fortran.
Some special handling for struct field maps has been added to libgomp in
order to handle arrays of derived types.
gcc/fortran/
* dump-parse-tree.cc (show_omp_namelist): Add iterator support for
OMP_LIST_MAP.
* openmp.cc (gfc_free_omp_clauses): Free namespace in namelist for
OMP_LIST_MAP.
(gfc_match_omp_clauses): Parse 'iterator' modifier for 'map' clause.
(resolve_omp_clauses): Resolve iterators for OMP_LIST_MAP.
* trans-openmp.cc: Include tree-ssa-loop-niter.h.
(gfc_trans_omp_array_section): Add iterator argument. Replace
instances of iterator variables with the initial value when
computing biases.
(gfc_trans_omp_clauses): Handle iterators in OMP_LIST_MAP clauses.
Add expressions to iter_block rather than block. Do not apply
iterators to firstprivate maps. Pass iterator to
gfc_trans_omp_array_section.
gcc/
* gimplify.cc (compute_omp_iterator_count): Account for difference
in loop boundaries in Fortran.
(build_omp_iterator_loop): Change upper boundary condition for
Fortran. Insert block statements into innermost loop.
(remove_unused_omp_iterator_vars): Copy block subblocks of old
iterator to new iterator and remove original.
(contains_vars_1): New.
(contains_vars): New.
(extract_base_bit_offset): Add iterator argument. Remove iterator
variables from base. Do not set variable_offset if the offset
does not contain any remaining variables.
(omp_accumulate_sibling_list): Add iterator argument to
extract_base_bit_offset.
* tree-pretty-print.cc (dump_block_node): Ignore BLOCK_SUBBLOCKS
containing iterator block statements.
gcc/testsuite/
* gfortran.dg/gomp/target-map-iterators-1.f90: New.
* gfortran.dg/gomp/target-map-iterators-2.f90: New.
* gfortran.dg/gomp/target-map-iterators-3.f90: New.
* gfortran.dg/gomp/target-map-iterators-4.f90: New.
libgomp/
* target.c (kind_to_name): Handle GOMP_MAP_STRUCT and
GOMP_MAP_STRUCT_UNORD.
(gomp_add_map): New.
(gomp_merge_iterator_maps): Expand fields of a struct mapping
breadth-first.
* testsuite/libgomp.fortran/target-map-iterators-1.f90: New.
* testsuite/libgomp.fortran/target-map-iterators-2.f90: New.
* testsuite/libgomp.fortran/target-map-iterators-3.f90: New.
Co-authored-by: Andrew Stubbs <a...@baylibre.com>
---
gcc/fortran/dump-parse-tree.cc | 9 +-
gcc/fortran/openmp.cc | 36 +++++-
gcc/fortran/trans-openmp.cc | 106 ++++++++++++++----
gcc/gimplify.cc | 94 +++++++++++++---
.../gomp/target-map-iterators-1.f90 | 26 +++++
.../gomp/target-map-iterators-2.f90 | 33 ++++++
.../gomp/target-map-iterators-3.f90 | 24 ++++
.../gomp/target-map-iterators-4.f90 | 31 +++++
gcc/tree-pretty-print.cc | 4 +-
libgomp/target.c | 84 ++++++++++----
.../target-map-iterators-1.f90 | 45 ++++++++
.../target-map-iterators-2.f90 | 45 ++++++++
.../target-map-iterators-3.f90 | 56 +++++++++
13 files changed, 526 insertions(+), 67 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/gomp/target-map-iterators-1.f90
create mode 100644 gcc/testsuite/gfortran.dg/gomp/target-map-iterators-2.f90
create mode 100644 gcc/testsuite/gfortran.dg/gomp/target-map-iterators-3.f90
create mode 100644 gcc/testsuite/gfortran.dg/gomp/target-map-iterators-4.f90
create mode 100644 libgomp/testsuite/libgomp.fortran/target-map-iterators-1.f90
create mode 100644 libgomp/testsuite/libgomp.fortran/target-map-iterators-2.f90
create mode 100644 libgomp/testsuite/libgomp.fortran/target-map-iterators-3.f90
diff --git a/gcc/fortran/dump-parse-tree.cc b/gcc/fortran/dump-parse-tree.cc
index 3cd2eeef11a..bf4ee446940 100644
--- a/gcc/fortran/dump-parse-tree.cc
+++ b/gcc/fortran/dump-parse-tree.cc
@@ -1461,7 +1461,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)
@@ -1473,8 +1474,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 fe0a47a6948..e8563278a5d 100644
--- a/gcc/fortran/openmp.cc
+++ b/gcc/fortran/openmp.cc
@@ -204,7 +204,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);
@@ -3566,9 +3567,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 (;;)
{
@@ -3588,6 +3592,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 (", ");
@@ -3644,15 +3653,29 @@ 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],
- false, NULL, &head,
- true, true) == MATCH_YES)
+ if (ns_iter)
+ gfc_current_ns = ns_iter;
+ m = gfc_match_omp_variable_list ("", &c->lists[OMP_LIST_MAP],
+ false, NULL, &head, 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;
@@ -9460,7 +9483,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 a2e70fca0b3..f6e46cb157a 100644
--- a/gcc/fortran/trans-openmp.cc
+++ b/gcc/fortran/trans-openmp.cc
@@ -27,6 +27,7 @@ along with GCC; see the file COPYING3. If not see
#include "gfortran.h"
#include "basic-block.h"
#include "tree-ssa.h"
+#include "tree-ssa-loop-niter.h" /* for simplify_replace_tree. */
#include "function.h"
#include "gimple.h"
#include "gimple-expr.h"
@@ -3241,7 +3242,8 @@ static void
gfc_trans_omp_array_section (stmtblock_t *block, gfc_exec_op op,
gfc_omp_namelist *n, tree decl, bool element,
bool openmp, gomp_map_kind ptr_kind, tree &node,
- tree &node2, tree &node3, tree &node4)
+ tree &node2, tree &node3, tree &node4,
+ tree iterator)
{
gfc_se se;
tree ptr, ptr2;
@@ -3396,6 +3398,13 @@ gfc_trans_omp_array_section (stmtblock_t *block,
gfc_exec_op op,
OMP_CLAUSE_DECL (node3) = decl;
}
ptr2 = fold_convert (ptrdiff_type_node, ptr2);
+ for (tree it = iterator; it; it = TREE_CHAIN (it))
+ {
+ ptr = simplify_replace_tree (ptr, TREE_VEC_ELT (it, 0),
+ TREE_VEC_ELT (it, 1));
+ ptr2 = simplify_replace_tree (ptr2, TREE_VEC_ELT (it, 0),
+ TREE_VEC_ELT (it, 1));
+ }
OMP_CLAUSE_SIZE (node3) = fold_build2 (MINUS_EXPR, ptrdiff_type_node,
ptr, ptr2);
}
@@ -4027,11 +4036,41 @@ 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))
+ if (OMP_CLAUSE_MAP_KIND (c) != GOMP_MAP_FIRSTPRIVATE_POINTER
+ && OMP_CLAUSE_MAP_KIND (c) !=
GOMP_MAP_FIRSTPRIVATE_REFERENCE)
+ 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;
+
location_t map_loc = gfc_get_location (&n->where);
bool always_modifier = false;
tree node = build_omp_clause (map_loc, OMP_CLAUSE_MAP);
@@ -4232,7 +4271,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,
@@ -4290,7 +4329,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);
@@ -4317,7 +4357,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;
}
@@ -4406,7 +4446,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,
@@ -4435,12 +4475,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;
}
}
@@ -4452,8 +4492,9 @@ 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)));
tree tmp = TREE_OPERAND (decl, 0);
- tmp = gfc_build_cond_assign_expr (block, present, tmp,
- null_pointer_node);
+ tmp = gfc_build_cond_assign_expr (&iter_block,
+ present, tmp,
+ null_pointer_node);
OMP_CLAUSE_DECL (node) = build_fold_indirect_ref (tmp);
}
else
@@ -4486,7 +4527,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;
}
if ((TREE_CODE (decl) != PARM_DECL
@@ -4502,7 +4543,8 @@ gfc_trans_omp_clauses (stmtblock_t *block,
gfc_omp_clauses *clauses,
tmp = DECL_P (decl) ? DECL_SIZE_UNIT (decl)
: TYPE_SIZE_UNIT (TREE_TYPE (decl));
tree var = gfc_create_var (TREE_TYPE (tmp), NULL);
- gfc_add_modify_loc (input_location, block, var, tmp);
+ gfc_add_modify_loc (input_location, &iter_block,
+ var, tmp);
OMP_CLAUSE_SIZE (node) = var;
gfc_allocate_lang_decl (var);
if (TREE_CODE (decl) == INDIRECT_REF)
@@ -4532,9 +4574,10 @@ 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,
- !openacc, k, node, node2,
- node3, node4);
+ gfc_trans_omp_array_section (&iter_block, op, n, decl,
+ element, !openacc, k,
+ node, node2, node3, node4,
+ iterator);
}
else if (n->expr
&& n->expr->expr_type == EXPR_VARIABLE
@@ -4550,12 +4593,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
@@ -4616,7 +4659,8 @@ gfc_trans_omp_clauses (stmtblock_t *block,
gfc_omp_clauses *clauses,
? DECL_SIZE_UNIT (se.expr)
: TYPE_SIZE_UNIT (TREE_TYPE (se.expr)));
tree var = gfc_create_var (TREE_TYPE (tmp), NULL);
- gfc_add_modify_loc (input_location, block, var, tmp);
+ gfc_add_modify_loc (input_location, &iter_block,
+ var, tmp);
OMP_CLAUSE_SIZE (node) = var;
gfc_allocate_lang_decl (var);
if (TREE_CODE (se.expr) == INDIRECT_REF)
@@ -4768,7 +4812,8 @@ gfc_trans_omp_clauses (stmtblock_t *block,
gfc_omp_clauses *clauses,
to ensure that it is not gimplified + is a decl.
*/
tree tmp = OMP_CLAUSE_SIZE (node);
tree var = gfc_create_var (TREE_TYPE (tmp), NULL);
- gfc_add_modify_loc (input_location, block, var, tmp);
+ gfc_add_modify_loc (input_location, &iter_block,
+ var, tmp);
OMP_CLAUSE_SIZE (node) = var;
gfc_allocate_lang_decl (var);
if (TREE_CODE (inner) == INDIRECT_REF)
@@ -4806,7 +4851,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);
@@ -4868,7 +4913,7 @@ gfc_trans_omp_clauses (stmtblock_t *block,
gfc_omp_clauses *clauses,
tree tmp = OMP_CLAUSE_SIZE (node);
tree var = gfc_create_var (TREE_TYPE (tmp),
NULL);
- gfc_add_modify_loc (map_loc, block,
+ gfc_add_modify_loc (map_loc, &iter_block,
var, tmp);
OMP_CLAUSE_SIZE (node) = var;
gfc_allocate_lang_decl (var);
@@ -4958,9 +5003,10 @@ 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,
- !openacc, kind, node, node2,
- node3, node4);
+ gfc_trans_omp_array_section (&iter_block, op, n, inner,
+ element, !openacc, kind,
+ node, node2, node3, node4,
+ iterator);
}
else
gcc_unreachable ();
@@ -4970,6 +5016,9 @@ 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);
@@ -4980,6 +5029,17 @@ 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))
+ if (OMP_CLAUSE_MAP_KIND (c) != GOMP_MAP_FIRSTPRIVATE_POINTER
+ && OMP_CLAUSE_MAP_KIND (c) !=
GOMP_MAP_FIRSTPRIVATE_REFERENCE)
+ 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 48d766138a4..52d0e11de8b 100644
--- a/gcc/gimplify.cc
+++ b/gcc/gimplify.cc
@@ -71,6 +71,7 @@ along with GCC; see the file COPYING3. If not see
#include "context.h"
#include "tree-nested.h"
#include "gcc-urlifier.h"
+#include "tree-ssa-loop-niter.h" /* For simplify_replace_tree. */
/* Identifier for a basic condition, mapping it to other basic conditions of
its Boolean expression. Basic conditions given the same uid (in the same
@@ -9667,10 +9668,17 @@ compute_omp_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);
@@ -9682,10 +9690,11 @@ compute_omp_iterator_count (tree it, gimple_seq *pre_p)
}
neg = fold_build2_loc (loc, TRUNC_DIV_EXPR, stype, neg, step);
step = NULL_TREE;
- tree cond = fold_build2_loc (loc, LT_EXPR, boolean_type_node, begin,
end);
+ tree_code cmp_op = lang_GNU_Fortran () ? LE_EXPR : LT_EXPR;
+ tree cond = fold_build2_loc (loc, cmp_op, boolean_type_node, begin, end);
pos = fold_build3_loc (loc, COND_EXPR, stype, cond, pos,
build_int_cst (stype, 0));
- cond = fold_build2_loc (loc, LT_EXPR, boolean_type_node, end, begin);
+ cond = fold_build2_loc (loc, cmp_op, boolean_type_node, end, begin);
neg = fold_build3_loc (loc, COND_EXPR, stype, cond, neg,
build_int_cst (stype, 0));
tree osteptype = TREE_TYPE (orig_step);
@@ -9714,6 +9723,7 @@ build_omp_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;
@@ -9725,6 +9735,7 @@ build_omp_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:
@@ -9735,9 +9746,9 @@ build_omp_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. */
@@ -9763,10 +9774,12 @@ build_omp_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);
@@ -9775,6 +9788,11 @@ build_omp_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;
@@ -9915,8 +9933,14 @@ remove_unused_omp_iterator_vars (tree *list_p)
i++;
}
}
+ tree old_block = TREE_VEC_ELT (OMP_CLAUSE_ITERATORS (c), 5);
tree new_block = make_node (BLOCK);
BLOCK_VARS (new_block) = new_vars;
+ if (BLOCK_SUBBLOCKS (old_block))
+ {
+ BLOCK_SUBBLOCKS (new_block) = BLOCK_SUBBLOCKS (old_block);
+ BLOCK_SUBBLOCKS (old_block) = NULL_TREE;
+ }
TREE_VEC_ELT (new_iters, 5) = new_block;
new_iterators.safe_push (new_iters);
iter_vars.safe_push (vars.copy ());
@@ -10579,6 +10603,27 @@ 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 found. */
+
+static tree
+contains_vars_1 (tree* tp, int *, void *)
+{
+ tree t = *tp;
+
+ if (TREE_CODE (t) != VAR_DECL)
+ return NULL_TREE;
+
+ return t;
+}
+
+/* Return true if there are any variables present in EXPR. */
+
+static bool
+contains_vars (tree expr)
+{
+ return walk_tree (&expr, contains_vars_1, NULL, 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
@@ -10589,7 +10634,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;
@@ -10599,6 +10645,19 @@ extract_base_bit_offset (tree base, poly_int64
*bitposp,
STRIP_NOPS (base);
+ if (iterator)
+ {
+ /* Replace any iterator variables with constant zero. This will give us
+ the nominal offset and bit position of the first element, which is
+ all we should need to lay out the mappings. The actual locations
+ of the iterated mappings are elsewhere.
+ E.g. "array[i].field" gives "16" (say), not "i * 32 + 16". */
+ tree it;
+ for (it = iterator; it; it = TREE_CHAIN (it))
+ base = simplify_replace_tree (base, TREE_VEC_ELT (it, 0),
+ TREE_VEC_ELT (it, 1));
+ }
+
base = get_inner_reference (base, &bitsize, &bitpos, &offset, &mode,
&unsignedp, &reversep, &volatilep);
@@ -10613,6 +10672,8 @@ extract_base_bit_offset (tree base, poly_int64 *bitposp,
{
poffset = 0;
*variable_offset = (offset != NULL_TREE);
+ if (iterator && *variable_offset)
+ *variable_offset = contains_vars (offset);
}
if (maybe_ne (bitpos, 0))
@@ -12418,8 +12479,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--)
@@ -12752,8 +12816,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/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..b4302aa7a73
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/target-map-iterators-2.f90
@@ -0,0 +1,33 @@
+! { dg-do compile }
+! { dg-options "-fopenmp -fdump-tree-gimple" }
+
+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-warning "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(i2=1:10, j2=1:20), from: x(i2)) ! { dg-warning
"iterator variable .j2. not used in clause expression" }
+ !$omp end target
+
+ !$omp target map(iterator(i3=1:10, j3=1:20, k3=1:30), to: x(i3+j3),
y(j3+k3), z(k3+i3))
+ !$omp end target
+ ! { dg-warning "iterator variable .i3. not used in clause expression" "" {
target *-*-* } .-2 }
+ ! { dg-warning "iterator variable .j3. not used in clause expression" "" {
target *-*-* } .-3 }
+ ! { dg-warning "iterator variable .k3. not used in clause expression" "" {
target *-*-* } .-4 }
+end program
+
+! { dg-final { scan-tree-dump-times "map\\\(to:x" 1 "gimple" } }
+! { dg-final { scan-tree-dump-times "map\\\(iterator\\\(integer\\\(kind=4\\\)
i2=1:10:1, loop_label=\[^\\\)\]+\\\):from:" 1 "gimple" } }
+! { dg-final { scan-tree-dump-times "map\\\(iterator\\\(integer\\\(kind=4\\\)
j3=1:20:1, integer\\\(kind=4\\\) i3=1:10:1, loop_label=\[^\\\)\]+\\\):to:" 1
"gimple" } }
+! { dg-final { scan-tree-dump-times "map\\\(iterator\\\(integer\\\(kind=4\\\)
k3=1:30:1, integer\\\(kind=4\\\) j3=1:20:1, loop_label=\[^\\\)\]+\\\):to:" 1
"gimple" } }
+! { dg-final { scan-tree-dump-times "map\\\(iterator\\\(integer\\\(kind=4\\\)
k3=1:30:1, integer\\\(kind=4\\\) i3=1:10:1, loop_label=\[^\\\)\]+\\\):to:" 1
"gimple" } }
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..7dad2a69c61
--- /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-gimple" }
+
+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 "gimple" } }
+! { dg-final { scan-tree-dump-times "if \\(i <= 27\\) goto <D\\\.\[0-9\]+>;
else goto <D\\\.\[0-9\]+>;" 1 "gimple" } }
+! { dg-final { scan-tree-dump-times "map\\(iterator\\(integer\\(kind=4\\)
i=1:17:1, loop_label=<D\\\.\[0-9\]+>, elems=omp_iter_data\\\.\[0-9\]+,
index=D\\.\[0-9\]+\\):to:MEM <\[^>\]+> \\\[\\\(\[^ \]+
\\\*\\\)D\\\.\[0-9\]+\\\]" 1 "gimple" } }
+! { dg-final { scan-tree-dump-times "map\\(iterator\\(integer\\(kind=4\\)
i=1:27:1, loop_label=<D\\\.\[0-9\]+>, elems=omp_iter_data\\\.\[0-9\]+,
index=D\\.\[0-9\]+\\):from:MEM <\[^>\]+> \\\[\\\(\[^ \]+
\\\*\\\)D\\\.\[0-9\]+\\\]" 1 "gimple" } }
+! { dg-final { scan-tree-dump-times "map\\(iterator\\(integer\\(kind=4\\)
i=1:17:1, loop_label=<D\\\.\[0-9\]+>, elems=omp_iter_data\\\.\[0-9\]+,
index=D\\.\[0-9\]+\\):attach:x\\\[D\\\.\[0-9\]+\\\]\.ptr\.data" 1 "gimple" } }
+! { dg-final { scan-tree-dump-times "map\\(iterator\\(integer\\(kind=4\\)
i=1:27:1, loop_label=<D\\\.\[0-9\]+>, elems=omp_iter_data\\\.\[0-9\]+,
index=D\\.\[0-9\]+\\):attach:y\\\[D\\\.\[0-9\]+\\\]\.ptr\.data" 1 "gimple" } }
diff --git a/gcc/testsuite/gfortran.dg/gomp/target-map-iterators-4.f90
b/gcc/testsuite/gfortran.dg/gomp/target-map-iterators-4.f90
new file mode 100644
index 00000000000..804b6861177
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/target-map-iterators-4.f90
@@ -0,0 +1,31 @@
+! { dg-do compile }
+! { dg-options "-fopenmp -fdump-tree-gimple" }
+
+module m
+ !$omp declare target (baz)
+ interface
+ subroutine baz (x, p)
+ integer, intent(in) :: x
+ integer, pointer :: p(:)
+ end subroutine
+ integer function bar (x, i)
+ integer :: x, i
+ end function
+ end interface
+contains
+ subroutine foo (x, p)
+ integer :: x
+ integer, pointer :: p(:)
+
+ !$omp target map (iterator (i=1:4), to: p(bar (x, i)))
+ ! FIXME: These warnings are due to implicit clauses generated that do
+ ! not use the iterator variable i.
+ ! { dg-warning "iterator variable .i. not used in clause expression" ""
{ target *-*-* } .-3 }
+ call baz (x, p)
+ !$omp end target
+ end subroutine
+end module
+
+! { dg-final { scan-tree-dump "firstprivate\\\(x\\\)" "gimple" } }
+! { dg-final { scan-tree-dump-times "bar \\\(x, &" 2 "gimple" } }
+! { dg-final { scan-tree-dump "map\\\(iterator\\\(integer\\\(kind=4\\\)
i=1:4:1, loop_label=" "gimple" } }
diff --git a/gcc/tree-pretty-print.cc b/gcc/tree-pretty-print.cc
index c19babadead..6ccb52d8eaf 100644
--- a/gcc/tree-pretty-print.cc
+++ b/gcc/tree-pretty-print.cc
@@ -1807,7 +1807,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 79def88226e..8180178fd83 100644
--- a/libgomp/target.c
+++ b/libgomp/target.c
@@ -1021,10 +1021,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
@@ -1065,33 +1103,35 @@ 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];
+ size_t idx_i = new_idx;
+
+ 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[idx_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[idx_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..d62fc1deeeb
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/target-map-iterators-3.f90
@@ -0,0 +1,56 @@
+! { 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, k
+
+ expected = mkarrays ()
+
+ !$omp target map(iterator(i=0:DIM1/4-1, j=0:3), to: x(f (i, j))%arr(:)) &
+ !$omp map(iterator(k=1:DIM1), to: y(k)%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
+
+ 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
--
2.43.0
