OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Add libgomp.fortran/order-reproducible-*.f90

Browse Source 
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 703d8a4d39)
This commit is contained in:
Tobias Burnus 2021-10-02 11:32:22 +02:00
parent 42a09d9e81
commit 0772686ae5
4 changed files with 128 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
libgomp/ChangeLog.omp
View File

@ -1,3 +1,13 @@
2021-10-02 Tobias Burnus <tobias@codesourcery.com>
Backported from master:
2021-10-02 Tobias Burnus <tobias@codesourcery.com>
* 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 <tobias@codesourcery.com>
Backported from master:

9
libgomp/testsuite/libgomp.fortran/my-usleep.c Normal file
View File

@ -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);
}

72
libgomp/testsuite/libgomp.fortran/order-reproducible-1.f90 Normal file
View File

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

37
libgomp/testsuite/libgomp.fortran/order-reproducible-2.f90 Normal file
View File

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