]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
Add libgomp.fortran/order-reproducible-*.f90
authorTobias Burnus <tobias@codesourcery.com>
Sat, 2 Oct 2021 09:29:35 +0000 (11:29 +0200)
committerTobias Burnus <tobias@codesourcery.com>
Sat, 2 Oct 2021 09:29:35 +0000 (11:29 +0200)
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.

libgomp/testsuite/libgomp.fortran/my-usleep.c [new file with mode: 0644]
libgomp/testsuite/libgomp.fortran/order-reproducible-1.f90 [new file with mode: 0644]
libgomp/testsuite/libgomp.fortran/order-reproducible-2.f90 [new file with mode: 0644]

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