libgomp/testsuite/libgomp.fortran/get-mapped-ptr-4.f90

   1 program main
   2   use omp_lib
   3   use iso_c_binding
   4   implicit none (external, type)
   5   integer :: d, id
   6   type(c_ptr) :: p1, p2
   7
   8   type t
   9     integer :: m1, m2
  10   end type t
  11   type(t), target :: s
  12
  13   d = omp_get_default_device ()
  14   id = omp_get_initial_device ()
  15
  16   if (d < 0 .or. d >= omp_get_num_devices ()) &
  17     d = id
  18
  19   if (d /= id) then
  20     !$omp target data map(alloc: s, s%m2) device(d)
  21       !$omp target map(from: p1, p2) map(alloc: s, s%m2) device(d)
  22       p1 = c_loc (s);
  23       p2 = c_loc (s%m2);
  24       !$omp end target
  25
  26       if (.not. c_associated (omp_get_mapped_ptr (c_loc (s), d), p1) &
  27           .or. .not. c_associated (omp_get_mapped_ptr (c_loc (s%m2), d), p2)) &
  28         stop 0
  29     !$omp end target data
  30
  31     if (c_associated (omp_get_mapped_ptr (c_loc (s), d)) &
  32         .or. c_associated (omp_get_mapped_ptr (c_loc (s%m2), d))) &
  33       stop 1
  34
  35     !$omp target enter data map (alloc: s, s%m2) device (d)
  36       !$omp target map(from: p1, p2) map(alloc: s, s%m2) device(d)
  37       p1 = c_loc (s);
  38       p2 = c_loc (s%m2);
  39       !$omp end target
  40
  41       if (.not. c_associated (omp_get_mapped_ptr (c_loc (s), d), p1) &
  42           .or. .not. c_associated (omp_get_mapped_ptr (c_loc (s%m2), d), p2)) &
  43         stop 2
  44     !$omp target exit data map (delete: s, s%m2) device (d)
  45
  46     if (c_associated (omp_get_mapped_ptr (c_loc (s), d)) &
  47         .or. c_associated (omp_get_mapped_ptr (c_loc (s%m2), d))) &
  48       stop 3
  49
  50   else ! d == id
  51
  52     !$omp target data map(alloc: s, s%m2) device(d)
  53       !$omp target map(from: p1, p2) map(alloc: s, s%m2) device(d)
  54       p1 = c_loc (s);
  55       p2 = c_loc (s%m2);
  56       !$omp end target
  57
  58       if (.not. c_associated (omp_get_mapped_ptr (c_loc (s), d), c_loc (s)) &
  59         .or. .not. c_associated (omp_get_mapped_ptr (c_loc (s%m2), d), c_loc (s%m2))) &
  60         stop 4
  61     !$omp end target data
  62
  63     if (.not. c_associated (omp_get_mapped_ptr (c_loc (s), d), c_loc (s)) &
  64         .or. .not. c_associated (omp_get_mapped_ptr (c_loc (s%m2), d), c_loc (s%m2))) &
  65       stop 5
  66
  67     !$omp target enter data map (alloc: s, s%m2) device (d)
  68       !$omp target map(from: p1, p2) map(alloc: s, s%m2) device(d)
  69       p1 = c_loc (s);
  70       p2 = c_loc (s%m2);
  71       !$omp end target
  72
  73       if (.not. c_associated (omp_get_mapped_ptr (c_loc (s), d), c_loc (s)) &
  74         .or. .not. c_associated (omp_get_mapped_ptr (c_loc (s%m2), d), c_loc (s%m2))) &
  75         stop 6
  76
  77     !$omp target exit data map (delete: s, s%m2) device (d)
  78
  79     if (.not. c_associated (omp_get_mapped_ptr (c_loc (s), d), c_loc (s)) &
  80         .or. .not. c_associated (omp_get_mapped_ptr (c_loc (s%m2), d), c_loc (s%m2))) &
  81       stop 7
  82   end if
  83
  84 end program main