OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity
5d01fc7c11
gcc/libgomp/testsuite/libgomp.fortran/use_device_addr-4.f90
Tobias Burnus 11586ed9c9 libgomp/testsuite/*fortran – make 'stop' values unique 
* testsuite/libgomp.fortran/use_device_addr-3.f90: Make 'stop' codes
        unique.
        * testsuite/libgomp.fortran/use_device_addr-4.f90: Ditto.
        * testsuite/libgomp.fortran/use_device_ptr-optional-2.f90: Ditto.
        * testsuite/libgomp.oacc-fortran/declare-5.f90: Ditto.
        * testsuite/libgomp.oacc-fortran/optional-data-copyin-by-value.f90:
        Ditto.
        * testsuite/libgomp.oacc-fortran/optional-firstprivate.f90: Ditto.
        * testsuite/libgomp.oacc-fortran/optional-update-host.f90: Ditto.

From-SVN: r279117
2019-12-09 12:21:22 +01:00

793 lines
29 KiB
Fortran
Raw Blame History

! { dg-do run }
! Comprehensive run-time test for use_device_addr
!
! Tests array with array descriptor
!
! Differs from use_device_addr-3.f90 by using a 4-byte variable (c_float)
!
! This test case assumes that a 'var' appearing in 'use_device_addr' is
! only used as 'c_loc(var)' - such that only the actual data is used/usable
! on the device - and not meta data ((dynamic) type information, 'present()'
! status, array shape).
!
! Untested in this test case are:
! - scalars
! - polymorphic variables
! - absent optional arguments
!
module target_procs
use iso_c_binding
implicit none (type, external)
private
public :: copy3_array
contains
subroutine copy3_array_int(from_ptr, to_ptr, N)
!$omp declare target
real(c_float) :: from_ptr(:)
real(c_float) :: to_ptr(:)
integer, value :: N
integer :: i
!$omp parallel do
do i = 1, N
to_ptr(i) = 3 * from_ptr(i)
end do
!$omp end parallel do
end subroutine copy3_array_int
subroutine copy3_array(from, to, N)
type(c_ptr), value :: from, to
integer, value :: N
real(c_float), pointer :: from_ptr(:), to_ptr(:)
call c_f_pointer(from, from_ptr, shape=[N])
call c_f_pointer(to, to_ptr, shape=[N])
call do_offload_scalar(from_ptr,to_ptr)
contains
subroutine do_offload_scalar(from_r, to_r)
real(c_float), target :: from_r(:), to_r(:)
! The extra function is needed as is_device_ptr
! requires non-value, non-pointer dummy arguments
!$omp target is_device_ptr(from_r, to_r)
call copy3_array_int(from_r, to_r, N)
!$omp end target
end subroutine do_offload_scalar
end subroutine copy3_array
end module target_procs
! Test local dummy arguments (w/o optional)
module test_dummies
use iso_c_binding
use target_procs
implicit none (type, external)
private
public :: test_dummy_call_1, test_dummy_call_2
contains
subroutine test_dummy_call_1()
integer, parameter :: N = 1000
real(c_float), target :: aa(N), bb(N)
real(c_float), target, allocatable :: cc(:), dd(:)
real(c_float), pointer :: ee(:), ff(:)
allocate(cc(N), dd(N), ee(N), ff(N))
aa = 11.0_c_float
bb = 22.0_c_float
cc = 33.0_c_float
dd = 44.0_c_float
ee = 55.0_c_float
ff = 66.0_c_float
call test_dummy_callee_1(aa, bb, cc, dd, ee, ff, N)
deallocate(ee, ff) ! pointers, only
end subroutine test_dummy_call_1
subroutine test_dummy_callee_1(aa, bb, cc, dd, ee, ff, N)
real(c_float), target :: aa(:), bb(:)
real(c_float), target, allocatable :: cc(:), dd(:)
real(c_float), pointer :: ee(:), ff(:)
integer, value :: N
!$omp target data map(to:aa) map(from:bb) use_device_addr(aa,bb)
call copy3_array(c_loc(aa), c_loc(bb), N)
!$omp end target data
if (any(abs(aa - 11.0_c_float) > 10.0_c_float * epsilon(aa))) stop 2
if (any(abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa))) stop 3
!$omp target data map(to:cc) map(from:dd) use_device_addr(cc,dd)
call copy3_array(c_loc(cc), c_loc(dd), N)
!$omp end target data
if (any(abs(cc - 33.0_c_float) > 10.0_c_float * epsilon(cc))) stop 4
if (any(abs(3.0_c_float * cc - dd) > 10.0_c_float * epsilon(cc))) stop 5
!$omp target data map(to:ee) map(from:ff) use_device_addr(ee,ff)
call copy3_array(c_loc(ee), c_loc(ff), N)
!$omp end target data
if (any(abs(ee - 55.0_c_float) > 10.0_c_float * epsilon(ee))) stop 6
if (any(abs(3.0_c_float * ee - ff) > 10.0_c_float * epsilon(ee))) stop 7
end subroutine test_dummy_callee_1
! Save device ptr - and recall pointer
subroutine test_dummy_call_2()
integer, parameter :: N = 1000
real(c_float), target :: aa(N), bb(N)
real(c_float), target, allocatable :: cc(:), dd(:)
real(c_float), pointer :: ee(:), ff(:)
type(c_ptr) :: c_aptr, c_bptr, c_cptr, c_dptr, c_eptr, c_fptr
real(c_float), pointer :: aptr(:), bptr(:), cptr(:), dptr(:), eptr(:), fptr(:)
allocate(cc(N), dd(N), ee(N), ff(N))
call test_dummy_callee_2(aa, bb, cc, dd, ee, ff, &
c_aptr, c_bptr, c_cptr, c_dptr, c_eptr, c_fptr, &
aptr, bptr, cptr, dptr, eptr, fptr, &
N)
deallocate(ee, ff)
end subroutine test_dummy_call_2
subroutine test_dummy_callee_2(aa, bb, cc, dd, ee, ff, &
c_aptr, c_bptr, c_cptr, c_dptr, c_eptr, c_fptr, &
aptr, bptr, cptr, dptr, eptr, fptr, &
N)
real(c_float), target :: aa(:), bb(:)
real(c_float), target, allocatable :: cc(:), dd(:)
real(c_float), pointer :: ee(:), ff(:)
type(c_ptr) :: c_aptr, c_bptr, c_cptr, c_dptr, c_eptr, c_fptr
real(c_float), pointer :: aptr(:), bptr(:), cptr(:), dptr(:), eptr(:), fptr(:)
integer, value :: N
real(c_float) :: dummy
aa = 111.0_c_float
bb = 222.0_c_float
cc = 333.0_c_float
dd = 444.0_c_float
ee = 555.0_c_float
ff = 666.0_c_float
!$omp target data map(to:aa) map(from:bb)
!$omp target data map(alloc:dummy) use_device_addr(aa,bb)
c_aptr = c_loc(aa)
c_bptr = c_loc(bb)
aptr => aa
bptr => bb
!$omp end target data
! check c_loc ptr once
call copy3_array(c_aptr, c_bptr, N)
!$omp target update from(bb)
if (any(abs(aa - 111.0_c_float) > 10.0_c_float * epsilon(aa))) stop 8
if (any(abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa))) stop 9
! check c_loc ptr again after target-value modification
aa = 1111.0_c_float
!$omp target update to(aa)
call copy3_array(c_aptr, c_bptr, N)
!$omp target update from(bb)
if (any(abs(aa - 1111.0_c_float) > 10.0_c_float * epsilon(aa))) stop 10
if (any(abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa))) stop 11
! check Fortran pointer after target-value modification
aa = 11111.0_c_float
!$omp target update to(aa)
call copy3_array(c_loc(aptr), c_loc(bptr), N)
!$omp target update from(bb)
if (any(abs(aa - 11111.0_c_float) > 10.0_c_float * epsilon(aa))) stop 12
if (any(abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa))) stop 13
!$omp end target data
if (any(abs(aa - 11111.0_c_float) > 10.0_c_float * epsilon(aa))) stop 14
if (any(abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa))) stop 15
!$omp target data map(to:cc) map(from:dd)
!$omp target data map(alloc:dummy) use_device_addr(cc,dd)
c_cptr = c_loc(cc)
c_dptr = c_loc(dd)
cptr => cc
dptr => dd
!$omp end target data
! check c_loc ptr once
call copy3_array(c_cptr, c_dptr, N)
!$omp target update from(dd)
if (any(abs(cc - 333.0_c_float) > 10.0_c_float * epsilon(cc))) stop 16
if (any(abs(3.0_c_float * cc - dd) > 10.0_c_float * epsilon(cc))) stop 17
! check c_loc ptr again after target-value modification
cc = 3333.0_c_float
!$omp target update to(cc)
call copy3_array(c_cptr, c_dptr, N)
!$omp target update from(dd)
if (any(abs(cc - 3333.0_c_float) > 10.0_c_float * epsilon(cc))) stop 18
if (any(abs(3.0_c_float * cc - dd) > 10.0_c_float * epsilon(cc))) stop 19
! check Fortran pointer after target-value modification
cc = 33333.0_c_float
!$omp target update to(cc)
call copy3_array(c_loc(cptr), c_loc(dptr), N)
!$omp target update from(dd)
if (any(abs(cc - 33333.0_c_float) > 10.0_c_float * epsilon(cc))) stop 20
if (any(abs(3.0_c_float * cc - dd) > 10.0_c_float * epsilon(cc))) stop 21
!$omp end target data
if (any(abs(cc - 33333.0_c_float) > 10.0_c_float * epsilon(dd))) stop 22
if (any(abs(3.0_c_float * cc - dd) > 10.0_c_float * epsilon(dd))) stop 23
!$omp target data map(to:ee) map(from:ff)
!$omp target data map(alloc:dummy) use_device_addr(ee,ff)
c_eptr = c_loc(ee)
c_fptr = c_loc(ff)
eptr => ee
fptr => ff
!$omp end target data
! check c_loc ptr once
call copy3_array(c_eptr, c_fptr, N)
!$omp target update from(ff)
if (any(abs(ee - 555.0_c_float) > 10.0_c_float * epsilon(ee))) stop 24
if (any(abs(3.0_c_float * ee - ff) > 10.0_c_float * epsilon(ee))) stop 25
! check c_loc ptr again after target-value modification
ee = 5555.0_c_float
!$omp target update to(ee)
call copy3_array(c_eptr, c_fptr, N)
!$omp target update from(ff)
if (any(abs(ee - 5555.0_c_float) > 10.0_c_float * epsilon(ee))) stop 26
if (any(abs(3.0_c_float * ee - ff) > 10.0_c_float * epsilon(ee))) stop 27
! check Fortran pointer after target-value modification
ee = 55555.0_c_float
!$omp target update to(ee)
call copy3_array(c_loc(eptr), c_loc(fptr), N)
!$omp target update from(ff)
if (any(abs(ee - 55555.0_c_float) > 10.0_c_float * epsilon(ee))) stop 28
if (any(abs(3.0_c_float * ee - ff) > 10.0_c_float * epsilon(ff))) stop 29
!$omp end target data
if (any(abs(ee - 55555.0_c_float) > 10.0_c_float * epsilon(ee))) stop 30
if (any(abs(3.0_c_float * ee - ff) > 10.0_c_float * epsilon(ee))) stop 31
end subroutine test_dummy_callee_2
end module test_dummies
! Test local dummy arguments + OPTIONAL
! Values present and ptr associated to nonzero
module test_dummies_opt
use iso_c_binding
use target_procs
implicit none (type, external)
private
public :: test_dummy_opt_call_1, test_dummy_opt_call_2
contains
subroutine test_dummy_opt_call_1()
integer, parameter :: N = 1000
real(c_float), target :: aa(N), bb(N)
real(c_float), target, allocatable :: cc(:), dd(:)
real(c_float), pointer :: ee(:), ff(:)
allocate(cc(N), dd(N), ee(N), ff(N))
aa = 11.0_c_float
bb = 22.0_c_float
cc = 33.0_c_float
dd = 44.0_c_float
ee = 55.0_c_float
ff = 66.0_c_float
call test_dummy_opt_callee_1(aa, bb, cc, dd, ee, ff, N)
call test_dummy_opt_callee_1_absent(N=N)
deallocate(ee, ff) ! pointers, only
end subroutine test_dummy_opt_call_1
subroutine test_dummy_opt_callee_1(aa, bb, cc, dd, ee, ff, N)
! scalars
real(c_float), optional, target :: aa(:), bb(:)
real(c_float), optional, target, allocatable :: cc(:), dd(:)
real(c_float), optional, pointer :: ee(:), ff(:)
integer, value :: N
! All shall be present - and pointing to non-NULL
if (.not.present(aa) .or. .not.present(bb)) stop 32
if (.not.present(cc) .or. .not.present(dd)) stop 33
if (.not.present(ee) .or. .not.present(ff)) stop 34
if (.not.allocated(cc) .or. .not.allocated(dd)) stop 35
if (.not.associated(ee) .or. .not.associated(ff)) stop 36
!$omp target data map(to:aa) map(from:bb) use_device_addr(aa,bb)
if (.not.present(aa) .or. .not.present(bb)) stop 37
if (.not.c_associated(c_loc(aa)) .or. .not.c_associated(c_loc(bb))) stop 38
call copy3_array(c_loc(aa), c_loc(bb), N)
!$omp end target data
if (any(abs(aa - 11.0_c_float) > 10.0_c_float * epsilon(aa))) stop 39
if (any(abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa))) stop 40
!$omp target data map(to:cc) map(from:dd) use_device_addr(cc,dd)
if (.not.present(cc) .or. .not.present(dd)) stop 41
if (.not.allocated(cc) .or. .not.allocated(dd)) stop 42
if (.not.c_associated(c_loc(cc)) .or. .not.c_associated(c_loc(dd))) stop 43
call copy3_array(c_loc(cc), c_loc(dd), N)
!$omp end target data
if (any(abs(cc - 33.0_c_float) > 10.0_c_float * epsilon(cc))) stop 44
if (any(abs(3.0_c_float * cc - dd) > 10.0_c_float * epsilon(cc))) stop 45
!$omp target data map(to:ee) map(from:ff) use_device_addr(ee,ff)
if (.not.present(ee) .or. .not.present(ff)) stop 46
if (.not.associated(ee) .or. .not.associated(ff)) stop 47
if (.not.c_associated(c_loc(ee)) .or. .not.c_associated(c_loc(ff))) stop 48
call copy3_array(c_loc(ee), c_loc(ff), N)
!$omp end target data
if (any(abs(ee - 55.0_c_float) > 10.0_c_float * epsilon(ee))) stop 49
if (any(abs(3.0_c_float * ee - ff) > 10.0_c_float * epsilon(ee))) stop 50
end subroutine test_dummy_opt_callee_1
subroutine test_dummy_opt_callee_1_absent(aa, bb, cc, dd, ee, ff, N)
! scalars
real(c_float), optional, target :: aa(:), bb(:)
real(c_float), optional, target, allocatable :: cc(:), dd(:)
real(c_float), optional, pointer :: ee(:), ff(:)
integer, value :: N
! All shall be absent
if (present(aa) .or. present(bb)) stop 51
if (present(cc) .or. present(dd)) stop 52
if (present(ee) .or. present(ff)) stop 53
!$omp target data map(to:aa) map(from:bb) use_device_addr(aa,bb)
if (present(aa) .or. present(bb)) stop 54
!$omp end target data
!$omp target data map(to:cc) map(from:dd) use_device_addr(cc,dd)
if (present(cc) .or. present(dd)) stop 55
!$omp end target data
!$omp target data map(to:ee) map(from:ff) use_device_addr(ee,ff)
if (present(ee) .or. present(ff)) stop 56
!$omp end target data
end subroutine test_dummy_opt_callee_1_absent
! Save device ptr - and recall pointer
subroutine test_dummy_opt_call_2()
integer, parameter :: N = 1000
real(c_float), target :: aa(N), bb(N)
real(c_float), target, allocatable :: cc(:), dd(:)
real(c_float), pointer :: ee(:), ff(:)
type(c_ptr) :: c_aptr, c_bptr, c_cptr, c_dptr, c_eptr, c_fptr
real(c_float), pointer :: aptr(:), bptr(:), cptr(:), dptr(:), eptr(:), fptr(:)
allocate(cc(N), dd(N), ee(N), ff(N))
call test_dummy_opt_callee_2(aa, bb, cc, dd, ee, ff, &
c_aptr, c_bptr, c_cptr, c_dptr, c_eptr, c_fptr, &
aptr, bptr, cptr, dptr, eptr, fptr, &
N)
deallocate(ee, ff)
end subroutine test_dummy_opt_call_2
subroutine test_dummy_opt_callee_2(aa, bb, cc, dd, ee, ff, &
c_aptr, c_bptr, c_cptr, c_dptr, c_eptr, c_fptr, &
aptr, bptr, cptr, dptr, eptr, fptr, &
N)
! scalars
real(c_float), optional, target :: aa(:), bb(:)
real(c_float), optional, target, allocatable :: cc(:), dd(:)
real(c_float), optional, pointer :: ee(:), ff(:)
type(c_ptr) :: c_aptr, c_bptr, c_cptr, c_dptr, c_eptr, c_fptr
real(c_float), optional, pointer :: aptr(:), bptr(:), cptr(:), dptr(:), eptr(:), fptr(:)
integer, value :: N
real(c_float) :: dummy
! All shall be present - and pointing to non-NULL
if (.not.present(aa) .or. .not.present(bb)) stop 57
if (.not.present(cc) .or. .not.present(dd)) stop 58
if (.not.present(ee) .or. .not.present(ff)) stop 59
if (.not.allocated(cc) .or. .not.allocated(dd)) stop 60
if (.not.associated(ee) .or. .not.associated(ff)) stop 61
aa = 111.0_c_float
bb = 222.0_c_float
cc = 333.0_c_float
dd = 444.0_c_float
ee = 555.0_c_float
ff = 666.0_c_float
!$omp target data map(to:aa) map(from:bb)
!$omp target data map(alloc:dummy) use_device_addr(aa,bb)
if (.not.present(aa) .or. .not.present(bb)) stop 62
if (.not.c_associated(c_loc(aa)) .or. .not.c_associated(c_loc(bb))) stop 63
c_aptr = c_loc(aa)
c_bptr = c_loc(bb)
aptr => aa
bptr => bb
if (.not.c_associated(c_aptr) .or. .not.c_associated(c_bptr)) stop 64
if (.not.associated(aptr) .or. .not.associated(bptr)) stop 65
!$omp end target data
if (.not.present(aa) .or. .not.present(bb)) stop 66
if (.not.c_associated(c_loc(aa)) .or. .not.c_associated(c_loc(bb))) stop 67
if (.not.c_associated(c_aptr) .or. .not.c_associated(c_bptr)) stop 68
if (.not.associated(aptr) .or. .not.associated(bptr)) stop 69
! check c_loc ptr once
call copy3_array(c_aptr, c_bptr, N)
!$omp target update from(bb)
if (any(abs(aa - 111.0_c_float) > 10.0_c_float * epsilon(aa))) stop 70
if (any(abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa))) stop 71
! check c_loc ptr again after target-value modification
aa = 1111.0_c_float
!$omp target update to(aa)
call copy3_array(c_aptr, c_bptr, N)
!$omp target update from(bb)
if (any(abs(aa - 1111.0_c_float) > 10.0_c_float * epsilon(aa))) stop 72
if (any(abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa))) stop 73
! check Fortran pointer after target-value modification
aa = 11111.0_c_float
!$omp target update to(aa)
call copy3_array(c_loc(aptr), c_loc(bptr), N)
!$omp target update from(bb)
if (any(abs(aa - 11111.0_c_float) > 10.0_c_float * epsilon(aa))) stop 74
if (any(abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa))) stop 75
!$omp end target data
if (any(abs(aa - 11111.0_c_float) > 10.0_c_float * epsilon(aa))) stop 76
if (any(abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa))) stop 77
!$omp target data map(to:cc) map(from:dd)
!$omp target data map(alloc:dummy) use_device_addr(cc,dd)
if (.not.present(cc) .or. .not.present(dd)) stop 78
if (.not.allocated(cc) .or. .not.allocated(dd)) stop 79
if (.not.c_associated(c_loc(cc)) .or. .not.c_associated(c_loc(dd))) stop 80
c_cptr = c_loc(cc)
c_dptr = c_loc(dd)
cptr => cc
dptr => dd
if (.not.c_associated(c_cptr) .or. .not.c_associated(c_dptr)) stop 81
if (.not.associated(cptr) .or. .not.associated(dptr)) stop 82
!$omp end target data
if (.not.present(cc) .or. .not.present(dd)) stop 83
if (.not.c_associated(c_loc(cc)) .or. .not.c_associated(c_loc(dd))) stop 84
if (.not.c_associated(c_cptr) .or. .not.c_associated(c_dptr)) stop 85
if (.not.associated(cptr) .or. .not.associated(dptr)) stop 86
! check c_loc ptr once
call copy3_array(c_cptr, c_dptr, N)
!$omp target update from(dd)
if (any(abs(cc - 333.0_c_float) > 10.0_c_float * epsilon(cc))) stop 87
if (any(abs(3.0_c_float * cc - dd) > 10.0_c_float * epsilon(cc))) stop 88
! check c_loc ptr again after target-value modification
cc = 3333.0_c_float
!$omp target update to(cc)
call copy3_array(c_cptr, c_dptr, N)
!$omp target update from(dd)
if (any(abs(cc - 3333.0_c_float) > 10.0_c_float * epsilon(cc))) stop 89
if (any(abs(3.0_c_float * cc - dd) > 10.0_c_float * epsilon(cc))) stop 90
! check Fortran pointer after target-value modification
cc = 33333.0_c_float
!$omp target update to(cc)
call copy3_array(c_loc(cptr), c_loc(dptr), N)
!$omp target update from(dd)
if (any(abs(cc - 33333.0_c_float) > 10.0_c_float * epsilon(cc))) stop 91
if (any(abs(3.0_c_float * cc - dd) > 10.0_c_float * epsilon(cc))) stop 92
!$omp end target data
if (any(abs(cc - 33333.0_c_float) > 10.0_c_float * epsilon(dd))) stop 93
if (any(abs(3.0_c_float * cc - dd) > 10.0_c_float * epsilon(dd))) stop 94
!$omp target data map(to:ee) map(from:ff)
!$omp target data map(alloc:dummy) use_device_addr(ee,ff)
if (.not.present(ee) .or. .not.present(ff)) stop 95
if (.not.associated(ee) .or. .not.associated(ff)) stop 96
if (.not.c_associated(c_loc(ee)) .or. .not.c_associated(c_loc(ff))) stop 97
c_eptr = c_loc(ee)
c_fptr = c_loc(ff)
eptr => ee
fptr => ff
if (.not.c_associated(c_eptr) .or. .not.c_associated(c_fptr)) stop 98
if (.not.associated(eptr) .or. .not.associated(fptr)) stop 99
!$omp end target data
if (.not.present(ee) .or. .not.present(ff)) stop 100
if (.not.associated(ee) .or. .not.associated(ff)) stop 101
if (.not.c_associated(c_loc(ee)) .or. .not.c_associated(c_loc(ff))) stop 102
if (.not.c_associated(c_eptr) .or. .not.c_associated(c_fptr)) stop 103
if (.not.associated(eptr) .or. .not.associated(fptr)) stop 104
! check c_loc ptr once
call copy3_array(c_eptr, c_fptr, N)
!$omp target update from(ff)
if (any(abs(ee - 555.0_c_float) > 10.0_c_float * epsilon(ee))) stop 105
if (any(abs(3.0_c_float * ee - ff) > 10.0_c_float * epsilon(ee))) stop 106
! check c_loc ptr again after target-value modification
ee = 5555.0_c_float
!$omp target update to(ee)
call copy3_array(c_eptr, c_fptr, N)
!$omp target update from(ff)
if (any(abs(ee - 5555.0_c_float) > 10.0_c_float * epsilon(ee))) stop 107
if (any(abs(3.0_c_float * ee - ff) > 10.0_c_float * epsilon(ee))) stop 108
! check Fortran pointer after target-value modification
ee = 55555.0_c_float
!$omp target update to(ee)
call copy3_array(c_loc(eptr), c_loc(fptr), N)
!$omp target update from(ff)
if (any(abs(ee - 55555.0_c_float) > 10.0_c_float * epsilon(ee))) stop 109
if (any(abs(3.0_c_float * ee - ff) > 10.0_c_float * epsilon(ff))) stop 110
!$omp end target data
if (any(abs(ee - 55555.0_c_float) > 10.0_c_float * epsilon(ee))) stop 111
if (any(abs(3.0_c_float * ee - ff) > 10.0_c_float * epsilon(ee))) stop 112
end subroutine test_dummy_opt_callee_2
end module test_dummies_opt
! Test nullptr
module test_nullptr
use iso_c_binding
implicit none (type, external)
private
public :: test_nullptr_1
contains
subroutine test_nullptr_1()
real(c_float), pointer :: aa(:), bb(:)
real(c_float), pointer :: ee(:), ff(:)
real(c_float), allocatable, target :: gg(:), hh(:)
type(c_ptr) :: c_aptr, c_bptr, c_eptr, c_fptr, c_gptr, c_hptr
real(c_float), pointer :: aptr(:), bptr(:), eptr(:), fptr(:), gptr(:), hptr(:)
aa => null()
bb => null()
ee => null()
ff => null()
if (associated(aa) .or. associated(bb)) stop 113
!$omp target data map(to:aa) map(from:bb) use_device_addr(aa,bb)
if (c_associated(c_loc(aa)) .or. c_associated(c_loc(bb))) stop 114
c_aptr = c_loc(aa)
c_bptr = c_loc(bb)
aptr => aa
bptr => bb
if (c_associated(c_aptr) .or. c_associated(c_bptr)) stop 115
if (associated(aptr) .or. associated(bptr, bb)) stop 116
if (associated(aa) .or. associated(bb)) stop 117
!$omp end target data
if (c_associated(c_aptr) .or. c_associated(c_bptr)) stop 118
if (associated(aptr) .or. associated(bptr, bb)) stop 119
if (associated(aa) .or. associated(bb)) stop 120
if (allocated(gg)) stop 121
!$omp target data map(tofrom:gg) use_device_addr(gg)
if (c_associated(c_loc(gg))) stop 122
c_gptr = c_loc(gg)
gptr => gg
if (c_associated(c_gptr)) stop 123
if (associated(gptr)) stop 124
if (allocated(gg)) stop 125
!$omp end target data
if (c_associated(c_gptr)) stop 126
if (associated(gptr)) stop 127
if (allocated(gg)) stop 128
call test_dummy_opt_nullptr_callee_1(ee, ff, hh, c_eptr, c_fptr, c_hptr, eptr, fptr, hptr)
end subroutine test_nullptr_1
subroutine test_dummy_opt_nullptr_callee_1(ee, ff, hh, c_eptr, c_fptr, c_hptr, eptr, fptr, hptr)
! scalars
real(c_float), optional, pointer :: ee(:), ff(:)
real(c_float), optional, allocatable, target :: hh(:)
type(c_ptr), optional :: c_eptr, c_fptr, c_hptr
real(c_float), optional, pointer :: eptr(:), fptr(:), hptr(:)
if (.not.present(ee) .or. .not.present(ff)) stop 129
if (associated(ee) .or. associated(ff)) stop 130
!$omp target data map(to:ee) map(from:ff) use_device_addr(ee,ff)
if (.not.present(ee) .or. .not.present(ff)) stop 131
if (associated(ee) .or. associated(ff)) stop 132
if (c_associated(c_loc(ee)) .or. c_associated(c_loc(ff))) stop 133
c_eptr = c_loc(ee)
c_fptr = c_loc(ff)
eptr => ee
fptr => ff
if (c_associated(c_eptr) .or. c_associated(c_fptr)) stop 134
if (associated(eptr) .or. associated(fptr)) stop 135
!$omp end target data
if (c_associated(c_eptr) .or. c_associated(c_fptr)) stop 136
if (associated(eptr) .or. associated(fptr)) stop 137
if (allocated(hh)) stop 138
!$omp target data map(tofrom:hh) use_device_addr(hh)
if (c_associated(c_loc(hh))) stop 139
c_hptr = c_loc(hh)
hptr => hh
if (c_associated(c_hptr)) stop 140
if (associated(hptr)) stop 141
if (allocated(hh)) stop 142
!$omp end target data
if (c_associated(c_hptr)) stop 143
if (associated(hptr)) stop 144
if (allocated(hh)) stop 145
end subroutine test_dummy_opt_nullptr_callee_1
end module test_nullptr
! Test local variables
module tests
use iso_c_binding
use target_procs
implicit none (type, external)
private
public :: test_main_1, test_main_2
contains
! map + use_device_addr + c_loc
subroutine test_main_1()
integer, parameter :: N = 1000
real(c_float), target, allocatable :: cc(:), dd(:)
real(c_float), pointer :: ee(:), ff(:)
allocate(cc(N), dd(N), ee(N), ff(N))
cc = 33.0_c_float
dd = 44.0_c_float
ee = 55.0_c_float
ff = 66.0_c_float
!$omp target data map(to:cc) map(from:dd) use_device_addr(cc,dd)
call copy3_array(c_loc(cc), c_loc(dd), N)
!$omp end target data
if (any(abs(cc - 33.0_c_float) > 10.0_c_float * epsilon(cc))) stop 146
if (any(abs(3.0_c_float * cc - dd) > 10.0_c_float * epsilon(cc))) stop 147
!$omp target data map(to:ee) map(from:ff) use_device_addr(ee,ff)
call copy3_array(c_loc(ee), c_loc(ff), N)
!$omp end target data
if (any(abs(ee - 55.0_c_float) > 10.0_c_float * epsilon(ee))) stop 148
if (any(abs(3.0_c_float * ee - ff) > 10.0_c_float * epsilon(ee))) stop 149
deallocate(ee, ff) ! pointers, only
end subroutine test_main_1
! Save device ptr - and recall pointer
subroutine test_main_2
integer, parameter :: N = 1000
real(c_float), target, allocatable :: cc(:), dd(:)
real(c_float), pointer :: ee(:), ff(:)
real(c_float) :: dummy
type(c_ptr) :: c_cptr, c_dptr, c_eptr, c_fptr
real(c_float), pointer :: cptr(:), dptr(:), eptr(:), fptr(:)
allocate(cc(N), dd(N), ee(N), ff(N))
cc = 333.0_c_float
dd = 444.0_c_float
ee = 555.0_c_float
ff = 666.0_c_float
!$omp target data map(to:cc) map(from:dd)
!$omp target data map(alloc:dummy) use_device_addr(cc,dd)
c_cptr = c_loc(cc)
c_dptr = c_loc(dd)
cptr => cc
dptr => dd
!$omp end target data
! check c_loc ptr once
call copy3_array(c_cptr, c_dptr, N)
!$omp target update from(dd)
if (any(abs(cc - 333.0_c_float) > 10.0_c_float * epsilon(cc))) stop 150
if (any(abs(3.0_c_float * cc - dd) > 10.0_c_float * epsilon(cc))) stop 151
! check c_loc ptr again after target-value modification
cc = 3333.0_c_float
!$omp target update to(cc)
call copy3_array(c_cptr, c_dptr, N)
!$omp target update from(dd)
if (any(abs(cc - 3333.0_c_float) > 10.0_c_float * epsilon(cc))) stop 152
if (any(abs(3.0_c_float * cc - dd) > 10.0_c_float * epsilon(cc))) stop 153
! check Fortran pointer after target-value modification
cc = 33333.0_c_float
!$omp target update to(cc)
call copy3_array(c_loc(cptr), c_loc(dptr), N)
!$omp target update from(dd)
if (any(abs(cc - 33333.0_c_float) > 10.0_c_float * epsilon(cc))) stop 154
if (any(abs(3.0_c_float * cc - dd) > 10.0_c_float * epsilon(cc))) stop 155
!$omp end target data
if (any(abs(cc - 33333.0_c_float) > 10.0_c_float * epsilon(dd))) stop 156
if (any(abs(3.0_c_float * cc - dd) > 10.0_c_float * epsilon(dd))) stop 157
!$omp target data map(to:ee) map(from:ff)
!$omp target data map(alloc:dummy) use_device_addr(ee,ff)
c_eptr = c_loc(ee)
c_fptr = c_loc(ff)
eptr => ee
fptr => ff
!$omp end target data
! check c_loc ptr once
call copy3_array(c_eptr, c_fptr, N)
!$omp target update from(ff)
if (any(abs(ee - 555.0_c_float) > 10.0_c_float * epsilon(ee))) stop 158
if (any(abs(3.0_c_float * ee - ff) > 10.0_c_float * epsilon(ee))) stop 159
! check c_loc ptr again after target-value modification
ee = 5555.0_c_float
!$omp target update to(ee)
call copy3_array(c_eptr, c_fptr, N)
!$omp target update from(ff)
if (any(abs(ee - 5555.0_c_float) > 10.0_c_float * epsilon(ee))) stop 160
if (any(abs(3.0_c_float * ee - ff) > 10.0_c_float * epsilon(ee))) stop 161
! check Fortran pointer after target-value modification
ee = 55555.0_c_float
!$omp target update to(ee)
call copy3_array(c_loc(eptr), c_loc(fptr), N)
!$omp target update from(ff)
if (any(abs(ee - 55555.0_c_float) > 10.0_c_float * epsilon(ee))) stop 162
if (any(abs(3.0_c_float * ee - ff) > 10.0_c_float * epsilon(ff))) stop 163
!$omp end target data
if (any(abs(ee - 55555.0_c_float) > 10.0_c_float * epsilon(ee))) stop 164
if (any(abs(3.0_c_float * ee - ff) > 10.0_c_float * epsilon(ee))) stop 165
deallocate(ee, ff)
end subroutine test_main_2
end module tests
program omp_device_addr
use tests
use test_dummies
use test_dummies_opt
use test_nullptr
implicit none (type, external)
call test_main_1()
call test_main_2()
call test_dummy_call_1()
call test_dummy_call_2()
call test_dummy_opt_call_1()
call test_dummy_opt_call_2()
call test_nullptr_1()
end program omp_device_addr
Reference in New Issue View Git Blame Copy Permalink