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:\] \*\)_[0-9]+\] \[len: 2\]\) map\(to:MEM \[\(struct t\[0:\] \*\)_[0-9]+\]\[_[0-9]+\]\.den1 \[pointer set, len: 88\]\) map\(to:MEM \[\(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:\] \*\)_[0-9]+\]\[_[0-9]+\]\.den1 \[pointer set, len: 88\]\) map\(release:MEM \[\(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