Mercurial > hg > CbC > CbC_gcc
diff gcc/testsuite/gfortran.dg/loc_2.f90 @ 111:04ced10e8804
gcc 7
author | kono |
---|---|
date | Fri, 27 Oct 2017 22:46:09 +0900 (2017-10-27) |
parents | |
children | 84e7813d76e9 |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/gcc/testsuite/gfortran.dg/loc_2.f90 Fri Oct 27 22:46:09 2017 +0900 @@ -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 +