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

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

[Tobias Burnus]

https://gcc.gnu.org/g:0b5437510c13dc0879349a4f259c800d2ce02eb2

commit r11-7648-g0b5437510c13dc0879349a4f259c800d2ce02eb2
Author: Tobias Burnus <tobias@codesourcery.com>
Date:   Fri Mar 12 16:33:02 2021 +0100

    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.

Diff:
---
 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