Add libgomp.fortran/order-reproducible-*.f90

libgomp/ChangeLog:

	* testsuite/libgomp.fortran/order-reproducible-1.f90: New test
	based on libgomp.c-c++-common/order-reproducible-1.c.
	* testsuite/libgomp.fortran/order-reproducible-2.f90: Likewise.
	* testsuite/libgomp.fortran/my-usleep.c: New test.

(cherry picked from commit 703d8a4d39bdc3870b60460e75f8ff7fbcb365b4)

diff --git a/libgomp/ChangeLog.omp b/libgomp/ChangeLog.omp
index 11d2f4eabd1405e3b2250d2025cc2a23d2a0efb1..ca5014c3993c36fa040ee045eb627a2e3b971ffb 100644 (file)
--- a/libgomp/ChangeLog.omp
+++ b/libgomp/ChangeLog.omp
@@ -1,3 +1,13 @@
+2021-10-02  Tobias Burnus  <tobias@codesourcery.com>
+
+       Backported from master:
+       2021-10-02  Tobias Burnus  <tobias@codesourcery.com>
+
+       * testsuite/libgomp.fortran/order-reproducible-1.f90: New test
+       based on libgomp.c-c++-common/order-reproducible-1.c.
+       * testsuite/libgomp.fortran/order-reproducible-2.f90: Likewise.
+       * testsuite/libgomp.fortran/my-usleep.c: New test.
+
 2021-10-01  Tobias Burnus  <tobias@codesourcery.com>
 
        Backported from master:

diff --git a/libgomp/testsuite/libgomp.fortran/my-usleep.c b/libgomp/testsuite/libgomp.fortran/my-usleep.c
new file mode 100644 (file)
index 0000000..1764db9
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/my-usleep.c
@@ -0,0 +1,9 @@
+/* Wrapper as usleep takes 'useconds_t', an unsigned integer type, as argument. */
+
+#include <unistd.h>
+
+void
+my_usleep (int t)
+{
+  usleep (t);
+}

diff --git a/libgomp/testsuite/libgomp.fortran/order-reproducible-1.f90 b/libgomp/testsuite/libgomp.fortran/order-reproducible-1.f90
new file mode 100644 (file)
index 0000000..ba416b9
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/order-reproducible-1.f90
@@ -0,0 +1,72 @@
+! { dg-additional-sources my-usleep.c }
+! { dg-prune-output "command-line option '-fintrinsic-modules-path=.*' is valid for Fortran but not for C" }
+program main
+  implicit none
+  interface
+    subroutine usleep(t) bind(C, name="my_usleep")
+      use iso_c_binding
+      integer(c_int), value :: t
+    end subroutine
+  end interface
+
+  integer :: a(128)
+  integer :: i
+
+  !$omp teams num_teams(5)
+    !$omp loop bind(teams)
+    do i = 1, 128
+      a(i) = i
+      if (i == 1) then
+        call usleep (20)
+      else if (i == 17) then
+        call usleep (40)
+      end if
+    end do
+    !$omp loop bind(teams)
+    do i = 1, 128
+      a(i) = a(i) + i
+    end do
+  !$omp end teams
+  do i = 1, 128
+    if (a(i) /= 2 * i) &
+      stop 1
+  end do
+  !$omp teams num_teams(5)
+    !$omp loop bind(teams) order(concurrent)
+    do i = 1, 128
+      a(i) = a(i) * 2
+      if (i == 1) then
+        call usleep (20)
+      else if (i == 13) then
+        call usleep (40)
+      end if
+    end do
+    !$omp loop bind(teams) order(concurrent)
+    do i = 1, 128
+      a(i) = a(i) + i
+    end do
+  !$omp end teams
+  do i = 1, 128
+    if (a(i) /= 5 * i) &
+      stop 2
+  end do
+  !$omp teams num_teams(5)
+    !$omp loop bind(teams) order(reproducible:concurrent)
+    do i = 1, 128
+      a(i) = a(i) * 2
+      if (i == 3) then
+        call usleep (20)
+      else if (i == 106) then
+        call usleep (40)
+      end if
+    end do
+    !$omp loop bind(teams) order(reproducible:concurrent)
+    do i = 1, 128
+      a(i) = a(i) + i
+    end do
+  !$omp end teams
+  do i = 1, 128
+    if (a(i) /= 11 * i) &
+      stop 3
+  end do
+end program main

diff --git a/libgomp/testsuite/libgomp.fortran/order-reproducible-2.f90 b/libgomp/testsuite/libgomp.fortran/order-reproducible-2.f90
new file mode 100644 (file)
index 0000000..9d72020
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/order-reproducible-2.f90
@@ -0,0 +1,37 @@
+! { dg-additional-sources my-usleep.c }
+! { dg-prune-output "command-line option '-fintrinsic-modules-path=.*' is valid for Fortran but not for C" }
+program main
+  implicit none
+  interface
+    subroutine usleep(t) bind(C, name="my_usleep")
+      use iso_c_binding
+      integer(c_int), value :: t
+    end subroutine
+  end interface
+
+  integer :: a(128)
+  integer :: i
+
+  !$omp parallel num_threads(8)
+    !$omp barrier
+    !$omp do schedule (dynamic, 2) order(reproducible:concurrent)
+    do i = 1, 128
+      a(i) = i
+      if (i == 1) then
+        call usleep (20)
+      else if (i == 18) then
+        call usleep (40)
+      end if
+    end do
+    !$omp end do nowait
+    !$omp do schedule (dynamic, 2) order(reproducible:concurrent)
+    do i = 1, 128
+      a(i) = a(i) + i
+    end do
+    !$omp end do nowait
+  !$omp end parallel
+  do i = 1, 128
+    if (a(i) /= 2 * i) &
+      stop
+  end do
+end program main