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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.dg/] [loc_2.f90] - Blame information for rev 694

Details | Compare with Previous | View Log

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

powered by: WebSVN 2.1.0

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