2 ! { dg-options "-std=legacy" }
4 ! Series of routines for testing a loc() implementation
6 common /errors/errors(12)
20 common /errors/errors(12)
22 integer, parameter :: n = 9
23 integer, parameter :: m = 10
24 integer, parameter :: o = 11
26 integer :: i,j,k,intsize,realsize,dblsize,chsize,ch8size
29 integer itarg3 (o,m,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)
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))
47 if (loc(itarg1).ne.loc(itarg1(i))-offset*intsize) then
51 if (loc(rtarg1).ne.loc(rtarg1(i))-offset*realsize) then
55 if (loc(chtarg1).ne.loc(chtarg1(i))-offset*chsize) then
59 if (loc(ch8targ1).ne.loc(ch8targ1(i))-offset*ch8size) then
65 offset = (j-1)+m*(i-1)
67 loc(itarg2(j,i))-offset*intsize) then
72 loc(rtarg2(j,i))-offset*realsize) then
76 if (loc(chtarg2).ne. &
77 loc(chtarg2(j,i))-offset*chsize) then
81 if (loc(ch8targ2).ne. &
82 loc(ch8targ2(j,i))-offset*ch8size) then
88 offset = (k-1)+o*(j-1)+o*m*(i-1)
90 loc(itarg3(k,j,i))-offset*intsize) then
95 loc(rtarg3(k,j,i))-offset*realsize) then
99 if (loc(chtarg3).ne. &
100 loc(chtarg3(k,j,i))-offset*chsize) then
104 if (loc(ch8targ3).ne. &
105 loc(ch8targ3(k,j,i))-offset*ch8size) then
114 end subroutine testloc