URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [libgomp/] [testsuite/] [libgomp.fortran/] [omp_parse2.f90] - Blame information for rev 801

Go to most recent revision | Details | Compare with Previous | View Log


! { dg-do run }
use omp_lib
  call test_master
  call test_critical
  call test_barrier
  call test_atomic
 
contains
  subroutine test_master
    logical :: i, j
    i = .false.
    j = .false.
!$omp parallel num_threads (4)
!$omp master
    i = .true.
    j = omp_get_thread_num () .eq. 0
!$omp endmaster
!$omp end parallel
    if (.not. (i .or. j)) call abort
  end subroutine test_master
 
  subroutine test_critical_1 (i, j)
    integer :: i, j
!$omp critical(critical_foo)
    i = i + 1
!$omp end critical (critical_foo)
!$omp critical
    j = j + 1
!$omp end critical
    end subroutine test_critical_1
 
  subroutine test_critical
    integer :: i, j, n
    n = -1
    i = 0
    j = 0
!$omp parallel num_threads (4)
    if (omp_get_thread_num () .eq. 0) n = omp_get_num_threads ()
    call test_critical_1 (i, j)
    call test_critical_1 (i, j)
!$omp critical
    j = j + 1
!$omp end critical
!$omp critical (critical_foo)
    i = i + 1
!$omp endcritical (critical_foo)
!$omp end parallel
    if (n .lt. 1 .or. i .ne. n * 3 .or. j .ne. n * 3) call abort
  end subroutine test_critical
 
  subroutine test_barrier
    integer :: i
    logical :: j
    i = 23
    j = .false.
!$omp parallel num_threads (4)
    if (omp_get_thread_num () .eq. 0) i = 5
!$omp flush (i)
!$omp barrier
    if (i .ne. 5) then
!$omp atomic
      j = j .or. .true.
    end if
!$omp end parallel
    if (i .ne. 5 .or. j) call abort
  end subroutine test_barrier
 
  subroutine test_atomic
    integer :: a, b, c, d, e, f, g
    a = 0
    b = 1
    c = 0
    d = 1024
    e = 1024
    f = -1
    g = -1
!$omp parallel num_threads (8)
!$omp atomic
    a = a + 2 + 4
!$omp atomic
    b = 3 * b
!$omp atomic
    c = 8 - c
!$omp atomic
    d = d / 2
!$omp atomic
    e = min (e, omp_get_thread_num ())
!$omp atomic
    f = max (omp_get_thread_num (), f)
    if (omp_get_thread_num () .eq. 0) g = omp_get_num_threads ()
!$omp end parallel
    if (g .le. 0 .or. g .gt. 8) call abort
    if (a .ne. 6 * g .or. b .ne. 3 ** g) call abort
    if (iand (g, 1) .eq. 1) then
      if (c .ne. 8) call abort
    else if (c .ne. 0) then
      call abort
    end if
    if (d .ne. 1024 / (2 ** g)) call abort
    if (e .ne. 0 .or. f .ne. g - 1) call abort
  end subroutine test_atomic
end

Line No.	Rev	Author	Line
1	735	jeremybenn	`! { dg-do run }`
2			`use omp_lib`
3			`call test_master`
4			`call test_critical`
5			`call test_barrier`
6			`call test_atomic`
7
8			`contains`
9			`subroutine test_master`
10			`logical :: i, j`
11			`i = .false.`
12			`j = .false.`
13			`!$omp parallel num_threads (4)`
14			`!$omp master`
15			`i = .true.`
16			`j = omp_get_thread_num () .eq. 0`
17			`!$omp endmaster`
18			`!$omp end parallel`
19			`if (.not. (i .or. j)) call abort`
20			`end subroutine test_master`
21
22			`subroutine test_critical_1 (i, j)`
23			`integer :: i, j`
24			`!$omp critical(critical_foo)`
25			`i = i + 1`
26			`!$omp end critical (critical_foo)`
27			`!$omp critical`
28			`j = j + 1`
29			`!$omp end critical`
30			`end subroutine test_critical_1`
31
32			`subroutine test_critical`
33			`integer :: i, j, n`
34			`n = -1`
35			`i = 0`
36			`j = 0`
37			`!$omp parallel num_threads (4)`
38			`if (omp_get_thread_num () .eq. 0) n = omp_get_num_threads ()`
39			`call test_critical_1 (i, j)`
40			`call test_critical_1 (i, j)`
41			`!$omp critical`
42			`j = j + 1`
43			`!$omp end critical`
44			`!$omp critical (critical_foo)`
45			`i = i + 1`
46			`!$omp endcritical (critical_foo)`
47			`!$omp end parallel`
48			`if (n .lt. 1 .or. i .ne. n * 3 .or. j .ne. n * 3) call abort`
49			`end subroutine test_critical`
50
51			`subroutine test_barrier`
52			`integer :: i`
53			`logical :: j`
54			`i = 23`
55			`j = .false.`
56			`!$omp parallel num_threads (4)`
57			`if (omp_get_thread_num () .eq. 0) i = 5`
58			`!$omp flush (i)`
59			`!$omp barrier`
60			`if (i .ne. 5) then`
61			`!$omp atomic`
62			`j = j .or. .true.`
63			`end if`
64			`!$omp end parallel`
65			`if (i .ne. 5 .or. j) call abort`
66			`end subroutine test_barrier`
67
68			`subroutine test_atomic`
69			`integer :: a, b, c, d, e, f, g`
70			`a = 0`
71			`b = 1`
72			`c = 0`
73			`d = 1024`
74			`e = 1024`
75			`f = -1`
76			`g = -1`
77			`!$omp parallel num_threads (8)`
78			`!$omp atomic`
79			`a = a + 2 + 4`
80			`!$omp atomic`
81			`b = 3 * b`
82			`!$omp atomic`
83			`c = 8 - c`
84			`!$omp atomic`
85			`d = d / 2`
86			`!$omp atomic`
87			`e = min (e, omp_get_thread_num ())`
88			`!$omp atomic`
89			`f = max (omp_get_thread_num (), f)`
90			`if (omp_get_thread_num () .eq. 0) g = omp_get_num_threads ()`
91			`!$omp end parallel`
92			`if (g .le. 0 .or. g .gt. 8) call abort`
93			`if (a .ne. 6 * g .or. b .ne. 3 ** g) call abort`
94			`if (iand (g, 1) .eq. 1) then`
95			`if (c .ne. 8) call abort`
96			`else if (c .ne. 0) then`
97			`call abort`
98			`end if`
99			`if (d .ne. 1024 / (2 ** g)) call abort`
100			`if (e .ne. 0 .or. f .ne. g - 1) call abort`
101			`end subroutine test_atomic`
102			`end`

Browse

Tools

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [libgomp/] [testsuite/] [libgomp.fortran/] [omp_parse2.f90] - Blame information for rev 801