On 16/02/2026 16:49, Tobias Burnus wrote:
Paul-Antoine Arras wrote:
This is a follow-up to r16-5789-g05c2ad4a2e7104.
Consider the following code, assuming tiles is allocatable:
type t
integer, allocatable :: den1(:,:), den2(:,:)
end type t
[...]
!$omp target enter data map(var%tiles(1)%den2, var%tiles(1)%den1)
r16-5789-g05c2ad4a2e7104 allowed mapping several components from the same
allocatable derived type, provided they are in the right order in user
code.
This patch relaxes this constraint by computing offsets and sorting
to-be-mapped
components at gimplification time.
PR fortran/120505
gcc/ChangeLog:
* gimplify.cc (omp_accumulate_sibling_list): When the containing
struct
is a Fortran array descriptor, sort mapped components by offset.
libgomp/ChangeLog:
* testsuite/libgomp.fortran/map-subarray-12.f90: New test.
gcc/testsuite/ChangeLog:
* gfortran.dg/gomp/map-subarray-4.f90: New test.
LGTM – however, I think it would be good if at least one of the
testcases could be made a bit more through/robust:
Currently, only two elements are checked for being in order – I think it
would be better to check for a handful, added to the map clauses in
random order (and possibly skipping one or two).
The attached revised patch has an extended libgomp test
map-subarray-12.f90 that covers several of those more complex scenarios.
Additionally, it might help to add a comment like 'sort mapped
components by offset' in the 'if (has_descriptor)' block to make it
easier to follow that the code does.
Added comment as suggested.
Otherwise, the patch the patch seems to be fine to me.
Sorry for the slow review!
Tobias
Is it OK for trunk like this?
Thanks,
--
PA
From 1edc06c40b112ba5e4a7aa1419007ba678d4bf40 Mon Sep 17 00:00:00 2001
From: Paul-Antoine Arras <[email protected]>
Date: Tue, 2 Dec 2025 18:56:18 +0100
Subject: [PATCH] OpenMP/Fortran: Enforce component order when mapping
allocatable DT [PR120505]
This is a follow-up to r16-5789-g05c2ad4a2e7104.
Consider the following code, assuming tiles is allocatable:
type t
integer, allocatable :: den1(:,:), den2(:,:)
end type t
[...]
!$omp target enter data map(var%tiles(1)%den2, var%tiles(1)%den1)
r16-5789-g05c2ad4a2e7104 allowed mapping several components from the same
allocatable derived type, provided they are in the right order in user code.
This patch relaxes this constraint by computing offsets and sorting to-be-mapped
components at gimplification time.
PR fortran/120505
gcc/ChangeLog:
* gimplify.cc (omp_accumulate_sibling_list): When the containing struct
is a Fortran array descriptor, sort mapped components by offset.
libgomp/ChangeLog:
* testsuite/libgomp.fortran/map-subarray-12.f90: New test.
gcc/testsuite/ChangeLog:
* gfortran.dg/gomp/map-subarray-4.f90: New test.
---
gcc/gimplify.cc | 46 +++--
.../gfortran.dg/gomp/map-subarray-4.f90 | 34 ++++
.../libgomp.fortran/map-subarray-12.f90 | 167 ++++++++++++++++++
3 files changed, 232 insertions(+), 15 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/gomp/map-subarray-4.f90
create mode 100644 libgomp/testsuite/libgomp.fortran/map-subarray-12.f90
diff --git a/gcc/gimplify.cc b/gcc/gimplify.cc
index c871fe7c576..ea689e9f734 100644
--- a/gcc/gimplify.cc
+++ b/gcc/gimplify.cc
@@ -12937,10 +12937,6 @@ omp_accumulate_sibling_list (enum omp_region_type region_type,
{
tree *osc = struct_map_to_clause->get (base);
tree *sc = NULL, *scp = NULL;
- bool unordered = false;
-
- if (osc && OMP_CLAUSE_MAP_KIND (*osc) == GOMP_MAP_STRUCT_UNORD)
- unordered = true;
unsigned HOST_WIDE_INT i, elems = tree_to_uhwi (OMP_CLAUSE_SIZE (*osc));
sc = &OMP_CLAUSE_CHAIN (*osc);
@@ -12992,8 +12988,37 @@ omp_accumulate_sibling_list (enum omp_region_type region_type,
if (variable_offset2)
{
OMP_CLAUSE_SET_MAP_KIND (*osc, GOMP_MAP_STRUCT_UNORD);
- unordered = true;
- break;
+
+ if (has_descriptor)
+ {
+ /* Sort mapped components by offset. This is needed for
+ libgomp to handle Fortran derived-type allocatable
+ components transparently. */
+
+ poly_int64 bitsize;
+ tree offset, coffset;
+ machine_mode mode;
+ int unsignedp, reversep, volatilep;
+ tree inner_ref1
+ = get_inner_reference (sc_decl, &bitsize, &bitpos,
+ &offset, &mode, &unsignedp,
+ &reversep, &volatilep);
+ tree osc_decl = ocd;
+ STRIP_NOPS (osc_decl);
+ tree inner_ref2
+ = get_inner_reference (osc_decl, &bitsize, &bitpos,
+ &coffset, &mode, &unsignedp,
+ &reversep, &volatilep);
+ gcc_assert (operand_equal_p (inner_ref1, inner_ref2, 0));
+ tree offset_diff
+ = fold_binary_to_constant (MINUS_EXPR, size_type_node,
+ coffset, offset);
+ if (offset_diff == NULL_TREE
+ || TREE_INT_CST_ELT (offset_diff, 0) > 0)
+ continue;
+ else
+ break;
+ }
}
else if ((region_type & ORT_ACC) != 0)
{
@@ -13027,15 +13052,6 @@ omp_accumulate_sibling_list (enum omp_region_type region_type,
}
}
- /* If this is an unordered struct, just insert the new element at the
- end of the list. */
- if (unordered)
- {
- for (; i < elems; i++)
- sc = &OMP_CLAUSE_CHAIN (*sc);
- scp = NULL;
- }
-
OMP_CLAUSE_SIZE (*osc)
= size_binop (PLUS_EXPR, OMP_CLAUSE_SIZE (*osc), size_one_node);
diff --git a/gcc/testsuite/gfortran.dg/gomp/map-subarray-4.f90 b/gcc/testsuite/gfortran.dg/gomp/map-subarray-4.f90
new file mode 100644
index 00000000000..31db184733b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/map-subarray-4.f90
@@ -0,0 +1,34 @@
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-gimple" }
+
+! PR fortran/120505
+
+! Check that struct components are mapped in increasing address order.
+
+module m
+type t
+ integer, allocatable :: den1(:,:), den2(:,:)
+end type t
+
+type t2
+ type(t), allocatable :: tiles(:)
+end type t2
+
+type(t2) :: var
+end
+
+use m
+
+allocate(var%tiles(1))
+var%tiles(1)%den1 = reshape([1,2,3,4],[2,2])
+var%tiles(1)%den2 = reshape([11,22,33,44],[2,2])
+
+!$omp target enter data map(var%tiles(1)%den2, var%tiles(1)%den1)
+
+! { dg-final { scan-tree-dump { map\(struct_unord:MEM <struct t\[0:\]> \[\(struct t\[0:\] \*\)_[0-9]+\] \[len: 2\]\) map\(to:MEM <struct t\[0:\]> \[\(struct t\[0:\] \*\)_[0-9]+\]\[_[0-9]+\]\.den1 \[pointer set, len: 88\]\) map\(to:MEM <struct t\[0:\]> \[\(struct t\[0:\] \*\)_[0-9]+\]\[_[0-9]+\]\.den2 \[pointer set, len: 88\]\) } "gimple" } }
+
+!$omp target exit data map(var%tiles(1)%den2, var%tiles(1)%den1)
+
+! { dg-final { scan-tree-dump { map\(release:MEM <struct t\[0:\]> \[\(struct t\[0:\] \*\)_[0-9]+\]\[_[0-9]+\]\.den1 \[pointer set, len: 88\]\) map\(release:MEM <struct t\[0:\]> \[\(struct t\[0:\] \*\)_[0-9]+\]\[_[0-9]+\]\.den2 \[pointer set, len: 88\]\) } "gimple" } }
+
+end
diff --git a/libgomp/testsuite/libgomp.fortran/map-subarray-12.f90 b/libgomp/testsuite/libgomp.fortran/map-subarray-12.f90
new file mode 100644
index 00000000000..c44beb7e4ec
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/map-subarray-12.f90
@@ -0,0 +1,167 @@
+! { dg-do run }
+
+! PR fortran/120505
+
+! Check that struct components are mapped in increasing address order.
+
+module m
+ type t
+ integer, allocatable :: den1(:,:), den2(:,:), den3(:,:)
+ real, allocatable :: data1(:), data2(:)
+ end type t
+
+ type t2
+ type(t), allocatable :: tiles(:)
+ end type t2
+
+ type(t2) :: var
+contains
+ ! Helper subroutine to validate array contents
+ subroutine validate_arrays(test_id, expect_den1, expect_den2, expect_den3, &
+ expect_data1, expect_data2)
+ integer :: test_id, i, j
+ integer, intent(in) :: expect_den1(:,:), expect_den2(:,:), expect_den3(:,:)
+ real, intent(in) :: expect_data1(:), expect_data2(:)
+
+ if (any (var%tiles(1)%den1 /= expect_den1)) then
+ print *, "Test", test_id, ": den1 mismatch"
+ stop 1
+ end if
+ if (any (var%tiles(1)%den2 /= expect_den2)) then
+ print *, "Test", test_id, ": den2 mismatch"
+ stop 1
+ end if
+ if (any (var%tiles(1)%den3 /= expect_den3)) then
+ print *, "Test", test_id, ": den3 mismatch"
+ stop 1
+ end if
+ if (any (abs(var%tiles(1)%data1 - expect_data1) > 1.0e-6)) then
+ print *, "Test", test_id, ": data1 mismatch"
+ stop 1
+ end if
+ if (any (abs(var%tiles(1)%data2 - expect_data2) > 1.0e-2)) then
+ print *, "Test", test_id, ": data2 mismatch"
+ stop 1
+ end if
+ end subroutine validate_arrays
+end module m
+
+use m
+
+! Initialize test data
+allocate(var%tiles(1))
+var%tiles(1)%den1 = reshape([1,2,3,4],[2,2])
+var%tiles(1)%den2 = reshape([11,22,33,44],[2,2])
+var%tiles(1)%den3 = reshape([111,222,333,444],[2,2])
+var%tiles(1)%data1 = [1.5, 2.5, 3.5]
+var%tiles(1)%data2 = [10.1, 20.2, 30.3]
+
+! ========== TEST 1: Reverse mapping order (den2, den3, den1, data2, data1) ==========
+!$omp target enter data map(var%tiles(1)%den2, var%tiles(1)%den3, &
+!$omp& var%tiles(1)%den1, var%tiles(1)%data2, &
+!$omp& var%tiles(1)%data1)
+
+!$omp target
+ if (any (var%tiles(1)%den1 /= reshape([1,2,3,4],[2,2]))) stop 1
+ if (any (var%tiles(1)%den2 /= reshape([11,22,33,44],[2,2]))) stop 1
+ if (any (var%tiles(1)%den3 /= reshape([111,222,333,444],[2,2]))) stop 1
+ if (any (abs(var%tiles(1)%data1 - [1.5, 2.5, 3.5]) > 1.0e-6)) stop 1
+ if (any (abs(var%tiles(1)%data2 - [10.1, 20.2, 30.3]) > 1.0e-6)) stop 1
+
+ var%tiles(1)%den1 = var%tiles(1)%den1 + 5
+ var%tiles(1)%den2 = var%tiles(1)%den2 + 7
+ var%tiles(1)%den3 = var%tiles(1)%den3 + 9
+ var%tiles(1)%data1 = var%tiles(1)%data1 * 2.0
+ var%tiles(1)%data2 = var%tiles(1)%data2 * 3.0
+!$omp end target
+
+!$omp target exit data map(var%tiles(1)%den2, var%tiles(1)%den3, &
+!$omp& var%tiles(1)%den1, var%tiles(1)%data2, &
+!$omp& var%tiles(1)%data1)
+
+call validate_arrays(1, &
+ reshape([6,7,8,9],[2,2]), reshape([18,29,40,51],[2,2]), reshape([120,231,342,453],[2,2]), &
+ [3.0, 5.0, 7.0], [30.3, 60.6, 90.9])
+
+! Reset data
+var%tiles(1)%den1 = reshape([1,2,3,4],[2,2])
+var%tiles(1)%den2 = reshape([11,22,33,44],[2,2])
+var%tiles(1)%den3 = reshape([111,222,333,444],[2,2])
+var%tiles(1)%data1 = [1.5, 2.5, 3.5]
+var%tiles(1)%data2 = [10.1, 20.2, 30.3]
+
+! ========== TEST 2: Different permutation (den3, data1, den1, den2, data2) ==========
+!$omp target enter data map(var%tiles(1)%den3, var%tiles(1)%data1, &
+!$omp& var%tiles(1)%den1, var%tiles(1)%den2, &
+!$omp& var%tiles(1)%data2)
+
+!$omp target
+ var%tiles(1)%den1 = var%tiles(1)%den1 * 2
+ var%tiles(1)%den2 = var%tiles(1)%den2 * 2
+ var%tiles(1)%den3 = var%tiles(1)%den3 * 2
+ var%tiles(1)%data1 = var%tiles(1)%data1 + 100.0
+ var%tiles(1)%data2 = var%tiles(1)%data2 + 100.0
+!$omp end target
+
+!$omp target exit data map(var%tiles(1)%den3, var%tiles(1)%data1, &
+!$omp& var%tiles(1)%den1, var%tiles(1)%den2, &
+!$omp& var%tiles(1)%data2)
+
+call validate_arrays(2, &
+ reshape([2,4,6,8],[2,2]), reshape([22,44,66,88],[2,2]), reshape([222,444,666,888],[2,2]), &
+ [101.5, 102.5, 103.5], [110.1, 120.2, 130.3])
+
+! Reset data
+var%tiles(1)%den1 = reshape([1,2,3,4],[2,2])
+var%tiles(1)%den2 = reshape([11,22,33,44],[2,2])
+var%tiles(1)%den3 = reshape([111,222,333,444],[2,2])
+var%tiles(1)%data1 = [1.5, 2.5, 3.5]
+var%tiles(1)%data2 = [10.1, 20.2, 30.3]
+
+! ========== TEST 3: Subset of components mapped (den2, data1 only) ==========
+!$omp target enter data map(var%tiles(1)%data1, var%tiles(1)%den2)
+
+!$omp target
+ if (any (var%tiles(1)%den2 /= reshape([11,22,33,44],[2,2]))) stop 1
+ if (any (abs(var%tiles(1)%data1 - [1.5, 2.5, 3.5]) > 1.0e-6)) stop 1
+
+ var%tiles(1)%den2 = var%tiles(1)%den2 - 3
+ var%tiles(1)%data1 = var%tiles(1)%data1 * 10.0
+!$omp end target
+
+!$omp target exit data map(var%tiles(1)%data1, var%tiles(1)%den2)
+
+call validate_arrays(3, &
+ reshape([1,2,3,4],[2,2]), reshape([8,19,30,41],[2,2]), reshape([111,222,333,444],[2,2]), &
+ [15.0, 25.0, 35.0], [10.1, 20.2, 30.3])
+
+! Reset data
+var%tiles(1)%den1 = reshape([1,2,3,4],[2,2])
+var%tiles(1)%den2 = reshape([11,22,33,44],[2,2])
+var%tiles(1)%den3 = reshape([111,222,333,444],[2,2])
+var%tiles(1)%data1 = [1.5, 2.5, 3.5]
+var%tiles(1)%data2 = [10.1, 20.2, 30.3]
+
+! ========== TEST 4: Enter and exit maps in different orders ==========
+!$omp target enter data map(var%tiles(1)%den1, var%tiles(1)%den3, &
+!$omp& var%tiles(1)%data2)
+
+!$omp target
+ if (any (var%tiles(1)%den1 /= reshape([1,2,3,4],[2,2]))) stop 1
+ if (any (var%tiles(1)%den3 /= reshape([111,222,333,444],[2,2]))) stop 1
+ if (any (abs(var%tiles(1)%data2 - [10.1, 20.2, 30.3]) > 1.0e-2)) stop 1
+
+ var%tiles(1)%den1 = var%tiles(1)%den1 * 3
+ var%tiles(1)%den3 = var%tiles(1)%den3 + 50
+ var%tiles(1)%data2 = var%tiles(1)%data2 * 2.0
+!$omp end target
+
+!$omp target exit data map(var%tiles(1)%data2, var%tiles(1)%den3, &
+!$omp& var%tiles(1)%den1)
+
+call validate_arrays(4, &
+ reshape([3,6,9,12],[2,2]), reshape([11,22,33,44],[2,2]), reshape([161,272,383,494],[2,2]), &
+ [1.5, 2.5, 3.5], [20.2, 40.4, 60.6])
+
+print *, "All tests passed!"
+end
--
2.51.0
