Initial checkin of GCC 4.9.0 from trunk (r208799).

Change-Id: I48a3c08bb98542aa215912a75f03c0890e497dba

1 files changed, 115 insertions, 0 deletions

diff --git a/gcc-4.9/gcc/testsuite/gfortran.dg/loc_2.f90 b/gcc-4.9/gcc/testsuite/gfortran.dg/loc_2.f90
new file mode 100644
index 000000000..d905fc0f7
--- /dev/null
+++ b/gcc-4.9/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
+