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.

1 files changed, 143 insertions, 0 deletions

diff --git a/libgomp/testsuite/libgomp.fortran/use_device_addr-5.f90 b/libgomp/testsuite/libgomp.fortran/use_device_addr-5.f90
new file mode 100644
index 0000000..1def70a
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/use_device_addr-5.f90
@@ -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