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.
This commit is contained in:
Tobias Burnus
2025-05-15 09:15:21 +02:00
parent d010a39b9e
commit f99017c312
2 changed files with 95 additions and 0 deletions

View File

@@ -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)

View File

@@ -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