On 01.10.21 11:45, Jakub Jelinek wrote:
Attached is the Fortran version of the two patches – the Fortran FE
modifications were already in Jakub's patch.
And no my-usleep.c in the patch.
Thou shall not send patches in a hurry when taking off on a day ...
New patch attached.
Tobias
-----------------
Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634
München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas
Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht
München, HRB 106955
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.
libgomp/testsuite/libgomp.fortran/my-usleep.c | 9 +++
.../libgomp.fortran/order-reproducible-1.f90 | 72 ++++++++++++++++++++++
.../libgomp.fortran/order-reproducible-2.f90 | 37 +++++++++++
3 files changed, 118 insertions(+)
diff --git a/libgomp/testsuite/libgomp.fortran/my-usleep.c b/libgomp/testsuite/libgomp.fortran/my-usleep.c
new file mode 100644
index 00000000000..1764db9cd64
--- /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 00000000000..0cf23e708bc
--- /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 == 0) 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 00000000000..9d720206144
--- /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
