mirror of
https://gcc.gnu.org/git/gcc.git
synced 2024-11-24 11:24:05 +08:00
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.
This commit is contained in:
parent
bda4aa3673
commit
703d8a4d39
9
libgomp/testsuite/libgomp.fortran/my-usleep.c
Normal file
9
libgomp/testsuite/libgomp.fortran/my-usleep.c
Normal 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
72
libgomp/testsuite/libgomp.fortran/order-reproducible-1.f90
Normal 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
37
libgomp/testsuite/libgomp.fortran/order-reproducible-2.f90
Normal 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
|
Loading…
Reference in New Issue
Block a user