All OpenACC Fortran runtime library routines with assumed-rank dummy
arguments (acc_copyin_array_h, acc_create_array_h, acc_copyout_array_h,
acc_delete_array_h, acc_is_present_array_h, and their async/finalize
variants) had 'contiguous' on the dummy argument. When a non-contiguous
array was passed (assumed-shape dummy, Fortran pointer), gfortran
created a temporary copy to satisfy the contiguity requirement. This
caused the runtime to operate on the copy's address rather than the
original data.
For acc_is_present this meant returning false for data that was actually
present on the device. For acc_copyin/acc_create this meant mapping a
temporary that gets freed after the call. For acc_copyout/acc_delete
this meant failing to find the original mapping.
Remove the contiguous attribute from all affected routines. They only
pass the base address and size to the underlying C functions, so
contiguous storage is not required.
PR libgomp/96080
PR libgomp/123280
libgomp/ChangeLog:
* openacc.f90: Remove contiguous attribute from assumed-rank
dummy argument in all array_h routines and their interfaces.
* testsuite/libgomp.oacc-fortran/pr123280.f90: New test.
Signed-off-by: Christopher Albert <[email protected]>
---
libgomp/openacc.f90 | 76 +++++++++----------
.../libgomp.oacc-fortran/pr123280.f90 | 67 ++++++++++++++++
2 files changed, 105 insertions(+), 38 deletions(-)
create mode 100644 libgomp/testsuite/libgomp.oacc-fortran/pr123280.f90
diff --git a/libgomp/openacc.f90 b/libgomp/openacc.f90
index dfac1b00151..f720e6a7234 100644
--- a/libgomp/openacc.f90
+++ b/libgomp/openacc.f90
@@ -176,7 +176,7 @@ module openacc_internal
end subroutine
subroutine acc_copyin_array_h (a)
- type (*), dimension (..), contiguous :: a
+ type (*), dimension (..) :: a
end subroutine
subroutine acc_present_or_copyin_32_h (a, len)
@@ -194,7 +194,7 @@ module openacc_internal
end subroutine
subroutine acc_present_or_copyin_array_h (a)
- type (*), dimension (..), contiguous :: a
+ type (*), dimension (..) :: a
end subroutine
subroutine acc_create_32_h (a, len)
@@ -212,7 +212,7 @@ module openacc_internal
end subroutine
subroutine acc_create_array_h (a)
- type (*), dimension (..), contiguous :: a
+ type (*), dimension (..) :: a
end subroutine
subroutine acc_present_or_create_32_h (a, len)
@@ -230,7 +230,7 @@ module openacc_internal
end subroutine
subroutine acc_present_or_create_array_h (a)
- type (*), dimension (..), contiguous :: a
+ type (*), dimension (..) :: a
end subroutine
subroutine acc_copyout_32_h (a, len)
@@ -248,7 +248,7 @@ module openacc_internal
end subroutine
subroutine acc_copyout_array_h (a)
- type (*), dimension (..), contiguous :: a
+ type (*), dimension (..) :: a
end subroutine
subroutine acc_copyout_finalize_32_h (a, len)
@@ -266,7 +266,7 @@ module openacc_internal
end subroutine
subroutine acc_copyout_finalize_array_h (a)
- type (*), dimension (..), contiguous :: a
+ type (*), dimension (..) :: a
end subroutine
subroutine acc_copyout_finalize_async_32_h (a, len, async)
@@ -289,7 +289,7 @@ module openacc_internal
subroutine acc_copyout_finalize_async_array_h (a, async)
use openacc_kinds, only: acc_handle_kind
- type (*), dimension (..), contiguous :: a
+ type (*), dimension (..) :: a
integer (acc_handle_kind) async
end subroutine
@@ -308,7 +308,7 @@ module openacc_internal
end subroutine
subroutine acc_delete_array_h (a)
- type (*), dimension (..), contiguous :: a
+ type (*), dimension (..) :: a
end subroutine
subroutine acc_delete_finalize_32_h (a, len)
@@ -326,7 +326,7 @@ module openacc_internal
end subroutine
subroutine acc_delete_finalize_array_h (a)
- type (*), dimension (..), contiguous :: a
+ type (*), dimension (..) :: a
end subroutine
subroutine acc_update_device_32_h (a, len)
@@ -344,7 +344,7 @@ module openacc_internal
end subroutine
subroutine acc_update_device_array_h (a)
- type (*), dimension (..), contiguous :: a
+ type (*), dimension (..) :: a
end subroutine
subroutine acc_update_self_32_h (a, len)
@@ -362,7 +362,7 @@ module openacc_internal
end subroutine
subroutine acc_update_self_array_h (a)
- type (*), dimension (..), contiguous :: a
+ type (*), dimension (..) :: a
end subroutine
function acc_is_present_32_h (a, len)
@@ -383,7 +383,7 @@ module openacc_internal
function acc_is_present_array_h (a)
logical acc_is_present_array_h
- type (*), dimension (..), contiguous :: a
+ type (*), dimension (..) :: a
end function
subroutine acc_copyin_async_32_h (a, len, async)
@@ -406,7 +406,7 @@ module openacc_internal
subroutine acc_copyin_async_array_h (a, async)
use openacc_kinds, only: acc_handle_kind
- type (*), dimension (..), contiguous :: a
+ type (*), dimension (..) :: a
integer (acc_handle_kind) async
end subroutine
@@ -430,7 +430,7 @@ module openacc_internal
subroutine acc_create_async_array_h (a, async)
use openacc_kinds, only: acc_handle_kind
- type (*), dimension (..), contiguous :: a
+ type (*), dimension (..) :: a
integer (acc_handle_kind) async
end subroutine
@@ -454,7 +454,7 @@ module openacc_internal
subroutine acc_copyout_async_array_h (a, async)
use openacc_kinds, only: acc_handle_kind
- type (*), dimension (..), contiguous :: a
+ type (*), dimension (..) :: a
integer (acc_handle_kind) async
end subroutine
@@ -478,7 +478,7 @@ module openacc_internal
subroutine acc_delete_async_array_h (a, async)
use openacc_kinds, only: acc_handle_kind
- type (*), dimension (..), contiguous :: a
+ type (*), dimension (..) :: a
integer (acc_handle_kind) async
end subroutine
@@ -502,7 +502,7 @@ module openacc_internal
subroutine acc_delete_finalize_async_array_h (a, async)
use openacc_kinds, only: acc_handle_kind
- type (*), dimension (..), contiguous :: a
+ type (*), dimension (..) :: a
integer (acc_handle_kind) async
end subroutine
@@ -526,7 +526,7 @@ module openacc_internal
subroutine acc_update_device_async_array_h (a, async)
use openacc_kinds, only: acc_handle_kind
- type (*), dimension (..), contiguous :: a
+ type (*), dimension (..) :: a
integer (acc_handle_kind) async
end subroutine
@@ -550,7 +550,7 @@ module openacc_internal
subroutine acc_update_self_async_array_h (a, async)
use openacc_kinds, only: acc_handle_kind
- type (*), dimension (..), contiguous :: a
+ type (*), dimension (..) :: a
integer (acc_handle_kind) async
end subroutine
end interface
@@ -1394,7 +1394,7 @@ end subroutine
subroutine acc_copyin_array_h (a)
use openacc_internal, only: acc_copyin_l
- type (*), dimension (..), contiguous :: a
+ type (*), dimension (..) :: a
call acc_copyin_l (a, sizeof (a))
end subroutine
@@ -1418,7 +1418,7 @@ end subroutine
subroutine acc_present_or_copyin_array_h (a)
use openacc_internal, only: acc_present_or_copyin_l
- type (*), dimension (..), contiguous :: a
+ type (*), dimension (..) :: a
call acc_present_or_copyin_l (a, sizeof (a))
end subroutine
@@ -1442,7 +1442,7 @@ end subroutine
subroutine acc_create_array_h (a)
use openacc_internal, only: acc_create_l
- type (*), dimension (..), contiguous :: a
+ type (*), dimension (..) :: a
call acc_create_l (a, sizeof (a))
end subroutine
@@ -1466,7 +1466,7 @@ end subroutine
subroutine acc_present_or_create_array_h (a)
use openacc_internal, only: acc_present_or_create_l
- type (*), dimension (..), contiguous :: a
+ type (*), dimension (..) :: a
call acc_present_or_create_l (a, sizeof (a))
end subroutine
@@ -1490,7 +1490,7 @@ end subroutine
subroutine acc_copyout_array_h (a)
use openacc_internal, only: acc_copyout_l
- type (*), dimension (..), contiguous :: a
+ type (*), dimension (..) :: a
call acc_copyout_l (a, sizeof (a))
end subroutine
@@ -1514,7 +1514,7 @@ end subroutine
subroutine acc_copyout_finalize_array_h (a)
use openacc_internal, only: acc_copyout_finalize_l
- type (*), dimension (..), contiguous :: a
+ type (*), dimension (..) :: a
call acc_copyout_finalize_l (a, sizeof (a))
end subroutine
@@ -1546,7 +1546,7 @@ subroutine acc_copyout_finalize_async_array_h (a, async)
use iso_c_binding, only: c_int
use openacc_internal, only: acc_copyout_finalize_async_l
use openacc_kinds, only: acc_handle_kind
- type (*), dimension (..), contiguous :: a
+ type (*), dimension (..) :: a
integer (acc_handle_kind) async
call acc_copyout_finalize_async_l (a, sizeof (a), int (async, kind = c_int))
end subroutine
@@ -1572,7 +1572,7 @@ end subroutine
subroutine acc_delete_array_h (a)
use openacc_internal, only: acc_delete_l
- type (*), dimension (..), contiguous :: a
+ type (*), dimension (..) :: a
call acc_delete_l (a, sizeof (a))
end subroutine
@@ -1596,7 +1596,7 @@ end subroutine
subroutine acc_delete_finalize_array_h (a)
use openacc_internal, only: acc_delete_finalize_l
- type (*), dimension (..), contiguous :: a
+ type (*), dimension (..) :: a
call acc_delete_finalize_l (a, sizeof (a))
end subroutine
@@ -1620,7 +1620,7 @@ end subroutine
subroutine acc_update_device_array_h (a)
use openacc_internal, only: acc_update_device_l
- type (*), dimension (..), contiguous :: a
+ type (*), dimension (..) :: a
call acc_update_device_l (a, sizeof (a))
end subroutine
@@ -1644,7 +1644,7 @@ end subroutine
subroutine acc_update_self_array_h (a)
use openacc_internal, only: acc_update_self_l
- type (*), dimension (..), contiguous :: a
+ type (*), dimension (..) :: a
call acc_update_self_l (a, sizeof (a))
end subroutine
@@ -1671,7 +1671,7 @@ end function
function acc_is_present_array_h (a)
use openacc_internal, only: acc_is_present_l
logical acc_is_present_array_h
- type (*), dimension (..), contiguous :: a
+ type (*), dimension (..) :: a
acc_is_present_array_h = acc_is_present_l (a, sizeof (a)) /= 0
end function
@@ -1701,7 +1701,7 @@ subroutine acc_copyin_async_array_h (a, async)
use iso_c_binding, only: c_int
use openacc_internal, only: acc_copyin_async_l
use openacc_kinds, only: acc_handle_kind
- type (*), dimension (..), contiguous :: a
+ type (*), dimension (..) :: a
integer (acc_handle_kind) async
call acc_copyin_async_l (a, sizeof (a), int (async, kind = c_int))
end subroutine
@@ -1732,7 +1732,7 @@ subroutine acc_create_async_array_h (a, async)
use iso_c_binding, only: c_int
use openacc_internal, only: acc_create_async_l
use openacc_kinds, only: acc_handle_kind
- type (*), dimension (..), contiguous :: a
+ type (*), dimension (..) :: a
integer (acc_handle_kind) async
call acc_create_async_l (a, sizeof (a), int (async, kind = c_int))
end subroutine
@@ -1763,7 +1763,7 @@ subroutine acc_copyout_async_array_h (a, async)
use iso_c_binding, only: c_int
use openacc_internal, only: acc_copyout_async_l
use openacc_kinds, only: acc_handle_kind
- type (*), dimension (..), contiguous :: a
+ type (*), dimension (..) :: a
integer (acc_handle_kind) async
call acc_copyout_async_l (a, sizeof (a), int (async, kind = c_int))
end subroutine
@@ -1794,7 +1794,7 @@ subroutine acc_delete_async_array_h (a, async)
use iso_c_binding, only: c_int
use openacc_internal, only: acc_delete_async_l
use openacc_kinds, only: acc_handle_kind
- type (*), dimension (..), contiguous :: a
+ type (*), dimension (..) :: a
integer (acc_handle_kind) async
call acc_delete_async_l (a, sizeof (a), int (async, kind = c_int))
end subroutine
@@ -1827,7 +1827,7 @@ subroutine acc_delete_finalize_async_array_h (a, async)
use iso_c_binding, only: c_int
use openacc_internal, only: acc_delete_finalize_async_l
use openacc_kinds, only: acc_handle_kind
- type (*), dimension (..), contiguous :: a
+ type (*), dimension (..) :: a
integer (acc_handle_kind) async
call acc_delete_finalize_async_l (a, sizeof (a), int (async, kind = c_int))
end subroutine
@@ -1858,7 +1858,7 @@ subroutine acc_update_device_async_array_h (a, async)
use iso_c_binding, only: c_int
use openacc_internal, only: acc_update_device_async_l
use openacc_kinds, only: acc_handle_kind
- type (*), dimension (..), contiguous :: a
+ type (*), dimension (..) :: a
integer (acc_handle_kind) async
call acc_update_device_async_l (a, sizeof (a), int (async, kind = c_int))
end subroutine
@@ -1889,7 +1889,7 @@ subroutine acc_update_self_async_array_h (a, async)
use iso_c_binding, only: c_int
use openacc_internal, only: acc_update_self_async_l
use openacc_kinds, only: acc_handle_kind
- type (*), dimension (..), contiguous :: a
+ type (*), dimension (..) :: a
integer (acc_handle_kind) async
call acc_update_self_async_l (a, sizeof (a), int (async, kind = c_int))
end subroutine
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/pr123280.f90
b/libgomp/testsuite/libgomp.oacc-fortran/pr123280.f90
new file mode 100644
index 00000000000..6ed6a714c30
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-fortran/pr123280.f90
@@ -0,0 +1,67 @@
+! PR libgomp/123280, PR libgomp/96080
+! { dg-do run }
+! { dg-skip-if "" { *-*-* } { "*" } { "-DACC_MEM_SHARED=0" } }
+!
+! Test that acc_is_present works correctly for assumed-shape dummy arguments
+! and Fortran pointers. Before the fix, these cases would create a copy
+! (due to the contiguous attribute), causing the lookup to fail.
+
+program pr123280
+ use openacc
+ implicit none
+
+ real, allocatable, target :: arr(:)
+ real, pointer :: ptr(:)
+ integer, parameter :: n = 100
+
+ allocate(arr(n))
+ arr = 1.0
+ ptr => arr
+
+ !$acc enter data copyin(arr)
+
+ ! Test 1: Direct check should pass
+ if (.not. acc_is_present(arr)) stop 1
+
+ ! Test 2: Check via subroutine with assumed-shape should pass
+ call check_assumed_shape(arr)
+
+ ! Test 3: Check via subroutine with explicit contiguous should pass
+ call check_contiguous(arr)
+
+ ! Test 4: Check pointer to mapped target (PR 96080)
+ if (.not. acc_is_present(ptr)) stop 4
+
+ ! Test 5: Check pointer in subroutine
+ call check_pointer(ptr)
+
+ ! Test 6: Check pointer passed as assumed-shape
+ call check_assumed_shape(ptr)
+
+ !$acc exit data delete(arr)
+
+contains
+
+ subroutine check_assumed_shape(x)
+ real, intent(in) :: x(:)
+
+ ! This used to fail because gfortran created a copy of the array
+ ! to satisfy the contiguous requirement in acc_is_present_array_h.
+ if (.not. acc_is_present(x)) stop 2
+ end subroutine check_assumed_shape
+
+ subroutine check_contiguous(x)
+ real, intent(in), contiguous :: x(:)
+
+ ! With explicit contiguous on the dummy, no copy should be needed.
+ if (.not. acc_is_present(x)) stop 3
+ end subroutine check_contiguous
+
+ subroutine check_pointer(p)
+ real, pointer, intent(in) :: p(:)
+
+ ! Pointer argument should detect mapped target (PR 96080).
+ if (.not. acc_is_present(p)) stop 5
+ end subroutine check_pointer
+
+end program pr123280
--
2.53.0
