On 01.10.21 11:03, Jakub Jelinek wrote:
2021-10-01 Jakub Jelinek <ja...@redhat.com>
libgomp/
* testsuite/libgomp.c-c++-common/order-reproducible-1.c: New test.
* testsuite/libgomp.c-c++-common/order-reproducible-2.c: New test.
Attached is the Fortran version of the two patches – the Fortran FE
modifications were already in Jakub's patch.
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.
.../libgomp.fortran/order-reproducible-1.f90 | 70 ++++++++++++++++++++++
.../libgomp.fortran/order-reproducible-2.f90 | 36 +++++++++++
2 files changed, 106 insertions(+)
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..2b852ebc70b
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/order-reproducible-1.f90
@@ -0,0 +1,70 @@
+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..af18c82f700
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/order-reproducible-2.f90
@@ -0,0 +1,36 @@
+! { dg-additional-sources my-usleep.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
