https://gcc.gnu.org/g:55c86c6cb2ef2a028a33b1dcaa39169355caba1a
commit r16-7647-g55c86c6cb2ef2a028a33b1dcaa39169355caba1a Author: Paul-Antoine Arras <[email protected]> Date: Fri Feb 20 14:21:55 2026 +0100 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. Diff: --- gcc/gimplify.cc | 46 ++++-- gcc/testsuite/gfortran.dg/gomp/map-subarray-4.f90 | 34 +++++ .../testsuite/libgomp.fortran/map-subarray-12.f90 | 167 +++++++++++++++++++++ 3 files changed, 232 insertions(+), 15 deletions(-) diff --git a/gcc/gimplify.cc b/gcc/gimplify.cc index c871fe7c5765..ea689e9f7340 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 000000000000..31db184733bc --- /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 000000000000..c44beb7e4ec9 --- /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
