summaryrefslogtreecommitdiff
path: root/gcc/testsuite/gfortran.dg/loc_2.f90
diff options
context:
space:
mode:
authorupstream source tree <ports@midipix.org>2015-03-15 20:14:05 -0400
committerupstream source tree <ports@midipix.org>2015-03-15 20:14:05 -0400
commit554fd8c5195424bdbcabf5de30fdc183aba391bd (patch)
tree976dc5ab7fddf506dadce60ae936f43f58787092 /gcc/testsuite/gfortran.dg/loc_2.f90
downloadcbb-gcc-4.6.4-554fd8c5195424bdbcabf5de30fdc183aba391bd.tar.bz2
cbb-gcc-4.6.4-554fd8c5195424bdbcabf5de30fdc183aba391bd.tar.xz
obtained gcc-4.6.4.tar.bz2 from upstream website;upstream
verified gcc-4.6.4.tar.bz2.sig; imported gcc-4.6.4 source tree from verified upstream tarball. downloading a git-generated archive based on the 'upstream' tag should provide you with a source tree that is binary identical to the one extracted from the above tarball. if you have obtained the source via the command 'git clone', however, do note that line-endings of files in your working directory might differ from line-endings of the respective files in the upstream repository.
Diffstat (limited to 'gcc/testsuite/gfortran.dg/loc_2.f90')
-rw-r--r--gcc/testsuite/gfortran.dg/loc_2.f90115
1 files changed, 115 insertions, 0 deletions
diff --git a/gcc/testsuite/gfortran.dg/loc_2.f90 b/gcc/testsuite/gfortran.dg/loc_2.f90
new file mode 100644
index 000000000..d905fc0f7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/loc_2.f90
@@ -0,0 +1,115 @@
+! { 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
+