libgomp/testsuite/libgomp.fortran/target-13.f90

   1 module m
   2   implicit none
   3   type t
   4     integer :: s, a(5)
   5   end type t
   6
   7   type t2
   8     integer :: s, a(5)
   9     type(t) :: st, at(2:3)
  10   end type t2
  11
  12   interface operator(/=)
  13     procedure ne_compare_t
  14     procedure ne_compare_t2
  15   end interface
  16
  17 contains
  18
  19   logical pure elemental function ne_compare_t (a, b) result(res)
  20     type(t), intent(in) :: a, b
  21     res = (a%s /= b%s) .or. any(a%a /= b%a)
  22   end function
  23
  24   logical pure elemental function ne_compare_t2 (a, b) result(res)
  25     type(t2), intent(in) :: a, b
  26     res = (a%s /= b%s) .or. any(a%a /= b%a)     &
  27           .or. (a%st /= b%st) .or. any(a%at /= b%at)
  28   end function
  29 end module m
  30
  31 program p
  32 use m
  33 implicit none
  34
  35 type(t2) :: var1, var2(5), var3(:)
  36 type(t2) :: var1a, var2a(5), var3a(:)
  37 allocatable :: var3, var3a
  38 logical :: shared_memory = .false.
  39
  40 !$omp target map(to: shared_memory)
  41   shared_memory = .true.
  42 !$omp end target
  43
  44 var1 = T2(1, [1,2,3,4,5], T(11, [11,22,33,44,55]), &
  45           [T(-11, [-11,-22,-33,-44,-55]), T(11, [11,22,33,44,55])])
  46
  47 var2 = [T2(101, [201,202,203,204,205], T(2011, [2011,2022,2033,2044,2055]), &
  48            [T(-11, [-11,-22,-33,-44,-55]), T(11, [11,22,33,44,55])]),       &
  49         T2(111, [211,212,213,214,215], T(2111, [2111,2122,2133,2144,2155]), &
  50            [T(-11, [-11,-22,-33,-44,-55]), T(11, [11,22,33,44,55])]),       &
  51         T2(121, [221,222,223,224,225], T(2211, [2211,2222,2233,2244,2255]), &
  52            [T(-11, [-11,-22,-33,-44,-55]), T(11, [11,22,33,44,55])]),       &
  53         T2(131, [231,232,233,234,235], T(2311, [2311,2322,2333,2344,2355]), &
  54            [T(-11, [-11,-22,-33,-44,-55]), T(11, [11,22,33,44,55])]),       &
  55         T2(141, [241,242,243,244,245], T(2411, [2411,2422,2433,2444,2455]), &
  56            [T(-11, [-11,-22,-33,-44,-55]), T(11, [11,22,33,44,55])])]
  57
  58 var3 = [T2(301, [401,402,403,404,405], T(4011, [4011,4022,4033,4044,4055]), &
  59            [T(-11, [-11,-22,-33,-44,-55]), T(11, [11,22,33,44,55])]),       &
  60         T2(311, [411,412,413,414,415], T(4111, [4111,4122,4133,4144,4155]), &
  61            [T(-11, [-11,-22,-33,-44,-55]), T(11, [11,22,33,44,55])]),       &
  62         T2(321, [421,422,423,424,425], T(4211, [4211,4222,4233,4244,4255]), &
  63            [T(-11, [-11,-22,-33,-44,-55]), T(11, [11,22,33,44,55])]),       &
  64         T2(331, [431,432,433,434,435], T(4311, [4311,4322,4333,4344,4355]), &
  65            [T(-11, [-11,-22,-33,-44,-55]), T(11, [11,22,33,44,55])]),       &
  66         T2(341, [441,442,443,444,445], T(4411, [4411,4422,4433,4444,4455]), &
  67            [T(-11, [-11,-22,-33,-44,-55]), T(11, [11,22,33,44,55])])]
  68
  69 var1a = var1
  70 var2a = var2
  71 var3a = var3
  72
  73 !$omp target enter data map(to:var1)
  74 !$omp target enter data map(to:var2)
  75 !$omp target enter data map(to:var3)
  76
  77 ! ---------------
  78
  79 !$omp target update from(var1%at(2:3))
  80
  81 if (var1a /= var1) error stop
  82 if (any (var2a /= var2)) error stop
  83 if (any (var3a /= var3)) error stop
  84
  85 ! ---------------
  86
  87 !$omp target
  88   var1%st%s = 1243
  89   var2(3)%at(2) = T(123, [345,64,356,39,13])
  90   var2(3)%at(3) = T(48, [74,162,572,357,3])
  91 !$omp end target
  92
  93 if (.not. shared_memory) then
  94   if (var1 /= var1) error stop
  95   if (any (var2a /= var2)) error stop
  96   if (any (var3a /= var3)) error stop
  97 endif
  98
  99 !$omp target update from(var1%st) from(var2(3)%at(2:3))
 100
 101 var1a%st%s = 1243
 102 var2a(3)%at(2) = T(123, [345,64,356,39,13])
 103 var2a(3)%at(3) = T(48, [74,162,572,357,3])
 104 if (var1 /= var1) error stop
 105 if (any (var2a /= var2)) error stop
 106 if (any (var3a /= var3)) error stop
 107
 108 ! ---------------
 109
 110 var3(1) = var2(1)
 111 var1%at(2)%a = var2(1)%a
 112 var1%at(3)%a = var2(2)%a
 113
 114 var1a = var1
 115 var2a = var2
 116 var3a = var3
 117
 118 !$omp target update to(var3) to(var1%at(2:3))
 119
 120 !$omp target
 121   var3(1)%s = var3(1)%s + 123
 122   var1%at(2)%a = var1%at(2)%a * 7
 123   var1%at(3)%s = var1%at(3)%s * (-3)
 124 !$omp end target
 125
 126 if (.not. shared_memory) then
 127   if (var1 /= var1) error stop
 128   if (any (var2a /= var2)) error stop
 129   if (any (var3a /= var3)) error stop
 130 endif
 131
 132 var3a(1)%s = var3a(1)%s + 123
 133 var1a%at(2)%a = var1a%at(2)%a * 7
 134 var1a%at(3)%s = var1a%at(3)%s * (-3)
 135
 136 block
 137   integer, volatile :: i1,i2,i3,i4
 138   i1 = 1
 139   i2 = 2
 140   i3 = 1
 141   i4 = 2
 142   !$omp target update from(var3(i1:i2)) from(var1%at(i3:i4))
 143   i1 = 3
 144   i2 = 3
 145   i3 = 1
 146   i4 = 5
 147   !$omp target update from(var1%at(i1)%s) from(var1%at(i2)%a(i3:i4))
 148 end block
 149
 150 if (var1 /= var1) error stop
 151 if (any (var2a /= var2)) error stop
 152 if (any (var3a /= var3)) error stop
 153
 154 ! ---------------
 155
 156 !$omp target exit data map(from:var1)
 157 !$omp target exit data map(from:var2)
 158 !$omp target exit data map(from:var3)
 159 end