blob: 4300a5561ac57b7508128df9236dc4a0db9d153e [file] [log] [blame]
program main
use omp_lib
use iso_c_binding
implicit none (external, type)
integer :: d, id
type(c_ptr) :: p1, p2
type t
integer :: m1, m2
end type t
type(t), target :: s
d = omp_get_default_device ()
id = omp_get_initial_device ()
if (d < 0 .or. d >= omp_get_num_devices ()) &
d = id
if (d /= id) then
!$omp target data map(alloc: s, s%m2) device(d)
!$omp target map(from: p1, p2) map(alloc: s, s%m2) device(d)
p1 = c_loc (s);
p2 = c_loc (s%m2);
!$omp end target
if (.not. c_associated (omp_get_mapped_ptr (c_loc (s), d), p1) &
.or. .not. c_associated (omp_get_mapped_ptr (c_loc (s%m2), d), p2)) &
stop 0
!$omp end target data
if (c_associated (omp_get_mapped_ptr (c_loc (s), d)) &
.or. c_associated (omp_get_mapped_ptr (c_loc (s%m2), d))) &
stop 1
!$omp target enter data map (alloc: s, s%m2) device (d)
!$omp target map(from: p1, p2) map(alloc: s, s%m2) device(d)
p1 = c_loc (s);
p2 = c_loc (s%m2);
!$omp end target
if (.not. c_associated (omp_get_mapped_ptr (c_loc (s), d), p1) &
.or. .not. c_associated (omp_get_mapped_ptr (c_loc (s%m2), d), p2)) &
stop 2
!$omp target exit data map (delete: s, s%m2) device (d)
if (c_associated (omp_get_mapped_ptr (c_loc (s), d)) &
.or. c_associated (omp_get_mapped_ptr (c_loc (s%m2), d))) &
stop 3
else ! d == id
!$omp target data map(alloc: s, s%m2) device(d)
!$omp target map(from: p1, p2) map(alloc: s, s%m2) device(d)
p1 = c_loc (s);
p2 = c_loc (s%m2);
!$omp end target
if (.not. c_associated (omp_get_mapped_ptr (c_loc (s), d), c_loc (s)) &
.or. .not. c_associated (omp_get_mapped_ptr (c_loc (s%m2), d), c_loc (s%m2))) &
stop 4
!$omp end target data
if (.not. c_associated (omp_get_mapped_ptr (c_loc (s), d), c_loc (s)) &
.or. .not. c_associated (omp_get_mapped_ptr (c_loc (s%m2), d), c_loc (s%m2))) &
stop 5
!$omp target enter data map (alloc: s, s%m2) device (d)
!$omp target map(from: p1, p2) map(alloc: s, s%m2) device(d)
p1 = c_loc (s);
p2 = c_loc (s%m2);
!$omp end target
if (.not. c_associated (omp_get_mapped_ptr (c_loc (s), d), c_loc (s)) &
.or. .not. c_associated (omp_get_mapped_ptr (c_loc (s%m2), d), c_loc (s%m2))) &
stop 6
!$omp target exit data map (delete: s, s%m2) device (d)
if (.not. c_associated (omp_get_mapped_ptr (c_loc (s), d), c_loc (s)) &
.or. .not. c_associated (omp_get_mapped_ptr (c_loc (s%m2), d), c_loc (s%m2))) &
stop 7
end if
end program main