OpenMP: Fix use_device_{addr,ptr} with in-data-sharing arg
For array-descriptor vars, the descriptor is assigned to a temporary. However,
this failed when the clause's argument was in turn in a data-sharing clause
as the outer context's VALUE_EXPR wasn't used.
gcc/ChangeLog:
* omp-low.cc (lower_omp_target): Fix use_device_{addr,ptr} with list
item that is in an outer data-sharing clause.
libgomp/ChangeLog:
* testsuite/libgomp.fortran/use_device_addr-5.f90: New test.
This commit is contained in:
Tobias Burnus
parent
79a1a01cbd
commit
3f8c389fe9
|
|
@ -13657,26 +13657,26 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx)
|
|||
new_var = lookup_decl (var, ctx);
|
||||
new_var = DECL_VALUE_EXPR (new_var);
|
||||
tree v = new_var;
|
||||
tree v2 = var;
|
||||
if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_USE_DEVICE_PTR
|
||||
|| OMP_CLAUSE_CODE (c) == OMP_CLAUSE_USE_DEVICE_ADDR)
|
||||
v2 = maybe_lookup_decl_in_outer_ctx (var, ctx);
|
||||
|
||||
if (is_ref)
|
||||
{
|
||||
var = build_fold_indirect_ref (var);
|
||||
gimplify_expr (&var, &assign_body, NULL, is_gimple_val,
|
||||
fb_rvalue);
|
||||
v = create_tmp_var_raw (TREE_TYPE (var), get_name (var));
|
||||
v2 = build_fold_indirect_ref (v2);
|
||||
v = create_tmp_var_raw (TREE_TYPE (v2), get_name (var));
|
||||
gimple_add_tmp_var (v);
|
||||
TREE_ADDRESSABLE (v) = 1;
|
||||
gimple_seq_add_stmt (&assign_body,
|
||||
gimple_build_assign (v, var));
|
||||
gimplify_assign (v, v2, &assign_body);
|
||||
tree rhs = build_fold_addr_expr (v);
|
||||
gimple_seq_add_stmt (&assign_body,
|
||||
gimple_build_assign (new_var, rhs));
|
||||
}
|
||||
else
|
||||
gimple_seq_add_stmt (&assign_body,
|
||||
gimple_build_assign (new_var, var));
|
||||
gimplify_assign (new_var, v2, &assign_body);
|
||||
|
||||
tree v2 = lang_hooks.decls.omp_array_data (unshare_expr (v), false);
|
||||
v2 = lang_hooks.decls.omp_array_data (unshare_expr (v), false);
|
||||
gcc_assert (v2);
|
||||
gimplify_expr (&x, &assign_body, NULL, is_gimple_val, fb_rvalue);
|
||||
gimple_seq_add_stmt (&assign_body,
|
||||
|
|
|
|||
|
|
@ -0,0 +1,143 @@
|
|||
program main
|
||||
use omp_lib
|
||||
implicit none
|
||||
integer, allocatable :: aaa(:,:,:)
|
||||
integer :: i
|
||||
|
||||
allocate (aaa(-4:10,-3:8,2))
|
||||
aaa(:,:,:) = reshape ([(i, i = 1, size(aaa))], shape(aaa))
|
||||
|
||||
do i = 0, omp_get_num_devices()
|
||||
!$omp target data map(to: aaa)
|
||||
call test_addr (aaa, i)
|
||||
call test_ptr (aaa, i)
|
||||
!$omp end target data
|
||||
end do
|
||||
deallocate (aaa)
|
||||
|
||||
contains
|
||||
|
||||
subroutine test_addr (aaaa, dev)
|
||||
use iso_c_binding
|
||||
integer, target, allocatable :: aaaa(:,:,:), bbbb(:,:,:)
|
||||
integer, value :: dev
|
||||
integer :: i
|
||||
type(c_ptr) :: ptr
|
||||
logical :: is_shared
|
||||
|
||||
is_shared = .false.
|
||||
!$omp target device(dev) map(to: is_shared)
|
||||
is_shared = .true.
|
||||
!$omp end target
|
||||
|
||||
allocate (bbbb(-4:10,-3:8,2))
|
||||
bbbb(:,:,:) = reshape ([(-i, i = 1, size(bbbb))], shape(bbbb))
|
||||
!$omp target enter data map(to: bbbb) device(dev)
|
||||
if (any (lbound (aaaa) /= [-4, -3, 1])) error stop 1
|
||||
if (any (shape (aaaa) /= [15, 12, 2])) error stop 2
|
||||
if (any (lbound (bbbb) /= [-4, -3, 1])) error stop 3
|
||||
if (any (shape (bbbb) /= [15, 12, 2])) error stop 4
|
||||
if (any (aaaa /= -bbbb)) error stop 5
|
||||
if (any (aaaa /= reshape ([(i, i = 1, size(aaaa))], shape(aaaa)))) &
|
||||
error stop 6
|
||||
|
||||
!$omp parallel do shared(bbbb, aaaa)
|
||||
do i = 1,1
|
||||
if (any (lbound (aaaa) /= [-4, -3, 1])) error stop 5
|
||||
if (any (shape (aaaa) /= [15, 12, 2])) error stop 6
|
||||
if (any (lbound (bbbb) /= [-4, -3, 1])) error stop 7
|
||||
if (any (shape (bbbb) /= [15, 12, 2])) error stop 8
|
||||
if (any (aaaa /= -bbbb)) error stop 5
|
||||
if (any (aaaa /= reshape ([(i, i = 1, size(aaaa))], shape(aaaa)))) &
|
||||
error stop 6
|
||||
ptr = c_loc (aaaa)
|
||||
!$omp target data use_device_addr(bbbb, aaaa) device(dev)
|
||||
if (any (lbound (aaaa) /= [-4, -3, 1])) error stop 9
|
||||
if (any (shape (aaaa) /= [15, 12, 2])) error stop 10
|
||||
if (any (lbound (bbbb) /= [-4, -3, 1])) error stop 11
|
||||
if (any (shape (bbbb) /= [15, 12, 2])) error stop 12
|
||||
if (is_shared) then
|
||||
if (any (aaaa /= -bbbb)) error stop 5
|
||||
if (any (aaaa /= reshape ([(i, i = 1, size(aaaa))], shape(aaaa)))) &
|
||||
error stop 6
|
||||
end if
|
||||
if (is_shared .neqv. c_associated (ptr, c_loc (aaaa))) error stop
|
||||
|
||||
!$omp target has_device_addr(bbbb, aaaa) device(dev)
|
||||
if (any (lbound (aaaa) /= [-4, -3, 1])) error stop 9
|
||||
if (any (shape (aaaa) /= [15, 12, 2])) error stop 10
|
||||
if (any (lbound (bbbb) /= [-4, -3, 1])) error stop 11
|
||||
if (any (shape (bbbb) /= [15, 12, 2])) error stop 12
|
||||
if (any (aaaa /= -bbbb)) error stop 5
|
||||
if (any (aaaa /= reshape ([(i, i = 1, size(aaaa))], shape(aaaa)))) &
|
||||
error stop 6
|
||||
!$omp end target
|
||||
!$omp end target data
|
||||
end do
|
||||
!$omp target exit data map(delete: bbbb) device(dev)
|
||||
deallocate (bbbb)
|
||||
end subroutine test_addr
|
||||
|
||||
subroutine test_ptr (aaaa, dev)
|
||||
use iso_c_binding
|
||||
integer, target, allocatable :: aaaa(:,:,:), bbbb(:,:,:)
|
||||
integer, value :: dev
|
||||
integer :: i
|
||||
type(c_ptr) :: ptr
|
||||
logical :: is_shared
|
||||
|
||||
is_shared = .false.
|
||||
!$omp target device(dev) map(to: is_shared)
|
||||
is_shared = .true.
|
||||
!$omp end target
|
||||
|
||||
allocate (bbbb(-4:10,-3:8,2))
|
||||
bbbb(:,:,:) = reshape ([(-i, i = 1, size(bbbb))], shape(bbbb))
|
||||
!$omp target enter data map(to: bbbb) device(dev)
|
||||
if (any (lbound (aaaa) /= [-4, -3, 1])) error stop 1
|
||||
if (any (shape (aaaa) /= [15, 12, 2])) error stop 2
|
||||
if (any (lbound (bbbb) /= [-4, -3, 1])) error stop 3
|
||||
if (any (shape (bbbb) /= [15, 12, 2])) error stop 4
|
||||
if (any (aaaa /= -bbbb)) error stop 5
|
||||
if (any (aaaa /= reshape ([(i, i = 1, size(aaaa))], shape(aaaa)))) &
|
||||
error stop 6
|
||||
|
||||
!$omp parallel do shared(bbbb, aaaa)
|
||||
do i = 1,1
|
||||
if (any (lbound (aaaa) /= [-4, -3, 1])) error stop 5
|
||||
if (any (shape (aaaa) /= [15, 12, 2])) error stop 6
|
||||
if (any (lbound (bbbb) /= [-4, -3, 1])) error stop 7
|
||||
if (any (shape (bbbb) /= [15, 12, 2])) error stop 8
|
||||
if (any (aaaa /= -bbbb)) error stop 5
|
||||
if (any (aaaa /= reshape ([(i, i = 1, size(aaaa))], shape(aaaa)))) &
|
||||
error stop 6
|
||||
ptr = c_loc (aaaa)
|
||||
!$omp target data use_device_ptr(bbbb, aaaa) device(dev)
|
||||
if (any (lbound (aaaa) /= [-4, -3, 1])) error stop 9
|
||||
if (any (shape (aaaa) /= [15, 12, 2])) error stop 10
|
||||
if (any (lbound (bbbb) /= [-4, -3, 1])) error stop 11
|
||||
if (any (shape (bbbb) /= [15, 12, 2])) error stop 12
|
||||
if (is_shared) then
|
||||
if (any (aaaa /= -bbbb)) error stop 5
|
||||
if (any (aaaa /= reshape ([(i, i = 1, size(aaaa))], shape(aaaa)))) &
|
||||
error stop 6
|
||||
end if
|
||||
if (is_shared .neqv. c_associated (ptr, c_loc (aaaa))) error stop
|
||||
|
||||
! Uses has_device_addr due to PR fortran/105318
|
||||
!!$omp target is_device_ptr(bbbb, aaaa) device(dev)
|
||||
!$omp target has_device_addr(bbbb, aaaa) device(dev)
|
||||
if (any (lbound (aaaa) /= [-4, -3, 1])) error stop 9
|
||||
if (any (shape (aaaa) /= [15, 12, 2])) error stop 10
|
||||
if (any (lbound (bbbb) /= [-4, -3, 1])) error stop 11
|
||||
if (any (shape (bbbb) /= [15, 12, 2])) error stop 12
|
||||
if (any (aaaa /= -bbbb)) error stop 5
|
||||
if (any (aaaa /= reshape ([(i, i = 1, size(aaaa))], shape(aaaa)))) &
|
||||
error stop 6
|
||||
!$omp end target
|
||||
!$omp end target data
|
||||
end do
|
||||
!$omp target exit data map(delete: bbbb) device(dev)
|
||||
deallocate (bbbb)
|
||||
end subroutine test_ptr
|
||||
end program main
|
||||
Loading…
Reference in New Issue