From: Tobias Burnus <tobias@codesourcery.com>
Date: Sat, 2 Oct 2021 09:29:35 +0000 (+0200)
Subject: Add libgomp.fortran/order-reproducible-*.f90
X-Git-Tag: basepoints/gcc-13~4220
X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=703d8a4d39bdc3870b60460e75f8ff7fbcb365b4;p=thirdparty%2Fgcc.git

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.
---

diff --git a/libgomp/testsuite/libgomp.fortran/my-usleep.c b/libgomp/testsuite/libgomp.fortran/my-usleep.c
new file mode 100644
index 000000000000..1764db9cd64c
--- /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
index 000000000000..ba416b9525e8
--- /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
index 000000000000..9d7202061443
--- /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