URL https://opencores.org/ocsvn/openrisc_2011-10-31/openrisc_2011-10-31/trunk

Subversion Repositories openrisc_2011-10-31

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.2.2/] [libgomp/] [testsuite/] [libgomp.fortran/] [omp_parse3.f90] - Blame information for rev 154

Details | Compare with Previous | View Log


! { dg-do run }
! { dg-require-effective-target tls_runtime }
use omp_lib
  common /tlsblock/ x, y
  integer :: x, y, z
  save z
!$omp threadprivate (/tlsblock/, z)
 
  call test_flush
  call test_ordered
  call test_threadprivate
 
contains
  subroutine test_flush
    integer :: i, j
    i = 0
    j = 0
!$omp parallel num_threads (4)
    if (omp_get_thread_num () .eq. 0) i = omp_get_num_threads ()
    if (omp_get_thread_num () .eq. 0) j = j + 1
!$omp flush (i, j)
!$omp barrier
    if (omp_get_thread_num () .eq. 1) j = j + 2
!$omp flush
!$omp barrier
    if (omp_get_thread_num () .eq. 2) j = j + 3
!$omp flush (i)
!$omp flush (j)
!$omp barrier
    if (omp_get_thread_num () .eq. 3) j = j + 4
!$omp end parallel
  end subroutine test_flush
 
  subroutine test_ordered
    integer :: i, j
    integer, dimension (100) :: d
    d(:) = -1
!$omp parallel do ordered schedule (dynamic) num_threads (4)
    do i = 1, 100, 5
!$omp ordered
      d(i) = i
!$omp end ordered
    end do
    j = 1
    do 100 i = 1, 100
      if (i .eq. j) then
        if (d(i) .ne. i) call abort
        j = i + 5
      else
        if (d(i) .ne. -1) call abort
      end if
100   d(i) = -1
  end subroutine test_ordered
 
  subroutine test_threadprivate
    common /tlsblock/ x, y
!$omp threadprivate (/tlsblock/)
    integer :: i, j
    logical :: m, n
    call omp_set_num_threads (4)
    call omp_set_dynamic (.false.)
    i = -1
    x = 6
    y = 7
    z = 8
    n = .false.
    m = .false.
!$omp parallel copyin (/tlsblock/, z) reduction (.or.:m) &
!$omp& num_threads (4)
    if (omp_get_thread_num () .eq. 0) i = omp_get_num_threads ()
    if (x .ne. 6 .or. y .ne. 7 .or. z .ne. 8) call abort
    x = omp_get_thread_num ()
    y = omp_get_thread_num () + 1024
    z = omp_get_thread_num () + 4096
!$omp end parallel
    if (x .ne. 0 .or. y .ne. 1024 .or. z .ne. 4096) call abort
!$omp parallel num_threads (4), private (j) reduction (.or.:n)
    if (omp_get_num_threads () .eq. i) then
      j = omp_get_thread_num ()
      if (x .ne. j .or. y .ne. j + 1024 .or. z .ne. j + 4096) &
&       call abort
    end if
!$omp end parallel
    m = m .or. n
    n = .false.
!$omp parallel num_threads (4), copyin (z) reduction (.or. : n)
    if (z .ne. 4096) n = .true.
    if (omp_get_num_threads () .eq. i) then
      j = omp_get_thread_num ()
      if (x .ne. j .or. y .ne. j + 1024) call abort
    end if
!$omp end parallel
    if (m .or. n) call abort
  end subroutine test_threadprivate
end

Line No.	Rev	Author	Line
1	38	julius	`! { dg-do run }`
2			`! { dg-require-effective-target tls_runtime }`
3			`use omp_lib`
4			`common /tlsblock/ x, y`
5			`integer :: x, y, z`
6			`save z`
7			`!$omp threadprivate (/tlsblock/, z)`
8
9			`call test_flush`
10			`call test_ordered`
11			`call test_threadprivate`
12
13			`contains`
14			`subroutine test_flush`
15			`integer :: i, j`
16			`i = 0`
17			`j = 0`
18			`!$omp parallel num_threads (4)`
19			`if (omp_get_thread_num () .eq. 0) i = omp_get_num_threads ()`
20			`if (omp_get_thread_num () .eq. 0) j = j + 1`
21			`!$omp flush (i, j)`
22			`!$omp barrier`
23			`if (omp_get_thread_num () .eq. 1) j = j + 2`
24			`!$omp flush`
25			`!$omp barrier`
26			`if (omp_get_thread_num () .eq. 2) j = j + 3`
27			`!$omp flush (i)`
28			`!$omp flush (j)`
29			`!$omp barrier`
30			`if (omp_get_thread_num () .eq. 3) j = j + 4`
31			`!$omp end parallel`
32			`end subroutine test_flush`
33
34			`subroutine test_ordered`
35			`integer :: i, j`
36			`integer, dimension (100) :: d`
37			`d(:) = -1`
38			`!$omp parallel do ordered schedule (dynamic) num_threads (4)`
39			`do i = 1, 100, 5`
40			`!$omp ordered`
41			`d(i) = i`
42			`!$omp end ordered`
43			`end do`
44			`j = 1`
45			`do 100 i = 1, 100`
46			`if (i .eq. j) then`
47			`if (d(i) .ne. i) call abort`
48			`j = i + 5`
49			`else`
50			`if (d(i) .ne. -1) call abort`
51			`end if`
52			`100 d(i) = -1`
53			`end subroutine test_ordered`
54
55			`subroutine test_threadprivate`
56			`common /tlsblock/ x, y`
57			`!$omp threadprivate (/tlsblock/)`
58			`integer :: i, j`
59			`logical :: m, n`
60			`call omp_set_num_threads (4)`
61			`call omp_set_dynamic (.false.)`
62			`i = -1`
63			`x = 6`
64			`y = 7`
65			`z = 8`
66			`n = .false.`
67			`m = .false.`
68			`!$omp parallel copyin (/tlsblock/, z) reduction (.or.:m) &`
69			`!$omp& num_threads (4)`
70			`if (omp_get_thread_num () .eq. 0) i = omp_get_num_threads ()`
71			`if (x .ne. 6 .or. y .ne. 7 .or. z .ne. 8) call abort`
72			`x = omp_get_thread_num ()`
73			`y = omp_get_thread_num () + 1024`
74			`z = omp_get_thread_num () + 4096`
75			`!$omp end parallel`
76			`if (x .ne. 0 .or. y .ne. 1024 .or. z .ne. 4096) call abort`
77			`!$omp parallel num_threads (4), private (j) reduction (.or.:n)`
78			`if (omp_get_num_threads () .eq. i) then`
79			`j = omp_get_thread_num ()`
80			`if (x .ne. j .or. y .ne. j + 1024 .or. z .ne. j + 4096) &`
81			`& call abort`
82			`end if`
83			`!$omp end parallel`
84			`m = m .or. n`
85			`n = .false.`
86			`!$omp parallel num_threads (4), copyin (z) reduction (.or. : n)`
87			`if (z .ne. 4096) n = .true.`
88			`if (omp_get_num_threads () .eq. i) then`
89			`j = omp_get_thread_num ()`
90			`if (x .ne. j .or. y .ne. j + 1024) call abort`
91			`end if`
92			`!$omp end parallel`
93			`if (m .or. n) call abort`
94			`end subroutine test_threadprivate`
95			`end`

Browse

Tools

Subversion Repositories openrisc_2011-10-31

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.2.2/] [libgomp/] [testsuite/] [libgomp.fortran/] [omp_parse3.f90] - Blame information for rev 154