Fortran/OpenMP: Fix use_device_{ptr,addr} with assumed-size array [PR98858]

gcc/ChangeLog:

	PR fortran/98858
	* gimplify.c (omp_add_variable): Handle NULL_TREE as size
	occuring for assumed-size arrays in use_device_{ptr,addr}.

libgomp/ChangeLog:

	PR fortran/98858
	* testsuite/libgomp.fortran/use_device_ptr-3.f90: New test.
This commit is contained in:
Tobias Burnus 2021-03-12 16:33:02 +01:00
parent a6e9633ccb
commit 0b5437510c
2 changed files with 92 additions and 1 deletions

View File

@ -7078,7 +7078,7 @@ omp_add_variable (struct gimplify_omp_ctx *ctx, tree decl, unsigned int flags)
if ((flags & GOVD_SHARED) == 0)
{
t = TYPE_SIZE_UNIT (TREE_TYPE (TREE_TYPE (decl)));
if (DECL_P (t))
if (t && DECL_P (t))
omp_notice_variable (ctx, t, true);
}
}

View File

@ -0,0 +1,91 @@
! PR fortran/98858
!
! Assumed-size array with use_device_ptr()
!
program test_use_device_ptr
use iso_c_binding, only: c_ptr, c_loc, c_f_pointer
implicit none
double precision :: alpha
integer, parameter :: lda = 10
integer, allocatable :: mat(:, :)
integer :: i, j
allocate(mat(lda, lda))
do i = 1, lda
do j = 1, lda
mat(j,i) = i*100 + j
end do
end do
!$omp target enter data map(to:mat)
call dgemm(lda, mat)
!$omp target exit data map(from:mat)
do i = 1, lda
do j = 1, lda
if (mat(j,i) /= -(i*100 + j)) stop 1
end do
end do
!$omp target enter data map(to:mat)
call dgemm2(lda, mat)
!$omp target exit data map(from:mat)
do i = 1, lda
do j = 1, lda
if (mat(j,i) /= (i*100 + j)) stop 1
end do
end do
contains
subroutine dgemm(lda, a)
implicit none
integer :: lda
integer, target:: a(lda,*) ! need target attribute to use c_loc
!$omp target data use_device_ptr(a)
call negate_it(c_loc(a), lda)
!$omp end target data
end subroutine
subroutine dgemm2(lda, a)
implicit none
integer :: lda
integer, target:: a(lda,*) ! need target attribute to use c_loc
!$omp target data use_device_addr(a)
call negate_it(c_loc(a), lda)
!$omp end target data
end subroutine
subroutine negate_it(a, n)
type(c_ptr), value :: a
integer, value :: n
integer, pointer :: array(:,:)
! detour due to OpenMP 5.0 oddness
call c_f_pointer(a, array, [n,n])
call do_offload(array, n)
end
subroutine do_offload(aptr, n)
integer, target :: aptr(:,:)
integer, value :: n
!$omp target is_device_ptr(aptr)
call negate_it_tgt(aptr, n)
!$omp end target
end subroutine do_offload
subroutine negate_it_tgt(array, n)
!$omp declare target
integer, value :: n
integer :: array(n,n)
integer :: i, j
!$omp parallel do collapse(2)
do i = 1, n
do j = 1, n
array(j,i) = - array(j,i)
end do
end do
!$omp end parallel do
end subroutine
end program