libgomp/testsuite/libgomp.fortran/nestedfn5.f90

   1 ! { dg-do run }
   2
   3   interface
   4     subroutine bar (q)
   5       integer :: q(19:)
   6     end subroutine
   7   end interface
   8   integer :: q(7:15)
   9   q(:) = 5
  10   call bar (q)
  11 end
  12 subroutine bar (q)
  13   use iso_c_binding, only: c_ptr, c_loc, c_int
  14   integer :: a, b, c, d(2:3,4:5), q(19:), h, k, m, n, o, p
  15   integer(c_int), target :: e(64)
  16   type (c_ptr) :: f, g(64)
  17   logical :: l
  18   a = 1
  19   b = 2
  20   c = 3
  21   d = 4
  22   l = .false.
  23   f = c_loc (e)
  24   call foo
  25 contains
  26   subroutine foo
  27     use iso_c_binding, only: c_sizeof
  28 !$omp simd linear(a:2) linear(b:1)
  29     do a = 1, 20, 2
  30       b = b + 1
  31     end do
  32 !$omp end simd
  33     if (a /= 21 .or. b /= 12) stop 1
  34 !$omp simd aligned(f : c_sizeof (e(1)))
  35     do b = 1, 64
  36       g(b) = f
  37     end do
  38 !$omp end simd
  39 !$omp parallel
  40 !$omp single
  41 !$omp taskgroup
  42 !$omp task depend(out : a, d(2:2,4:5))
  43     a = a + 1
  44     d(2:2,4:5) = d(2:2,4:5) + 1
  45 !$omp end task
  46 !$omp task depend(in : a, d(2:2,4:5))
  47     if (a /= 22) stop 2
  48     if (any (d(2:2,4:5) /= 5)) stop 3
  49 !$omp end task
  50 !$omp end taskgroup
  51 !$omp end single
  52 !$omp end parallel
  53     b = 10
  54 !$omp target data map (tofrom: a, d(2:3,4:4), q) map (from: l)
  55 !$omp target map (tofrom: b, d(2:3,4:4)) map (alloc: a, l)
  56     l = .false.
  57     if (a /= 22 .or. any (q /= 5)) l = .true.
  58     if (lbound (q, 1) /= 19 .or. ubound (q, 1) /= 27) l = .true.
  59     if (d(2,4) /= 5 .or. d(3,4) /= 4) l = .true.
  60     l = l .or. (b /= 10)
  61     a = 6
  62     b = 11
  63     q = 8
  64     d(2:3,4:4) = 9
  65 !$omp end target
  66 !$omp target update from (a, q, d(2:3,4:4), l)
  67     if (a /= 6 .or. l .or. b /= 11 .or. any (q /= 8)) stop 4
  68     if (any (d(2:3,4:4) /= 9) .or. d(2,5) /= 5 .or. d(3,5) /= 4) stop 5
  69     a = 12
  70     b = 13
  71     q = 14
  72     d = 15
  73 !$omp target update to (a, q, d(2:3,4:4))
  74 !$omp target map (tofrom: b, d(2:3,4:4)) map (alloc: a, l)
  75     if (a /= 12 .or. b /= 13 .or. any (q /= 14)) l = .true.
  76     l = l .or. any (d(2:3,4:4) /= 15)
  77 !$omp end target
  78     a = 0
  79     b = 1
  80     c = 100
  81     h = 8
  82     m = 0
  83     n = 64
  84     o = 16
  85     if (l) stop 6
  86 !$omp target teams distribute parallel do simd if (.not.l) device(a) &
  87 !$omp & num_teams(b) dist_schedule(static, c) num_threads (h) &
  88 !$omp & reduction (+: m) safelen (n) schedule(static, o) &
  89 !$omp & defaultmap(tofrom: scalar)
  90     do p = 1, 64
  91       m = m + 1
  92     end do
  93 !$omp end target teams distribute parallel do simd
  94     if (m /= 64) stop 7
  95 !$omp end target data
  96   end subroutine foo
  97 end subroutine bar