mirror of
https://github.com/gcc-mirror/gcc.git
synced 2026-05-06 14:59:39 +02:00
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.
This commit is contained in:
Paul-Antoine Arras
@@ -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);
|
||||
|
||||
|
||||
34
gcc/testsuite/gfortran.dg/gomp/map-subarray-4.f90
Normal file
34
gcc/testsuite/gfortran.dg/gomp/map-subarray-4.f90
Normal file
@@ -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
|
||||
167
libgomp/testsuite/libgomp.fortran/map-subarray-12.f90
Normal file
167
libgomp/testsuite/libgomp.fortran/map-subarray-12.f90
Normal file
@@ -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
|
||||
Reference in New Issue
Block a user