From e3241486f68c077006513ea41c59ba3fdaeca7f7 Mon Sep 17 00:00:00 2001 From: Thomas Schwinge Date: Wed, 29 Jul 2020 15:57:17 +0200 Subject: [PATCH] into: openacc: No attach/detach present/release mappings for array descriptors --- .../attach-descriptor-1.f90 | 93 ++++++++++++++++--- .../attach-descriptor-3.f90 | 68 -------------- .../attach-descriptor-4.f90 | 61 ------------ 3 files changed, 80 insertions(+), 142 deletions(-) delete mode 100644 libgomp/testsuite/libgomp.oacc-fortran/attach-descriptor-3.f90 delete mode 100644 libgomp/testsuite/libgomp.oacc-fortran/attach-descriptor-4.f90 diff --git a/libgomp/testsuite/libgomp.oacc-fortran/attach-descriptor-1.f90 b/libgomp/testsuite/libgomp.oacc-fortran/attach-descriptor-1.f90 index 9f159fa3b75..960b9f94507 100644 --- a/libgomp/testsuite/libgomp.oacc-fortran/attach-descriptor-1.f90 +++ b/libgomp/testsuite/libgomp.oacc-fortran/attach-descriptor-1.f90 @@ -1,9 +1,10 @@ ! { dg-do run } ! { dg-skip-if "" { *-*-* } { "*" } { "-DACC_MEM_SHARED=0" } } -program att +subroutine test(variant) use openacc implicit none + integer :: variant type t integer :: arr1(10) integer, allocatable :: arr2(:) @@ -27,31 +28,97 @@ program att myptr => tarr - !$acc enter data attach(myvar%arr2, myptr) + if (variant == 0 & + .or. variant == 3 & + .or. variant == 5) then + !$acc enter data attach(myvar%arr2, myptr) + else if (variant == 1 & + .or. variant == 2 & + .or. variant == 4) then + !$acc enter data attach(myvar%arr2, myptr) + !$acc enter data attach(myvar%arr2, myptr) + else + ! Internal error. + stop 1 + end if ! FIXME: This warning is emitted on the wrong line number. - ! { dg-warning "using vector_length \\(32\\), ignoring 1" "" { target openacc_nvidia_accel_selected } 39 } + ! { dg-warning "using vector_length \\(32\\), ignoring 1" "" { target openacc_nvidia_accel_selected } 52 } !$acc serial present(myvar%arr2) do i=1,10 - myvar%arr1(i) = i - myvar%arr2(i) = i + myvar%arr1(i) = i + variant + myvar%arr2(i) = i - variant end do - myptr(3) = 99 + myptr(3) = 99 - variant !$acc end serial - !$acc exit data detach(myvar%arr2, myptr) + if (variant == 0) then + !$acc exit data detach(myvar%arr2, myptr) + else if (variant == 1) then + !$acc exit data detach(myvar%arr2, myptr) + !$acc exit data detach(myvar%arr2, myptr) + else if (variant == 2) then + !$acc exit data detach(myvar%arr2, myptr) + !$acc exit data detach(myvar%arr2, myptr) finalize + else if (variant == 3 & + .or. variant == 4) then + !$acc exit data detach(myvar%arr2, myptr) finalize + else if (variant == 5) then + ! Do not detach. + else + ! Internal error. + stop 2 + end if + + if (.not. acc_is_present(myvar%arr2)) stop 10 + if (.not. acc_is_present(myvar)) stop 11 + if (.not. acc_is_present(tarr)) stop 12 call acc_copyout(myvar%arr2) - if (acc_is_present(myvar%arr2)) stop 10 + if (acc_is_present(myvar%arr2)) stop 20 + if (.not. acc_is_present(myvar)) stop 21 + if (.not. acc_is_present(tarr)) stop 22 call acc_copyout(myvar) - if (acc_is_present(myvar)) stop 11 + if (acc_is_present(myvar%arr2)) stop 30 + if (acc_is_present(myvar)) stop 31 + if (.not. acc_is_present(tarr)) stop 32 call acc_copyout(tarr) - if (acc_is_present(tarr)) stop 12 + if (acc_is_present(myvar%arr2)) stop 40 + if (acc_is_present(myvar)) stop 41 + if (acc_is_present(tarr)) stop 42 do i=1,10 - if (myvar%arr1(i) .ne. i) stop 1 - if (myvar%arr2(i) .ne. i) stop 2 + if (myvar%arr1(i) .ne. i + variant) stop 50 + if (variant == 5) then + ! We have not detached, so have copyied out a device pointer, so cannot + ! access 'myvar%arr2' on the host. + else + if (myvar%arr2(i) .ne. i - variant) stop 51 + end if end do - if (tarr(3) .ne. 99) stop 3 + if (tarr(3) .ne. 99 - variant) stop 52 + + if (variant == 5) then + ! If not explicitly stopping here, we'd in the following try to deallocate + ! the device pointer on the host, SIGSEGV. + stop + end if +end subroutine test + +program att + implicit none + + call test(0) + + call test(1) + + call test(2) + + call test(3) + + call test(4) + call test(5) + ! Make sure that 'test(5)' has stopped the program. + stop 60 end program att diff --git a/libgomp/testsuite/libgomp.oacc-fortran/attach-descriptor-3.f90 b/libgomp/testsuite/libgomp.oacc-fortran/attach-descriptor-3.f90 deleted file mode 100644 index f0e57b47453..00000000000 --- a/libgomp/testsuite/libgomp.oacc-fortran/attach-descriptor-3.f90 +++ /dev/null @@ -1,68 +0,0 @@ -! { dg-do run } -! { dg-skip-if "" { *-*-* } { "*" } { "-DACC_MEM_SHARED=0" } } - -program att - use openacc - implicit none - type t - integer :: arr1(10) - integer, allocatable :: arr2(:) - end type t - integer :: i - type(t) :: myvar - integer, target :: tarr(10) - integer, pointer :: myptr(:) - - allocate(myvar%arr2(10)) - - do i=1,10 - myvar%arr1(i) = 0 - myvar%arr2(i) = 0 - tarr(i) = 0 - end do - - call acc_copyin(myvar) - call acc_copyin(myvar%arr2) - call acc_copyin(tarr) - - myptr => tarr - - !$acc enter data attach(myvar%arr2, myptr) - !$acc enter data attach(myvar%arr2, myptr) - - ! FIXME: This warning is emitted on the wrong line number. - ! { dg-warning "using vector_length \\(32\\), ignoring 1" "" { target openacc_nvidia_accel_selected } 40 } - !$acc serial present(myvar%arr2) - do i=1,10 - myvar%arr1(i) = i - myvar%arr2(i) = i - end do - myptr(3) = 99 - !$acc end serial - - !$acc exit data detach(myvar%arr2, myptr) finalize - - if (.not. acc_is_present(myvar%arr2)) stop 10 - if (.not. acc_is_present(myvar)) stop 11 - if (.not. acc_is_present(tarr)) stop 12 - - call acc_copyout(myvar%arr2) - if (acc_is_present(myvar%arr2)) stop 20 - if (.not. acc_is_present(myvar)) stop 21 - if (.not. acc_is_present(tarr)) stop 22 - call acc_copyout(myvar) - if (acc_is_present(myvar%arr2)) stop 30 - if (acc_is_present(myvar)) stop 31 - if (.not. acc_is_present(tarr)) stop 32 - call acc_copyout(tarr) - if (acc_is_present(myvar%arr2)) stop 40 - if (acc_is_present(myvar)) stop 41 - if (acc_is_present(tarr)) stop 42 - - do i=1,10 - if (myvar%arr1(i) .ne. i) stop 1 - if (myvar%arr2(i) .ne. i) stop 2 - end do - if (tarr(3) .ne. 99) stop 3 - -end program att diff --git a/libgomp/testsuite/libgomp.oacc-fortran/attach-descriptor-4.f90 b/libgomp/testsuite/libgomp.oacc-fortran/attach-descriptor-4.f90 deleted file mode 100644 index 9dbf53d0213..00000000000 --- a/libgomp/testsuite/libgomp.oacc-fortran/attach-descriptor-4.f90 +++ /dev/null @@ -1,61 +0,0 @@ -! { dg-do run } -! { dg-skip-if "" { *-*-* } { "*" } { "-DACC_MEM_SHARED=0" } } - -program att - use openacc - implicit none - type t - integer :: arr1(10) - integer, allocatable :: arr2(:) - end type t - integer :: i - type(t) :: myvar - integer, target :: tarr(10) - integer, pointer :: myptr(:) - - allocate(myvar%arr2(10)) - - do i=1,10 - myvar%arr1(i) = 0 - myvar%arr2(i) = 0 - tarr(i) = 0 - end do - - call acc_copyin(myvar) - call acc_copyin(myvar%arr2) - call acc_copyin(tarr) - - myptr => tarr - - !$acc enter data attach(myvar%arr2, myptr) - !$acc enter data attach(myvar%arr2, myptr) - - ! FIXME: This warning is emitted on the wrong line number. - ! { dg-warning "using vector_length \\(32\\), ignoring 1" "" { target openacc_nvidia_accel_selected } 40 } - !$acc serial present(myvar%arr2) - do i=1,10 - myvar%arr1(i) = i - myvar%arr2(i) = i - end do - myptr(3) = 99 - !$acc end serial - - !$acc exit data detach(myvar%arr2, myptr) - - call acc_copyout(myvar%arr2) - ! { dg-output ".*copyout of block \\\[0x\[0-9a-f\]+,\\+\[0-9\]+\\\] with attached pointers(\n|\r\n|\r)+" } - if (acc_is_present(myvar%arr2)) stop 10 - call acc_copyout(myvar) - if (acc_is_present(myvar)) stop 11 - call acc_copyout(tarr) - if (acc_is_present(tarr)) stop 12 - - do i=1,10 - if (myvar%arr1(i) .ne. i) stop 1 - if (myvar%arr2(i) .ne. i) stop 2 - end do - if (tarr(3) .ne. 99) stop 3 - -end program att - -! { dg-shouldfail "" } -- 2.17.1