libgomp/testsuite/libgomp.fortran/retval1.f90

   1 ! { dg-do run }
   2
   3 function f1 ()
   4   use omp_lib
   5   real :: f1
   6   logical :: l
   7   f1 = 6.5
   8   l = .false.
   9 !$omp parallel firstprivate (f1) num_threads (2) reduction (.or.:l)
  10   l = f1 .ne. 6.5
  11   if (omp_get_thread_num () .eq. 0) f1 = 8.5
  12   if (omp_get_thread_num () .eq. 1) f1 = 14.5
  13 !$omp barrier
  14   l = l .or. (omp_get_thread_num () .eq. 0 .and. f1 .ne. 8.5)
  15   l = l .or. (omp_get_thread_num () .eq. 1 .and. f1 .ne. 14.5)
  16 !$omp end parallel
  17   if (l) call abort
  18   f1 = -2.5
  19 end function f1
  20 function f2 ()
  21   use omp_lib
  22   real :: f2, e2
  23   logical :: l
  24 entry e2 ()
  25   f2 = 6.5
  26   l = .false.
  27 !$omp parallel firstprivate (e2) num_threads (2) reduction (.or.:l)
  28   l = e2 .ne. 6.5
  29   if (omp_get_thread_num () .eq. 0) e2 = 8.5
  30   if (omp_get_thread_num () .eq. 1) e2 = 14.5
  31 !$omp barrier
  32   l = l .or. (omp_get_thread_num () .eq. 0 .and. e2 .ne. 8.5)
  33   l = l .or. (omp_get_thread_num () .eq. 1 .and. e2 .ne. 14.5)
  34 !$omp end parallel
  35   if (l) call abort
  36   e2 = 7.5
  37 end function f2
  38 function f3 ()
  39   use omp_lib
  40   real :: f3, e3
  41   logical :: l
  42 entry e3 ()
  43   f3 = 6.5
  44   l = .false.
  45 !$omp parallel firstprivate (f3, e3) num_threads (2) reduction (.or.:l)
  46   l = e3 .ne. 6.5
  47   l = l .or. f3 .ne. 6.5
  48   if (omp_get_thread_num () .eq. 0) e3 = 8.5
  49   if (omp_get_thread_num () .eq. 1) e3 = 14.5
  50   f3 = e3 - 4.5
  51 !$omp barrier
  52   l = l .or. (omp_get_thread_num () .eq. 0 .and. e3 .ne. 8.5)
  53   l = l .or. (omp_get_thread_num () .eq. 1 .and. e3 .ne. 14.5)
  54   l = l .or. f3 .ne. e3 - 4.5
  55 !$omp end parallel
  56   if (l) call abort
  57   e3 = 0.5
  58 end function f3
  59 function f4 () result (r4)
  60   use omp_lib
  61   real :: r4, s4
  62   logical :: l
  63 entry e4 () result (s4)
  64   r4 = 6.5
  65   l = .false.
  66 !$omp parallel firstprivate (r4, s4) num_threads (2) reduction (.or.:l)
  67   l = s4 .ne. 6.5
  68   l = l .or. r4 .ne. 6.5
  69   if (omp_get_thread_num () .eq. 0) s4 = 8.5
  70   if (omp_get_thread_num () .eq. 1) s4 = 14.5
  71   r4 = s4 - 4.5
  72 !$omp barrier
  73   l = l .or. (omp_get_thread_num () .eq. 0 .and. s4 .ne. 8.5)
  74   l = l .or. (omp_get_thread_num () .eq. 1 .and. s4 .ne. 14.5)
  75   l = l .or. r4 .ne. s4 - 4.5
  76 !$omp end parallel
  77   if (l) call abort
  78   s4 = -0.5
  79 end function f4
  80 function f5 (is_f5)
  81   use omp_lib
  82   real :: f5
  83   integer :: e5
  84   logical :: l, is_f5
  85 entry e5 (is_f5)
  86   if (is_f5) then
  87     f5 = 6.5
  88   else
  89     e5 = 8
  90   end if
  91   l = .false.
  92 !$omp parallel firstprivate (f5, e5) shared (is_f5) num_threads (2) &
  93 !$omp reduction (.or.:l)
  94   l = .not. is_f5 .and. e5 .ne. 8
  95   l = l .or. (is_f5 .and. f5 .ne. 6.5)
  96   if (omp_get_thread_num () .eq. 0) e5 = 8
  97   if (omp_get_thread_num () .eq. 1) e5 = 14
  98   f5 = e5 - 4.5
  99 !$omp barrier
 100   l = l .or. (omp_get_thread_num () .eq. 0 .and. e5 .ne. 8)
 101   l = l .or. (omp_get_thread_num () .eq. 1 .and. e5 .ne. 14)
 102   l = l .or. f5 .ne. e5 - 4.5
 103 !$omp end parallel
 104   if (l) call abort
 105   if (is_f5) f5 = -2.5
 106   if (.not. is_f5) e5 = 8
 107 end function f5
 108
 109   real :: f1, f2, e2, f3, e3, f4, e4, f5
 110   integer :: e5
 111   if (f1 () .ne. -2.5) call abort
 112   if (f2 () .ne. 7.5) call abort
 113   if (e2 () .ne. 7.5) call abort
 114   if (f3 () .ne. 0.5) call abort
 115   if (e3 () .ne. 0.5) call abort
 116   if (f4 () .ne. -0.5) call abort
 117   if (e4 () .ne. -0.5) call abort
 118   if (f5 (.true.) .ne. -2.5) call abort
 119   if (e5 (.false.) .ne. 8) call abort
 120 end