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

Subversion Repositories openrisc

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

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

Line No. Rev Author Line
1 735 jeremybenn
! { dg-do run }
2
!$ use omp_lib
3
 
4
  character (len = 8) :: h
5
  character (len = 9) :: i
6
  h = '01234567'
7
  i = 'ABCDEFGHI'
8
  call test (h, i, 9)
9
contains
10
  subroutine test (p, q, n)
11
    character (len = *) :: p
12
    character (len = n) :: q
13
    character (len = n) :: r
14
    character (len = n) :: t
15
    character (len = n) :: u
16
    integer, dimension (n + 4) :: s
17
    logical :: l
18
    integer :: m
19
    r = ''
20
    if (n .gt. 8) r = 'jklmnopqr'
21
    do m = 1, n + 4
22
      s(m) = m
23
    end do
24
    u = 'abc'
25
    l = .false.
26
!$omp parallel firstprivate (p, q, r) private (t, m) reduction (.or.:l) &
27
!$omp & num_threads (2)
28
    do m = 1, 13
29
      if (s(m) .ne. m) l = .true.
30
    end do
31
    m = omp_get_thread_num ()
32
    l = l .or. p .ne. '01234567' .or. q .ne. 'ABCDEFGHI'
33
    l = l .or. r .ne. 'jklmnopqr' .or. u .ne. 'abc'
34
!$omp barrier
35
    if (m .eq. 0) then
36
      p = 'A'
37
      q = 'B'
38
      r = 'C'
39
      t = '123'
40
      u = '987654321'
41
    else if (m .eq. 1) then
42
      p = 'D'
43
      q = 'E'
44
      r = 'F'
45
      t = '456'
46
      s = m
47
    end if
48
!$omp barrier
49
    l = l .or. u .ne. '987654321'
50
    if (any (s .ne. 1)) l = .true.
51
    if (m .eq. 0) then
52
      l = l .or. p .ne. 'A' .or. q .ne. 'B' .or. r .ne. 'C'
53
      l = l .or. t .ne. '123'
54
    else
55
      l = l .or. p .ne. 'D' .or. q .ne. 'E' .or. r .ne. 'F'
56
      l = l .or. t .ne. '456'
57
    end if
58
!$omp end parallel
59
    if (l) call abort
60
  end subroutine test
61
end

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.