From 0772686ae55dc35cd4b6ec4ec866542a780f0db6 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Sat, 2 Oct 2021 11:32:22 +0200 Subject: [PATCH] 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) --- libgomp/ChangeLog.omp | 10 +++ libgomp/testsuite/libgomp.fortran/my-usleep.c | 9 +++ .../libgomp.fortran/order-reproducible-1.f90 | 72 +++++++++++++++++++ .../libgomp.fortran/order-reproducible-2.f90 | 37 ++++++++++ 4 files changed, 128 insertions(+) create mode 100644 libgomp/testsuite/libgomp.fortran/my-usleep.c create mode 100644 libgomp/testsuite/libgomp.fortran/order-reproducible-1.f90 create mode 100644 libgomp/testsuite/libgomp.fortran/order-reproducible-2.f90 diff --git a/libgomp/ChangeLog.omp b/libgomp/ChangeLog.omp index 11d2f4eabd1..ca5014c3993 100644 --- a/libgomp/ChangeLog.omp +++ b/libgomp/ChangeLog.omp @@ -1,3 +1,13 @@ +2021-10-02 Tobias Burnus + + Backported from master: + 2021-10-02 Tobias Burnus + + * 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 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 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 + +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..ba416b9525e --- /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 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