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

   1 ! { dg-additional-sources my-usleep.c }
   2 ! { dg-prune-output "command-line option '-fintrinsic-modules-path=.*' is valid for Fortran but not for C" }
   3
   4 module m
   5   implicit none
   6
   7   interface
   8     subroutine usleep(t) bind(C, name="my_usleep")
   9       use iso_c_binding
  10       integer(c_int), value :: t
  11     end subroutine
  12   end interface
  13
  14 contains
  15 subroutine test (ifval)
  16   logical, value :: ifval
  17   integer :: a(0:7), b(0:7), i
  18
  19   do i = 0, 7
  20     a(i) = i
  21     b(i) = 2 * i
  22   end do
  23   !$omp parallel
  24   block
  25    !$omp single
  26    block
  27     !$omp task shared(a) depend(in: a(0))
  28     block
  29       call usleep (5000)
  30       a(0) = 42
  31     end block
  32     !$omp task shared(a) depend(out: a(1))
  33     block
  34       call usleep (5000)
  35       a(1) = 43
  36     end block
  37     !$omp task shared(a) depend(inout: a(2))
  38     block
  39       call usleep (5000)
  40       a(2) = 44
  41     end block
  42     !$omp task shared(a) depend(mutexinoutset: a(3))
  43     block
  44       call usleep (5000)
  45       a(3) = 45
  46     end block
  47     !$omp task shared(a)
  48     block
  49       call usleep (15000)
  50       a(4) = 46
  51     end block
  52     !$omp task shared(b) depend(in: b(0))
  53     block
  54       call usleep (5000)
  55       b(0) = 47
  56     end block
  57     !$omp task shared(b) depend(in: b(4))
  58     block
  59       call usleep (5000)
  60       b(4) = 48
  61     end block
  62     !$omp task shared(b) depend(inoutset: b(5))
  63     block
  64       call usleep (5000)
  65       b(5) = 49
  66     end block
  67
  68     ! None of the above tasks depend on each other.
  69     ! The following task depends on all but the a(4) = 46; one.
  70     !$omp task shared(a, b) depend(out: omp_all_memory) private(i) if(ifval)
  71     block
  72       if (a(0) /= 42 .or. a(1) /= 43 .or. a(2) /= 44 .or. a(3) /= 45       &
  73           .or. a(5) /= 5 .or. a(6) /= 6 .or. a(7) /= 7                     &
  74           .or. b(0) /= 47 .or. b(1) /= 2 .or. b(2) /= 4 .or. b(3) /= 6     &
  75           .or. b(4) /= 48 .or. b(5) /= 49 .or. b(6) /= 12 .or. b(7) /= 14) &
  76         error stop
  77       do i = 0, 7
  78         if (i /= 4) &
  79           a(i) = 3 * i + 7
  80       end do
  81       do i = 0, 7
  82         b(i) = 4 * i - 7
  83       end do
  84     end block
  85     ! The following task depends on both b(0) = 47; and
  86     ! above omp_all_memory tasks, but as the latter depends on
  87     ! the former, effectively it is dependent just on the omp_all_memory
  88     ! task.
  89     !$omp task shared(b) depend(inout: b(0))
  90     block
  91       call usleep (5000)
  92       b(0) = 49
  93     end block
  94     ! The following task depends on all the above except a(4) = 46; one,
  95     ! but it can be reduced to dependency on the above omp_all_memory
  96     ! one and b(0) = 49; one.
  97     !$omp task shared(a, b) depend(inout: b(7), omp_all_memory, b(6)) &
  98     !$omp&     private(i) if(ifval)
  99     block
 100       do i = 0, 7
 101         if (i /= 4) then
 102             if (a(i) /= 3 * i + 7) &
 103               error stop
 104             a(i) = 5 * i + 50
 105         end if
 106       end do
 107       if (b(0) /= 49) &
 108         error stop
 109       b(0) = 6 * i + 57
 110       do i = 1, 7
 111         if (b(i) /= 4 * i - 7) &
 112           error stop
 113         b(i) = 6 * i + 57
 114       end do
 115     end block
 116     !$omp taskwait
 117     if (a(4) /= 46) &
 118       error stop
 119    end block   ! end single
 120   end block  ! end parallel
 121 end
 122 end module m
 123
 124 use m
 125 call test(.true.)
 126 call test(.false.)
 127 end