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


! { dg-do run }
! { dg-options "-std=legacy" }
!
! 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	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)+om*(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

Browse

Tools

Subversion Repositories openrisc

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