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

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

[Tobias Burnus]

[-- Attachment #1: Type: text/plain, Size: 393 bytes --]

The ICE occurs because the 't' == NULL for assumed-size arrays.
For them, the size is not known – but as this should only occur
for use_device_{addr,ptr}, the size is not needed.

OK for mainline?

Tobias

-----------------
Mentor Graphics (Deutschland) GmbH, Arnulfstrasse 201, 80634 München Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung, Frank Thürauf

[-- Attachment #2: assumed-devptr.diff --]
[-- Type: text/x-patch, Size: 3461 bytes --]

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.

 gcc/gimplify.c                                     |  2 +-
 .../testsuite/libgomp.fortran/use_device_ptr-3.f90 | 91 ++++++++++++++++++++++
 2 files changed, 92 insertions(+), 1 deletion(-)

diff --git a/gcc/gimplify.c b/gcc/gimplify.c
index caf25ccdd5c..6da66985ad6 100644
--- a/gcc/gimplify.c
+++ b/gcc/gimplify.c
@@ -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);
 	}
     }
diff --git a/libgomp/testsuite/libgomp.fortran/use_device_ptr-3.f90 b/libgomp/testsuite/libgomp.fortran/use_device_ptr-3.f90
new file mode 100644
index 00000000000..f2b33cd5e89
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/use_device_ptr-3.f90
@@ -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

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

[Jakub Jelinek]

On Thu, Mar 11, 2021 at 02:44:38PM +0100, Tobias Burnus wrote:
> 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.

Ok, thanks.

	Jakub