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 --git a/gcc/gimplify.cc b/gcc/gimplify.cc
index c871fe7c57659229d88617ab3bf8b6ac2c99d1e7..ea689e9f7340838a70bff53545f0cd3453ff2894 100644 (file)
--- 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 (file)
index 0000000..31db184
--- /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 (file)
index 0000000..c44beb7
--- /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