https://gcc.gnu.org/g:57f73c3956572f30f3e0f7a350d958985b11daa5
commit r15-9707-g57f73c3956572f30f3e0f7a350d958985b11daa5
Author: Tobias Burnus <tbur...@baylibre.com>
Date: Thu May 15 09:15:21 2025 +0200
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.
(cherry picked from commit f99017c3125f4400cf6a098cf5b33d32fe3e6645)
Diff:
---
gcc/fortran/trans-openmp.cc | 20 ++++++
libgomp/testsuite/libgomp.fortran/alloc-comp-4.f90 | 75 ++++++++++++++++++++++
2 files changed, 95 insertions(+)
diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc
index 0b8150fb9777..2a48d4af5276 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 000000000000..d5e982ba1a81
--- /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
