mirror of
https://forge.sourceware.org/marek/gcc.git
synced 2026-02-22 03:47:02 -05:00
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:
@@ -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)
|
||||
|
||||
75
libgomp/testsuite/libgomp.fortran/alloc-comp-4.f90
Normal file
75
libgomp/testsuite/libgomp.fortran/alloc-comp-4.f90
Normal 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
|
||||
Reference in New Issue
Block a user