From 554fd8c5195424bdbcabf5de30fdc183aba391bd Mon Sep 17 00:00:00 2001
From: upstream source tree <ports@midipix.org>
Date: Sun, 15 Mar 2015 20:14:05 -0400
Subject: obtained gcc-4.6.4.tar.bz2 from upstream website; 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.
---
 gcc/testsuite/gfortran.dg/loc_2.f90 | 115 ++++++++++++++++++++++++++++++++++++
 1 file changed, 115 insertions(+)
 create mode 100644 gcc/testsuite/gfortran.dg/loc_2.f90

(limited to 'gcc/testsuite/gfortran.dg/loc_2.f90')

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
+
-- 
cgit v1.2.3