The testcase was found when looking at mapping fails with
SPEC HPC's 619.clvleaf_s; however, the variant fixed by the
attached patch only showed up when experimenting and not
in the SPEC testcase itself.
Before the included fix, to be added testcase failed with
an ICE.
I intent to commit the attached patch tomorrow,
unless there are comments or suggestions.
Thanks,
Tobias
OpenMP/Fortran: Fix allocatable-component mapping of derived-type array comps
The check whether the location expression in map clause has allocatable
components was failing for some derived-type array expressions such as
map(var%tiles(1))
as the compiler produced
_4 = var.tiles;
MEMREF(_4, _5);
This commit now also handles this case.
gcc/fortran/ChangeLog:
* trans-openmp.cc (gfc_omp_deep_mapping_do): Handle SSA_NAME if
a def_stmt is available.
libgomp/ChangeLog:
* testsuite/libgomp.fortran/alloc-comp-4.f90: New test.
diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc
index 0b8150fb977..2a48d4af527 100644
--- a/gcc/fortran/trans-openmp.cc
+++ b/gcc/fortran/trans-openmp.cc
@@ -2478,6 +2478,26 @@ gfc_omp_deep_mapping_do (bool is_cnt, const gimple *ctx, tree clause,
else
while (TREE_CODE (tmp) == COMPONENT_REF || TREE_CODE (tmp) == ARRAY_REF)
tmp = TREE_OPERAND (tmp, TREE_CODE (tmp) == COMPONENT_REF ? 1 : 0);
+ if (TREE_CODE (tmp) == MEM_REF)
+ tmp = TREE_OPERAND (tmp, 0);
+ if (TREE_CODE (tmp) == SSA_NAME)
+ {
+ gimple *def_stmt = SSA_NAME_DEF_STMT (tmp);
+ if (gimple_code (def_stmt) == GIMPLE_ASSIGN)
+ {
+ tmp = gimple_assign_rhs1 (def_stmt);
+ if (poly)
+ {
+ tmp = TYPE_FIELDS (type);
+ type = TREE_TYPE (tmp);
+ }
+ else
+ while (TREE_CODE (tmp) == COMPONENT_REF
+ || TREE_CODE (tmp) == ARRAY_REF)
+ tmp = TREE_OPERAND (tmp,
+ TREE_CODE (tmp) == COMPONENT_REF ? 1 : 0);
+ }
+ }
/* If the clause argument is nonallocatable, skip is-allocate check. */
if (GFC_DECL_GET_SCALAR_ALLOCATABLE (tmp)
|| GFC_DECL_GET_SCALAR_POINTER (tmp)
diff --git a/libgomp/testsuite/libgomp.fortran/alloc-comp-4.f90 b/libgomp/testsuite/libgomp.fortran/alloc-comp-4.f90
new file mode 100644
index 00000000000..d5e982ba1a8
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/alloc-comp-4.f90
@@ -0,0 +1,75 @@
+!
+! Check that mapping with map(var%tiles(1)) works.
+!
+! This uses deep mapping to handle the allocatable
+! derived-type components
+!
+! The tricky part is that GCC generates intermittently
+! an SSA_NAME that needs to be resolved.
+!
+module m
+type t
+ integer, allocatable :: den1(:,:), den2(:,:)
+end type t
+
+type t2
+ type(t), allocatable :: tiles(:)
+end type t2
+end
+
+use m
+use iso_c_binding
+implicit none (type, external)
+type(t2), target :: var
+logical :: is_self_map
+type(C_ptr) :: pden1, pden2, ptiles, ptiles1
+
+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])
+
+ptiles = c_loc(var%tiles)
+ptiles1 = c_loc(var%tiles(1))
+pden1 = c_loc(var%tiles(1)%den1)
+pden2 = c_loc(var%tiles(1)%den2)
+
+
+is_self_map = .false.
+!$omp target map(to: is_self_map)
+ is_self_map = .true.
+!$omp end target
+
+!$omp target enter data map(var%tiles(1))
+
+!$omp target firstprivate(ptiles, ptiles1, pden1, pden2)
+ 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 2
+ var%tiles(1)%den1 = var%tiles(1)%den1 + 5
+ var%tiles(1)%den2 = var%tiles(1)%den2 + 7
+
+ if (is_self_map) then
+ if (.not. c_associated (ptiles, c_loc(var%tiles))) stop 3
+ if (.not. c_associated (ptiles1, c_loc(var%tiles(1)))) stop 4
+ if (.not. c_associated (pden1, c_loc(var%tiles(1)%den1))) stop 5
+ if (.not. c_associated (pden2, c_loc(var%tiles(1)%den2))) stop 6
+ else
+ if (c_associated (ptiles, c_loc(var%tiles))) stop 3
+ if (c_associated (ptiles1, c_loc(var%tiles(1)))) stop 4
+ if (c_associated (pden1, c_loc(var%tiles(1)%den1))) stop 5
+ if (c_associated (pden2, c_loc(var%tiles(1)%den2))) stop 6
+ endif
+!$omp end target
+
+if (is_self_map) then
+ if (any (var%tiles(1)%den1 /= 5 + reshape([1,2,3,4],[2,2]))) stop 7
+ if (any (var%tiles(1)%den2 /= 7 + reshape([11,22,33,44],[2,2]))) stop 8
+else
+ if (any (var%tiles(1)%den1 /= reshape([1,2,3,4],[2,2]))) stop 7
+ if (any (var%tiles(1)%den2 /= reshape([11,22,33,44],[2,2]))) stop 8
+endif
+
+!$omp target exit data map(var%tiles(1))
+
+if (any (var%tiles(1)%den1 /= 5 + reshape([1,2,3,4],[2,2]))) stop 7
+if (any (var%tiles(1)%den2 /= 7 + reshape([11,22,33,44],[2,2]))) stop 8
+end
