|
111
|
1 ! { 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
|
|
131
|
13 STOP 1
|
|
111
|
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
|
