libgomp/testsuite/libgomp.fortran/pr66199-5.f90

   1 ! { dg-do run }
   2 !
   3 ! PR fortran/94690
   4 ! PR middle-end/66199
   5
   6 module m
   7   implicit none
   8   integer u(0:1023), v(0:1023), w(0:1023)
   9   !$omp declare target (u, v, w)
  10
  11 contains
  12
  13 integer function f1 (a, b)
  14   integer :: a, b, d
  15   !$omp target map(from: d)
  16   !$omp teams distribute parallel do simd default(none) firstprivate (a, b) shared(u, v, w)
  17   do d = a, b-1
  18     u(d) = v(d) + w(d)
  19   end do
  20   !$omp end target
  21   f1 = d
  22 end
  23
  24 integer function f2 (a, b, c)
  25   integer :: a, b, c, d, e
  26   !$omp target map(from: d, e)
  27   !$omp teams distribute parallel do simd default(none) firstprivate (a, b, c) shared(u, v, w) linear(d) lastprivate(e)
  28   do d = a, b-1
  29     u(d) = v(d) + w(d)
  30     e = c + d * 5
  31   end do
  32   !$omp end target
  33   f2 = d + e
  34 end
  35
  36 integer function f3 (a1, b1, a2, b2)
  37   integer :: a1, b1, a2, b2, d1, d2
  38   !$omp target map(from: d1, d2)
  39   !$omp teams distribute parallel do simd default(none) firstprivate (a1, b1, a2, b2) shared(u, v, w) lastprivate(d1, d2) &
  40   !$omp&      collapse(2)
  41   do d1 = a1, b1-1
  42     do d2 = a2, b2-1
  43       u(d1 * 32 + d2) = v(d1 * 32 + d2) + w(d1 * 32 + d2)
  44     end do
  45   end do
  46   !$omp end target
  47   f3 = d1 + d2
  48 end
  49
  50 integer function f4 (a1, b1, a2, b2)
  51   integer :: a1, b1, a2, b2, d1, d2
  52   !$omp target map(from: d1, d2)
  53   !$omp teams distribute parallel do simd default(none) firstprivate (a1, b1, a2, b2) shared(u, v, w) collapse(2)
  54   do d1 = a1, b1-1
  55     do d2 = a2, b2-1
  56       u(d1 * 32 + d2) = v(d1 * 32 + d2) + w(d1 * 32 + d2)
  57     end do
  58   end do
  59   !$omp end target
  60   f4 = d1 + d2
  61 end
  62 end module
  63
  64 program main
  65   use m
  66   implicit none
  67   if (f1 (0, 1024) /= 1024) stop 1
  68   if (f2 (0, 1024, 17) /= 1024 + (17 + 5 * 1023)) stop 2
  69   if (f3 (0, 32, 0, 32) /= 64) stop 3
  70   if (f4 (0, 32, 0, 32) /= 64) stop 3
  71 end