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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-old/] [gcc-4.2.2/] [gcc/] [testsuite/] [gfortran.dg/] [loc_2.f90] - Blame information for rev 816

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 149 jeremybenn
! { dg-do run }
2
! Series of routines for testing a loc() implementation
3
program test
4
  common /errors/errors(12)
5
  integer i
6
  logical errors
7
  errors = .false.
8
  call testloc
9
  do i=1,12
10
     if (errors(i)) then
11
        call abort()
12
     endif
13
  end do
14
end program test
15
 
16
! Test loc
17
subroutine testloc
18
  common /errors/errors(12)
19
  logical errors
20
  integer, parameter :: n = 9
21
  integer, parameter :: m = 10
22
  integer, parameter :: o = 11
23
  integer :: offset
24
  integer :: i,j,k,intsize,realsize,dblsize,chsize,ch8size
25
  integer itarg1 (n)
26
  integer itarg2 (m,n)
27
  integer itarg3 (o,m,n)
28
  real rtarg1(n)
29
  real rtarg2(m,n)
30
  real rtarg3(o,m,n)
31
  character chtarg1(n)
32
  character chtarg2(m,n)
33
  character chtarg3(o,m,n)
34
  character*8 ch8targ1(n)
35
  character*8 ch8targ2(m,n)
36
  character*8 ch8targ3(o,m,n)
37
 
38
  intsize = kind(itarg1(1))
39
  realsize = kind(rtarg1(1))
40
  chsize = kind(chtarg1(1))*len(chtarg1(1))
41
  ch8size = kind(ch8targ1(1))*len(ch8targ1(1))
42
 
43
  do, i=1,n
44
     offset = i-1
45
     if (loc(itarg1).ne.loc(itarg1(i))-offset*intsize) then
46
        ! Error #1
47
        errors(1) = .true.
48
     end if
49
     if (loc(rtarg1).ne.loc(rtarg1(i))-offset*realsize) then
50
        ! Error #2
51
        errors(2) = .true.
52
     end if
53
     if (loc(chtarg1).ne.loc(chtarg1(i))-offset*chsize) then
54
        ! Error #3
55
        errors(3) = .true.
56
     end if
57
     if (loc(ch8targ1).ne.loc(ch8targ1(i))-offset*ch8size) then
58
        ! Error #4
59
        errors(4) = .true.
60
     end if
61
 
62
     do, j=1,m
63
        offset = (j-1)+m*(i-1)
64
        if (loc(itarg2).ne. &
65
             loc(itarg2(j,i))-offset*intsize) then
66
           ! Error #5
67
           errors(5) = .true.
68
        end if
69
        if (loc(rtarg2).ne. &
70
             loc(rtarg2(j,i))-offset*realsize) then
71
           ! Error #6
72
           errors(6) = .true.
73
        end if
74
        if (loc(chtarg2).ne. &
75
             loc(chtarg2(j,i))-offset*chsize) then
76
           ! Error #7
77
           errors(7) = .true.
78
        end if
79
        if (loc(ch8targ2).ne. &
80
             loc(ch8targ2(j,i))-offset*ch8size) then
81
           ! Error #8
82
           errors(8) = .true.
83
        end if
84
 
85
        do k=1,o
86
           offset = (k-1)+o*(j-1)+o*m*(i-1)
87
           if (loc(itarg3).ne. &
88
                loc(itarg3(k,j,i))-offset*intsize) then
89
              ! Error #9
90
              errors(9) = .true.
91
           end if
92
           if (loc(rtarg3).ne. &
93
                loc(rtarg3(k,j,i))-offset*realsize) then
94
              ! Error #10
95
              errors(10) = .true.
96
           end if
97
           if (loc(chtarg3).ne. &
98
                loc(chtarg3(k,j,i))-offset*chsize) then
99
              ! Error #11
100
              errors(11) = .true.
101
           end if
102
           if (loc(ch8targ3).ne. &
103
                loc(ch8targ3(k,j,i))-offset*ch8size) then
104
              ! Error #12
105
              errors(12) = .true.
106
           end if
107
 
108
        end do
109
     end do
110
  end do
111
 
112
end subroutine testloc
113
 

powered by: WebSVN 2.1.0

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