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 823

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


! { dg-do run }
! Series of routines for testing a loc() implementation
program test
  common /errors/errors(12)
  integer i
  logical errors
  errors = .false.
  call testloc
  do i=1,12
     if (errors(i)) then
        call abort()
     endif
  end do
end program test
 
! Test loc
subroutine testloc
  common /errors/errors(12)
  logical errors
  integer, parameter :: n = 9
  integer, parameter :: m = 10
  integer, parameter :: o = 11
  integer :: offset
  integer :: i,j,k,intsize,realsize,dblsize,chsize,ch8size
  integer itarg1 (n)
  integer itarg2 (m,n)
  integer itarg3 (o,m,n)
  real rtarg1(n)
  real rtarg2(m,n)
  real rtarg3(o,m,n)
  character chtarg1(n)
  character chtarg2(m,n)
  character chtarg3(o,m,n)
  character*8 ch8targ1(n)
  character*8 ch8targ2(m,n)
  character*8 ch8targ3(o,m,n)
 
  intsize = kind(itarg1(1))
  realsize = kind(rtarg1(1))
  chsize = kind(chtarg1(1))*len(chtarg1(1))
  ch8size = kind(ch8targ1(1))*len(ch8targ1(1))
 
  do, i=1,n
     offset = i-1
     if (loc(itarg1).ne.loc(itarg1(i))-offset*intsize) then
        ! Error #1
        errors(1) = .true.
     end if
     if (loc(rtarg1).ne.loc(rtarg1(i))-offset*realsize) then
        ! Error #2
        errors(2) = .true.
     end if
     if (loc(chtarg1).ne.loc(chtarg1(i))-offset*chsize) then
        ! Error #3
        errors(3) = .true.
     end if
     if (loc(ch8targ1).ne.loc(ch8targ1(i))-offset*ch8size) then
        ! Error #4
        errors(4) = .true.
     end if
 
     do, j=1,m
        offset = (j-1)+m*(i-1)
        if (loc(itarg2).ne. &
             loc(itarg2(j,i))-offset*intsize) then
           ! Error #5
           errors(5) = .true.
        end if
        if (loc(rtarg2).ne. &
             loc(rtarg2(j,i))-offset*realsize) then
           ! Error #6
           errors(6) = .true.
        end if
        if (loc(chtarg2).ne. &
             loc(chtarg2(j,i))-offset*chsize) then
           ! Error #7
           errors(7) = .true.
        end if
        if (loc(ch8targ2).ne. &
             loc(ch8targ2(j,i))-offset*ch8size) then
           ! Error #8
           errors(8) = .true.
        end if
 
        do k=1,o
           offset = (k-1)+o*(j-1)+o*m*(i-1)
           if (loc(itarg3).ne. &
                loc(itarg3(k,j,i))-offset*intsize) then
              ! Error #9
              errors(9) = .true.
           end if
           if (loc(rtarg3).ne. &
                loc(rtarg3(k,j,i))-offset*realsize) then
              ! Error #10
              errors(10) = .true.
           end if
           if (loc(chtarg3).ne. &
                loc(chtarg3(k,j,i))-offset*chsize) then
              ! Error #11
              errors(11) = .true.
           end if
           if (loc(ch8targ3).ne. &
                loc(ch8targ3(k,j,i))-offset*ch8size) then
              ! Error #12
              errors(12) = .true.
           end if
 
        end do
     end do
  end do
 
end subroutine testloc
 

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)+om*(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

Browse

Tools

Subversion Repositories openrisc

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