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 --git a/gcc/gimplify.c b/gcc/gimplify.c
index caf25ccdd5c7abdf60dc7adc3de0197cf90dd637..6da66985ad62cc170158f76656fe3085b6246567 100644 (file)
--- 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 (file)
index 0000000..f2b33cd
--- /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