diff options
Diffstat (limited to 'gcc/testsuite/gfortran.dg/graphite')
75 files changed, 1853 insertions, 0 deletions
diff --git a/gcc/testsuite/gfortran.dg/graphite/block-1.f90 b/gcc/testsuite/gfortran.dg/graphite/block-1.f90 new file mode 100644 index 000000000..cea307e5a --- /dev/null +++ b/gcc/testsuite/gfortran.dg/graphite/block-1.f90 @@ -0,0 +1,13 @@ +subroutine matrix_multiply(a,b,c,n) + +real(8), dimension(n,n) :: a,b,c + +! The following code is disabled for the moment. +c=0.d0 + +end subroutine matrix_multiply + +! { dg-final { scan-tree-dump-times "number of SCoPs: 1" 1 "graphite" } } +! { dg-final { scan-tree-dump-times "will be loop blocked" 1 "graphite" { xfail *-*-* } } } +! { dg-final { cleanup-tree-dump "graphite" } } + diff --git a/gcc/testsuite/gfortran.dg/graphite/block-2.f b/gcc/testsuite/gfortran.dg/graphite/block-2.f new file mode 100644 index 000000000..75fccca14 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/graphite/block-2.f @@ -0,0 +1,21 @@ + SUBROUTINE MATRIX_MUL_UNROLLED (A, B, C, L, M, N) + DIMENSION A(L,M), B(M,N), C(L,N) + + DO 100 K = 1, N + DO 100 I = 1, L + C(I,K) = 0. +100 CONTINUE + DO 110 J = 1, M, 4 + DO 110 K = 1, N + DO 110 I = 1, L + C(I,K) = C(I,K) + A(I,J) * B(J,K) + $ + A(I,J+1) * B(J+1,K) + A(I,J+2) * B(J+2,K) + $ + A(I,J+3) * B(J+3,K) +110 CONTINUE + + RETURN + END + +! { dg-final { scan-tree-dump-times "number of SCoPs: 2" 1 "graphite" } } +! { dg-final { scan-tree-dump-times "will be loop blocked" 2 "graphite" { xfail *-*-* } } } +! { dg-final { cleanup-tree-dump "graphite" } } diff --git a/gcc/testsuite/gfortran.dg/graphite/block-3.f90 b/gcc/testsuite/gfortran.dg/graphite/block-3.f90 new file mode 100644 index 000000000..9a66adffd --- /dev/null +++ b/gcc/testsuite/gfortran.dg/graphite/block-3.f90 @@ -0,0 +1,18 @@ +subroutine matrix_multiply(a,b,c,n) + +real(8), dimension(n,n) :: a,b,c + +do i = 1,n + do j = 1,n + do k = 1,n + c(j,i) = c(j,i) + a(k,i) * b(j,k) + enddo + enddo +enddo + +end subroutine matrix_multiply + +! { dg-final { scan-tree-dump-times "number of SCoPs: 1" 1 "graphite" { xfail *-*-* } } } +! { dg-final { scan-tree-dump-times "will be loop blocked" 1 "graphite" { xfail *-*-* } } } +! { dg-final { cleanup-tree-dump "graphite" } } + diff --git a/gcc/testsuite/gfortran.dg/graphite/block-4.f90 b/gcc/testsuite/gfortran.dg/graphite/block-4.f90 new file mode 100644 index 000000000..061830fb9 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/graphite/block-4.f90 @@ -0,0 +1,21 @@ +subroutine matrix_multiply(a,b,c,n) + +real(8), dimension(n,n) :: a,b,c + +! The following code is disabled for the moment. +! c=0.d0 + +do i = 1,n + do j = 1,n + do k = 1,n + c(j,i) = c(j,i) + a(k,i) * b(j,k) + enddo + enddo +enddo + +end subroutine matrix_multiply + +! { dg-final { scan-tree-dump-times "number of SCoPs: 1" 1 "graphite" { xfail *-*-* } } } +! { dg-final { scan-tree-dump-times "will be loop blocked" 1 "graphite" { xfail *-*-* } } } +! { dg-final { cleanup-tree-dump "graphite" } } + diff --git a/gcc/testsuite/gfortran.dg/graphite/graphite.exp b/gcc/testsuite/gfortran.dg/graphite/graphite.exp new file mode 100644 index 000000000..73c2aeed4 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/graphite/graphite.exp @@ -0,0 +1,78 @@ +# Copyright (C) 2008, 2010 Free Software Foundation, Inc. + +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with GCC; see the file COPYING3. If not see +# <http://www.gnu.org/licenses/>. + +# GCC testsuite that uses the `dg.exp' driver. + +# Load support procs. +load_lib gfortran-dg.exp + +if ![check_effective_target_fgraphite] { + return +} + +# Remove VALUE from LIST_VARIABLE. +proc lremove {list_variable value} { + upvar 1 $list_variable var + set idx [lsearch -exact $var $value] + set var [lreplace $var $idx $idx] +} + +# The default action for a test is 'compile'. Save current default. +global dg-do-what-default +set save-dg-do-what-default ${dg-do-what-default} + +# Initialize `dg'. +dg-init + +set wait_to_run_files [lsort [glob -nocomplain $srcdir/$subdir/*.\[fF\]{,90,95,03,08} ] ] +set block_files [lsort [glob -nocomplain $srcdir/$subdir/block-*.\[fF\]{,90,95,03,08} ] ] +set id_files [lsort [glob -nocomplain $srcdir/$subdir/id-*.\[fF\]{,90,95,03,08} ] ] +set interchange_files [lsort [glob -nocomplain $srcdir/$subdir/interchange-*.\[fF\]{,90,95,03,08} ] ] +set scop_files [lsort [glob -nocomplain $srcdir/$subdir/scop-*.\[fF\]{,90,95,03,08} ] ] +set run_id_files [lsort [glob -nocomplain $srcdir/$subdir/run-id-*.\[fF\]{,90,95,03,08} ] ] +set vect_files [lsort [glob -nocomplain $srcdir/$subdir/vect-*.\[fF\]{,90,95,03,08} ] ] + +# Tests to be compiled. +set dg-do-what-default compile +gfortran-dg-runtest $scop_files "-O2 -fgraphite -fdump-tree-graphite-all" +gfortran-dg-runtest $id_files "-O2 -fgraphite-identity -ffast-math" +gfortran-dg-runtest $interchange_files "-O2 -floop-interchange -fno-loop-block -fno-loop-strip-mine -ffast-math -fdump-tree-graphite-all" +gfortran-dg-runtest $block_files "-O2 -floop-block -fno-loop-strip-mine -fno-loop-interchange -ffast-math -fdump-tree-graphite-all" + +# Vectorizer tests, to be run or compiled, depending on target capabilities. +if [check_vect_support_and_set_flags] { + gfortran-dg-runtest $vect_files "-O2 -fgraphite-identity -ftree-vectorize -fno-vect-cost-model -fdump-tree-vect-details -ffast-math" +} + +# Tests to be run. +set dg-do-what-default run +gfortran-dg-runtest $run_id_files "-O2 -fgraphite-identity" + +# The default action for the rest of the files is 'compile'. +set dg-do-what-default compile +foreach f $block_files {lremove wait_to_run_files $f} +foreach f $id_files {lremove wait_to_run_files $f} +foreach f $interchange_files {lremove wait_to_run_files $f} +foreach f $scop_files {lremove wait_to_run_files $f} +foreach f $run_id_files {lremove wait_to_run_files $f} +foreach f $vect_files {lremove wait_to_run_files $f} +gfortran-dg-runtest $wait_to_run_files "" + +# Clean up. +set dg-do-what-default ${save-dg-do-what-default} + +# All done. +dg-finish diff --git a/gcc/testsuite/gfortran.dg/graphite/id-1.f90 b/gcc/testsuite/gfortran.dg/graphite/id-1.f90 new file mode 100644 index 000000000..5fe709bfb --- /dev/null +++ b/gcc/testsuite/gfortran.dg/graphite/id-1.f90 @@ -0,0 +1,11 @@ +program NF +end program NF +subroutine mattest(nx,ny,nz,band1,band2,band3,stiffness,maxiter,targrms,method) + integer,parameter :: dpkind=kind(1.0D0) + character(*) :: method + real(dpkind),allocatable,dimension(:) :: ad,au1,au2,au3,x,b + allocate(ad(nxyz),au1(nxyz),au2(nxyz),au3(nxyz),x(nxyz),b(nxyz)) + au1(nx:nxyz:nx) = 0.0 + if ( method=='NFCG' ) then + endif +end subroutine mattest diff --git a/gcc/testsuite/gfortran.dg/graphite/id-10.f90 b/gcc/testsuite/gfortran.dg/graphite/id-10.f90 new file mode 100644 index 000000000..0e016f253 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/graphite/id-10.f90 @@ -0,0 +1,11 @@ +subroutine foo ( uplo, ap, y ) + character*1 uplo + complex(kind((1.0d0,1.0d0))) ap( * ), y( * ) + if ( .not. scan( uplo, 'uu' )>0.and. & + .not. scan( uplo, 'll' )>0 )then + do 60, j = 1, n + y( j ) = y( j ) + dble( ap( kk ) ) + kk = kk + j + 60 continue + end if + end diff --git a/gcc/testsuite/gfortran.dg/graphite/id-11.f b/gcc/testsuite/gfortran.dg/graphite/id-11.f new file mode 100644 index 000000000..872e12f35 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/graphite/id-11.f @@ -0,0 +1,14 @@ + subroutine foo(bar) + dimension bar(100) + common l_ + 50 continue + do i=1,20 + bar(i)=0 + enddo + do 100 j=1,l_ + if(sum.gt.r) then + bar(n2)=j + end if + 100 continue + if(bar(4).ne.0) go to 50 + end diff --git a/gcc/testsuite/gfortran.dg/graphite/id-12.f b/gcc/testsuite/gfortran.dg/graphite/id-12.f new file mode 100644 index 000000000..5b7415ca0 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/graphite/id-12.f @@ -0,0 +1,19 @@ + subroutine foo(a) + logical bar + dimension a(12,2) + dimension b(12,8) + if(cd .eq. 1) then + if (bar) write(iw,*) norb + if(ef.ne.1) then + do i=1,norb + end do + end if + end if + do 400 j = 1,8 + b(i,j) = 0 + 400 continue + do 410 j=1,norb + a(i,j) = 0 + 410 continue + call rdrsym(b) + end diff --git a/gcc/testsuite/gfortran.dg/graphite/id-13.f b/gcc/testsuite/gfortran.dg/graphite/id-13.f new file mode 100644 index 000000000..9aec1fa6b --- /dev/null +++ b/gcc/testsuite/gfortran.dg/graphite/id-13.f @@ -0,0 +1,12 @@ + DIMENSION FF(19) + COMMON UF(9) + CALL RYSNOD(K) + DO 150 K=2,N + JMAX=K-1 + DUM = ONE/FF(1) + DO 110 J=1,JMAX + DUM=DUM+POLY*POLY + 110 CONTINUE + 150 CONTINUE + UF(K)=DUM/(ONE-DUM) + END diff --git a/gcc/testsuite/gfortran.dg/graphite/id-14.f b/gcc/testsuite/gfortran.dg/graphite/id-14.f new file mode 100644 index 000000000..cdc3d101c --- /dev/null +++ b/gcc/testsuite/gfortran.dg/graphite/id-14.f @@ -0,0 +1,20 @@ + SUBROUTINE ORDORB(IORBTP,IORBCD) + LOGICAL MASWRK + DIMENSION IORBTP(12,12) + DIMENSION IORBCD(12) + DIMENSION NSYMTP(12,8) + IF (MASWRK) WRITE(IW) K,NORB + DO 280 I=1,NFZV + IORBCD(K+I) = 3 + 280 CONTINUE + DO 420 I = 1,NTPS + DO 400 J = 1,8 + NSYMTP(I,J) = 0 + 400 CONTINUE + DO 410 J=1,NORB + IORBTP(I,J) = 0 + 410 CONTINUE + 420 CONTINUE + CALL RDRSYM(ICODE,NSYMTP,NSYM) + 9055 FORMAT(I5) + END diff --git a/gcc/testsuite/gfortran.dg/graphite/id-15.f b/gcc/testsuite/gfortran.dg/graphite/id-15.f new file mode 100644 index 000000000..bf60d8569 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/graphite/id-15.f @@ -0,0 +1,16 @@ + SUBROUTINE ORDORB(IORBTP) + LOGICAL MASWRK + DIMENSION IORBTP(12,12) + DIMENSION NSYMTP(12,8) + IF (MASWRK) WRITE(IW) K,NORB + DO 420 I = 1,NTPS + DO 400 J = 1,8 + NSYMTP(I,J) = 0 + 400 CONTINUE + DO 410 J=1,NORB + IORBTP(I,J) = 0 + 410 CONTINUE + 420 CONTINUE + CALL RDRSYM(ICODE,NSYMTP,NSYM) + 9055 FORMAT(I5) + END diff --git a/gcc/testsuite/gfortran.dg/graphite/id-16.f b/gcc/testsuite/gfortran.dg/graphite/id-16.f new file mode 100644 index 000000000..323d6c958 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/graphite/id-16.f @@ -0,0 +1,10 @@ + SUBROUTINE BFN(X,BF) + DIMENSION BF(13) + DIMENSION FACT(17) + DO 70 M=0,LAST + XF = 1 + IF(M.NE.0) XF = FACT(M) + Y = Y + XF + 70 CONTINUE + BF(1)=Y + END diff --git a/gcc/testsuite/gfortran.dg/graphite/id-17.f b/gcc/testsuite/gfortran.dg/graphite/id-17.f new file mode 100644 index 000000000..4bebed016 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/graphite/id-17.f @@ -0,0 +1,16 @@ + SUBROUTINE SPECTOP(Dr,N) + DIMENSION d1(0:32,0:32) , Dr(0:32,0:32) , x(0:32) + DO k = 0 , N + fctr2 = o + DO j = 0 , N + fctr = fctr1*fctr2 + IF ( j.NE.k ) THEN + d1(k,j) = ck*fctr/(cj*(x(k)-x(j))) + ENDIF + fctr2 = -o*fctr2 + ENDDO + DO j = 0 , N + Dr(k,j) = d1(N-k,N-j) + ENDDO + ENDDO + END diff --git a/gcc/testsuite/gfortran.dg/graphite/id-18.f90 b/gcc/testsuite/gfortran.dg/graphite/id-18.f90 new file mode 100644 index 000000000..ed7806736 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/graphite/id-18.f90 @@ -0,0 +1,26 @@ +MODULE spherical_harmonics + INTEGER, PARAMETER :: dp = SELECTED_REAL_KIND ( 14, 200 ) +CONTAINS + FUNCTION dlegendre (x, l, m) RESULT (dplm) + SELECT CASE ( l ) + CASE ( 0 ) + dplm = 0.0_dp + CASE ( 1 ) + dplm = 1.0_dp + CASE DEFAULT + IF ( mm > 0 ) THEN + dpmm = -m + DO im = 1, mm + dpmm = -dpmm + END DO + IF ( l == mm + 1 ) THEN + DO il = mm + 2, l + dpll = dpmm + END DO + dplm = dpll + END IF + END IF + END SELECT + END FUNCTION dlegendre +END MODULE spherical_harmonics +! { dg-final { cleanup-modules "spherical_harmonics" } } diff --git a/gcc/testsuite/gfortran.dg/graphite/id-19.f b/gcc/testsuite/gfortran.dg/graphite/id-19.f new file mode 100644 index 000000000..e05f764b2 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/graphite/id-19.f @@ -0,0 +1,15 @@ + SUBROUTINE ECCODR(FPQR) + DIMENSION FPQR(25,25,25) + INTEGER P,Q,R + DIMENSION REC(73) + DO 150 P=1,N4MAX,2 + QM2=-ONE + DO 140 Q=1,N4MAX,2 + DO 130 R=1,N4MAX,2 + IF(P.GT.1) THEN + FPQR(P,Q,R)= QM2*FPQR(P,Q-2,R)*REC(P+Q-2+R) + END IF + 130 RM2= RM2+TWO + 140 QM2= QM2+TWO + 150 PM2= PM2+TWO + END diff --git a/gcc/testsuite/gfortran.dg/graphite/id-2.f90 b/gcc/testsuite/gfortran.dg/graphite/id-2.f90 new file mode 100644 index 000000000..2f9f9dbec --- /dev/null +++ b/gcc/testsuite/gfortran.dg/graphite/id-2.f90 @@ -0,0 +1,14 @@ +module solv_cap + integer, parameter, public :: dp = selected_real_kind(5) +contains + subroutine prod0( G, X ) + real(kind=dp), intent(in out), dimension(:,:) :: X + real(kind=dp), dimension(size(X,1),size(X,2)) :: Y + X = Y + end subroutine prod0 + function Ginteg(xq1,yq1, xq2,yq2, xp,yp) result(G) + end function Ginteg + subroutine fourir(A,ntot,kconjg, E,useold) + end subroutine fourir +end module solv_cap +! { dg-final { cleanup-modules "solv_cap" } } diff --git a/gcc/testsuite/gfortran.dg/graphite/id-20.f b/gcc/testsuite/gfortran.dg/graphite/id-20.f new file mode 100644 index 000000000..795cb1b92 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/graphite/id-20.f @@ -0,0 +1,10 @@ +! { dg-options "-O3 -ffast-math" } + + DIMENSION FPQR(25,25,25) + INTEGER P,Q,R + DO 130 R=1,N4MAX,2 + IF(P.GT.1) THEN + FPQR(P,Q,R)= RM2*FPQR(P,Q,R-2)*REC(P+Q+R-2) + END IF + 130 RM2= RM2+TWO + END diff --git a/gcc/testsuite/gfortran.dg/graphite/id-21.f b/gcc/testsuite/gfortran.dg/graphite/id-21.f new file mode 100644 index 000000000..4fa047ed6 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/graphite/id-21.f @@ -0,0 +1,20 @@ + MODULE LES3D_DATA + DOUBLE PRECISION,ALLOCATABLE,DIMENSION(:,:,:) :: + > P, T, H + DOUBLE PRECISION,ALLOCATABLE,DIMENSION(:,:,:,:) :: + > HF + DOUBLE PRECISION,ALLOCATABLE,DIMENSION(:,:,:,:,:) :: + > Q + END MODULE LES3D_DATA + USE LES3D_DATA + DO K = 1, KMAX - 1 + DO J = 1, JMAX - 1 + DO I = 1, I2 + T(I,J,K) = (EI - HF(I,J,K,1)) / HF(I,J,K,3) + ENDDO + P(1:I2,J,K) = Q(1:I2,J,K,1,M) * HF(1:I2,J,K,4) * T(1:I2,J,K) + IF(ISGSK .EQ. 1) H(1:I2,J,K) = + > (Q(1:I2,J,K,5,M) + P(1:I2,J,K)) + END DO + ENDDO + END diff --git a/gcc/testsuite/gfortran.dg/graphite/id-22.f b/gcc/testsuite/gfortran.dg/graphite/id-22.f new file mode 100644 index 000000000..4b943f1b5 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/graphite/id-22.f @@ -0,0 +1,10 @@ +! { dg-options "-O3 -ffast-math" } + + COMMON /NONEQ / UNZOR + DO ITS = 1, NTS + DO JATOM = 1, NAT + IF(IEF.EQ.5.OR.IEF.EQ.8) + * UNZOR = UNZOR + 8 + ENDDO + ENDDO + END diff --git a/gcc/testsuite/gfortran.dg/graphite/id-23.f b/gcc/testsuite/gfortran.dg/graphite/id-23.f new file mode 100644 index 000000000..74c29283d --- /dev/null +++ b/gcc/testsuite/gfortran.dg/graphite/id-23.f @@ -0,0 +1,13 @@ + SUBROUTINE CAMB(RX2,RTX,NUM) + DIMENSION RX2(NUM,NUM),RTX(NUM,NUM) + DO I=1,NUM + DO J=1,I + DO M=1,NUM + RX2(I,J)=RX2(I,J)+RTX(M,I) + END DO + END DO + END DO + IF (RX2(I,1).LE.EIGCT2) THEN + RTX(I,1)=4.0D+00 + END IF + END diff --git a/gcc/testsuite/gfortran.dg/graphite/id-24.f b/gcc/testsuite/gfortran.dg/graphite/id-24.f new file mode 100644 index 000000000..20c40ee06 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/graphite/id-24.f @@ -0,0 +1,9 @@ + SUBROUTINE TFTRAB(A,NA) + DIMENSION A(NA,NA) + DO 160 K=1,NA + DUM = DUM + A(K,I) + 160 CONTINUE + DO 180 I=1,NA + A(I,J) = DUM + 180 CONTINUE + END diff --git a/gcc/testsuite/gfortran.dg/graphite/id-25.f b/gcc/testsuite/gfortran.dg/graphite/id-25.f new file mode 100644 index 000000000..642ed6de7 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/graphite/id-25.f @@ -0,0 +1,10 @@ + SUBROUTINE TFTRAB(NA,NC,D,WRK) + DIMENSION D(NA,NC), WRK(NA) + DO 160 K=1,NA + DUM = DUM + D(K,J) + 160 CONTINUE + WRK(I) = DUM + DO 180 I=1,NA + D(I,J) = WRK(I) + 180 CONTINUE + END diff --git a/gcc/testsuite/gfortran.dg/graphite/id-3.f90 b/gcc/testsuite/gfortran.dg/graphite/id-3.f90 new file mode 100644 index 000000000..7f0efc7bc --- /dev/null +++ b/gcc/testsuite/gfortran.dg/graphite/id-3.f90 @@ -0,0 +1,19 @@ +subroutine gentrs (ptrst, ncls, xmin, dcls, xdont, ndon) +do icls1 = 1, ncls + prec: do + select case (isns) + case (-1) + do icls = icls1, 1, -1 + enddo + case (+1) + do icls = icls1, ncls + if (xale > rtrst (icls1, icls)) then + endif + enddo + end select + enddo prec +enddo +contains +real function genuni (jsee) +end function genuni +end subroutine gentrs diff --git a/gcc/testsuite/gfortran.dg/graphite/id-4.f90 b/gcc/testsuite/gfortran.dg/graphite/id-4.f90 new file mode 100644 index 000000000..83899445d --- /dev/null +++ b/gcc/testsuite/gfortran.dg/graphite/id-4.f90 @@ -0,0 +1,33 @@ +MODULE Vcimage + CHARACTER (LEN=80), SAVE :: CARD, FIELD +END MODULE Vcimage +MODULE Vimage + LOGICAL, SAVE :: EOFF +END MODULE Vimage +SUBROUTINE READIN(PROB, TITLE, CSTOP, FCYCLE, DCYCLE, DHIST, VHIST& + & , IMAX, PHIST, DEBUG, NSTAT, STATS, MAXSTA, NCORE, PPLOT, & + & DPLOT, VPLOT, TPLOT, SLIST, D0, E0, NODES, SHEAT, GAMMA, COLD & + & , THIST, NVISC, SCREEN, WEIGHT, TSTOP, STABF) + USE Vcimage + USE Vimage + INTEGER, DIMENSION(MAXSTA) :: STATS + IF (.NOT.EOFF) THEN + IF (FIELD=='PROB' .OR. FIELD=='PROBLEM_NUMBER') THEN + CALL QSORT (STATS(1:NSTAT)) + WRITE (16, & + &'(//'' YOU HAVE REQUESTED A PRINTOUT OF THE STATION'', & + & '' ABORT''//)') + ENDIF + ENDIF +CONTAINS + RECURSIVE SUBROUTINE QSORT (LIST) + INTEGER, DIMENSION(:), INTENT(INOUT) :: LIST + INTEGER, DIMENSION(SIZE(LIST)) :: SMALLER,LARGER + IF (SIZE(LIST) > 1) THEN + LIST(NUMBER_SMALLER+1:NUMBER_SMALLER+NUMBER_EQUAL) = CHOSEN + CALL QSORT (LARGER(1:NUMBER_LARGER)) + LIST(NUMBER_SMALLER+NUMBER_EQUAL+1:) = LARGER(1:NUMBER_LARGER) + END IF + END SUBROUTINE QSORT +END SUBROUTINE READIN +! { dg-final { cleanup-modules "vimage vcimage" } } diff --git a/gcc/testsuite/gfortran.dg/graphite/id-5.f b/gcc/testsuite/gfortran.dg/graphite/id-5.f new file mode 100644 index 000000000..b9e93e39c --- /dev/null +++ b/gcc/testsuite/gfortran.dg/graphite/id-5.f @@ -0,0 +1,19 @@ + subroutine shell(Re,Pr,nx,ny,nz, + $nuim,nuex2,nuex4,cfl,scheme,conf,ni,maxit) + real*8 q(5,nx,ny,nz),dq(5,nx,ny,nz),rhs(5,nx,ny,nz),e(5,nx,ny,nz), + 1 f(5,nx,ny,nz),g(5,nx,ny,nz),ev(5,nx,ny,nz),fv(5,nx,ny,nz), + 2 gv(5,nx,ny,nz),diss(5,nx,ny,nz) + do k=1,nz + do j=1,ny + do i=1,nx + do l=1,5 + t1= -0.5d0*dt*( + 3 (g(l,i,j,kp1)-g(l,i,j,km1))/dz) + + 4 dt/Re*((ev(l,i,j,k)-ev(l,im1,j,k))/dx + + 6 (gv(l,i,j,k)-gv(l,i,j,km1))/dz) + rhs(l,i,j,k)=t1+t2 + enddo + enddo + enddo + enddo + end diff --git a/gcc/testsuite/gfortran.dg/graphite/id-6.f b/gcc/testsuite/gfortran.dg/graphite/id-6.f new file mode 100644 index 000000000..2ccb4632a --- /dev/null +++ b/gcc/testsuite/gfortran.dg/graphite/id-6.f @@ -0,0 +1,22 @@ + SUBROUTINE EIJDEN(EPS,V,E,IA,WRK,L1,L2,L3,L0,ECI) + DIMENSION V(L1,L0),EPS(L2),E(*),IA(L1),WRK(L1),ECI(L0,L0) + IF(SCFTYP.EQ.RHF .AND. MPLEVL.EQ.0 .AND. + * CITYP.NE.GUGA .AND. CITYP.NE.CIS) THEN + CALL DCOPY(NORB,E(IADDE),1,E(IADD),1) + END IF + IF (CITYP.NE.GUGA) THEN + DO 500 I = 1,L1 + DO 430 L = 1,NORB + DO 420 K = 1,NORB + IF(K.LE.L) THEN + WRK(L) = WRK(L) - V(I,K)*ECI(K,L) + ELSE + WRK(L) = WRK(L) - V(I,K)*ECI(L,K) + END IF + 420 CONTINUE + 430 CONTINUE + DO 440 L = 1,NORB + 440 CONTINUE + 500 CONTINUE + END IF + END diff --git a/gcc/testsuite/gfortran.dg/graphite/id-7.f b/gcc/testsuite/gfortran.dg/graphite/id-7.f new file mode 100644 index 000000000..dbbbe37a4 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/graphite/id-7.f @@ -0,0 +1,14 @@ + subroutine dasol(al,au,ad,b,jp,neq,energy) + real*8 al(*),au(*),ad(*),b(*),zero,energy,bd,dot + do 100 is=1,neq + if(b(is).ne.zero) go to 200 + 100 continue + return + 200 if(is.lt.neq) then + endif + do 400 j = is,neq + energy=energy+bd*b(j) + 400 continue + if(neq.gt.1)then + endif + end diff --git a/gcc/testsuite/gfortran.dg/graphite/id-8.f b/gcc/testsuite/gfortran.dg/graphite/id-8.f new file mode 100644 index 000000000..6594dda24 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/graphite/id-8.f @@ -0,0 +1,17 @@ + subroutine foo(mxgtot,mxsh) + logical b + dimension ex(mxgtot),cs(mxgtot) + do 500 jg = k1,ig + u = ex(ig)+ex(jg) + z = u*sqrt(u) + x = cs(ig)*cs(jg)/z + if (ig .eq. jg) go to 480 + x = x+x + 480 continue + y = y+x + 500 continue + if(y.gt.t) z=1/sqrt(y) + if (b) then + write(9) z + endif + end diff --git a/gcc/testsuite/gfortran.dg/graphite/id-9.f b/gcc/testsuite/gfortran.dg/graphite/id-9.f new file mode 100644 index 000000000..c93937088 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/graphite/id-9.f @@ -0,0 +1,20 @@ + subroutine foo(bar) + real*8 bar(3,3),coefm + do ii=istart,iend + do i=1,21 + bar(k,l)=4 + enddo + do m=1,ne + do l=1,3 + do k=1,l + enddo + bar(k,l)=bar(k,l)+(v3b-1.d0) + enddo + enddo + do m=1,ne + do k=1,l + l = l*(v3b**(-coefm)) + enddo + enddo + enddo + end diff --git a/gcc/testsuite/gfortran.dg/graphite/id-pr43354.f b/gcc/testsuite/gfortran.dg/graphite/id-pr43354.f new file mode 100644 index 000000000..e614f912b --- /dev/null +++ b/gcc/testsuite/gfortran.dg/graphite/id-pr43354.f @@ -0,0 +1,18 @@ + SUBROUTINE POFUN2(DIM,GRDENT,FPART,FPARTL) + DOUBLE PRECISION GRDENT(*) + DOUBLE COMPLEX FPART(*) + DOUBLE COMPLEX FPARTL(*) + INTEGER REFLCT,XRIREF + IF (DIM.GT.1) THEN + ABCS3=XRCELL(1) + IF (ABCS2.EQ.ABCS3) THEN + END IF + ELSE + DO REFLCT=1,XRIREF,1 + FPARTL(REFLCT)=FPART(REFLCT) + END DO + END IF + IF (ABCS2.EQ.ABCS3) THEN + GRDENT(1)=GRDENT(3) + END IF + END diff --git a/gcc/testsuite/gfortran.dg/graphite/id-pr45370.f90 b/gcc/testsuite/gfortran.dg/graphite/id-pr45370.f90 new file mode 100644 index 000000000..94eebd1f8 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/graphite/id-pr45370.f90 @@ -0,0 +1,100 @@ +! + type :: t + real :: r + integer :: i + character(3) :: chr + end type t + + type :: t2 + real :: r(2, 2) + integer :: i + character(3) :: chr + end type t2 + + type :: s + type(t), pointer :: t(:) + end type s + + integer, parameter :: sh(2) = (/2,2/) + real, parameter :: a1(2,2) = reshape ((/1.0,2.0,3.0,4.0/),sh) + real, parameter :: a2(2,2) = reshape ((/5.0,6.0,7.0,8.0/),sh) + + type(t), target :: tar1(2) = (/t(1.0, 2, "abc"), t(3.0, 4, "efg")/) + character(4), target :: tar2(2) = (/"abcd","efgh"/) + type(s), target :: tar3 + character(2), target :: tar4(2) = (/"ab","cd"/) + type(t2), target :: tar5(2) = (/t2(a1, 2, "abc"), t2(a2, 4, "efg")/) + + integer, pointer :: ptr(:) + character(2), pointer :: ptr2(:) + real, pointer :: ptr3(:) + +!_______________component subreference___________ + ptr => tar1%i + ptr = ptr + 1 ! check the scalarizer is OK + + if (any (ptr .ne. (/3, 5/))) call abort () + if (any ((/ptr(1), ptr(2)/) .ne. (/3, 5/))) call abort () + if (any (tar1%i .ne. (/3, 5/))) call abort () + +! Make sure that the other components are not touched. + if (any (tar1%r .ne. (/1.0, 3.0/))) call abort () + if (any (tar1%chr .ne. (/"abc", "efg"/))) call abort () + +! Check that the pointer is passed correctly as an actual argument. + call foo (ptr) + if (any (tar1%i .ne. (/2, 4/))) call abort () + +! And that dummy pointers are OK too. + call bar (ptr) + if (any (tar1%i .ne. (/101, 103/))) call abort () + +!_______________substring subreference___________ + ptr2 => tar2(:)(2:3) + ptr2 = ptr2(:)(2:2)//"z" ! again, check the scalarizer + + if (any (ptr2 .ne. (/"cz", "gz"/))) call abort () + if (any ((/ptr2(1), ptr2(2)/) .ne. (/"cz", "gz"/))) call abort () + if (any (tar2 .ne. (/"aczd", "egzh"/))) call abort () + +!_______________substring component subreference___________ + ptr2 => tar1(:)%chr(1:2) + ptr2 = ptr2(:)(2:2)//"q" ! yet again, check the scalarizer + if (any (ptr2 .ne. (/"bq","fq"/))) call abort () + if (any (tar1%chr .ne. (/"bqc","fqg"/))) call abort () + +!_______________trailing array element subreference___________ + ptr3 => tar5%r(1,2) + ptr3 = (/99.0, 999.0/) + if (any (tar5(1)%r .ne. reshape ((/1.0,2.0,99.0,4.0/), sh))) call abort () + if (any (tar5(2)%r .ne. reshape ((/5.0,6.0,999.0,8.0/), sh))) call abort () + +!_______________forall assignment___________ + ptr2 => tar2(:)(1:2) + forall (i = 1:2) ptr2(i)(1:1) = "z" + if (any (tar2 .ne. (/"zczd", "zgzh"/))) call abort () + +!_______________something more complicated___________ + tar3%t => tar1 + ptr3 => tar3%t%r + ptr3 = cos (ptr3) + if (any (abs(ptr3 - (/cos(1.0_4), cos(3.0_4)/)) >= epsilon(1.0_4))) call abort () + + ptr2 => tar3%t(:)%chr(2:3) + ptr2 = " x" + if (any (tar1%chr .ne. (/"b x", "f x"/))) call abort () + +!_______________check non-subref works still___________ + ptr2 => tar4 + if (any (ptr2 .ne. (/"ab","cd"/))) call abort () + +contains + subroutine foo (arg) + integer :: arg(:) + arg = arg - 1 + end subroutine + subroutine bar (arg) + integer, pointer :: arg(:) + arg = arg + 99 + end subroutine +end diff --git a/gcc/testsuite/gfortran.dg/graphite/id-pr46994.f90 b/gcc/testsuite/gfortran.dg/graphite/id-pr46994.f90 new file mode 100644 index 000000000..93eff45fb --- /dev/null +++ b/gcc/testsuite/gfortran.dg/graphite/id-pr46994.f90 @@ -0,0 +1,14 @@ +! { dg-options "-O -ffast-math -fgraphite-identity -fno-tree-dce" } + +subroutine foo (m) + integer :: m, i, j, k + real :: s + s = 0 + do i = 1, 9 + do j = 1, 2*m + do k = 1, 2*m + s = s + 1 + end do + end do + end do +end subroutine foo diff --git a/gcc/testsuite/gfortran.dg/graphite/id-pr46995.f90 b/gcc/testsuite/gfortran.dg/graphite/id-pr46995.f90 new file mode 100644 index 000000000..06cbfd364 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/graphite/id-pr46995.f90 @@ -0,0 +1,16 @@ +! { dg-options "-O -ffast-math -fgraphite-identity -fno-tree-dce" } + +subroutine foo (m, l, zw) + integer :: m, i, j, k + real, dimension(1:9) :: zw + real :: l, s + s = 0 + do i = 1, 9 + do j = 1, 2*m + do k = 1, 2*m + s = s + 1 + end do + end do + l = l + zw(i)*s + end do +end subroutine foo diff --git a/gcc/testsuite/gfortran.dg/graphite/interchange-1.f b/gcc/testsuite/gfortran.dg/graphite/interchange-1.f new file mode 100644 index 000000000..334fbd824 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/graphite/interchange-1.f @@ -0,0 +1,45 @@ + subroutine foo(f1,f2,f3,f4,f5,f6,f7,f8,f9,f0,g1,g2,g3) + implicit none + integer f4,f3,f2,f1 + integer g4,g5,g6,g7,g8,g9 + integer i1,i2,i3,i4,i5 + + real*8 g1(5,f3,f2,f1),g2(5,5,f3,f2,f1),g3(5,f3,f2,f1) + real*8 f0(5,5,f3,f2,f1),f9(5,5,f3,f2,f1),f8(5,5,f3,f2,f1) + real*8 f7(5,5,f3,f2,f1),f6(5,5,f3,f2,f1),f5(5,5,f3,f2,f1) + + do i3=1,f1 + g8=mod(i3+f1-2,f1)+1 + g9=mod(i3,f1)+1 + do i4=1,f2 + g6=mod(i4+f2-2,f2)+1 + g7=mod(i4,f2)+1 + do i5=1,f3 + g4=mod(i5+f3-2,f3)+1 + g5=mod(i5,f3)+1 + do i1=1,5 + g3(i1,i5,i4,i3)=0.0d0 + do i2=1,5 + g3(i1,i5,i4,i3)=g3(i1,i5,i4,i3)+ + 1 g2(i1,i2,i5,i4,i3)*g1(i2,i5,i4,i3)+ + 2 f0(i1,i2,i5,i4,i3)*g1(i2,g5,i4,i3)+ + 3 f9(i1,i2,i5,i4,i3)*g1(i2,i5,g7,i3)+ + 4 f8(i1,i2,i5,i4,i3)*g1(i2,i5,i4,g9)+ + 5 f7(i1,i2,i5,i4,i3)*g1(i2,g4,i4,i3)+ + 6 f6(i1,i2,i5,i4,i3)*g1(i2,i5,g6,i3)+ + 7 f5(i1,i2,i5,i4,i3)*g1(i2,i5,i4,g8) + enddo + enddo + enddo + enddo + enddo + return + end + + +! We should be able to interchange this as the number of iterations is +! known to be 4 in the inner two loops. See interchange-2.f for the +! kernel from bwaves. + +! { dg-final { scan-tree-dump-times "will be interchanged" 1 "graphite" { xfail *-*-* } } } +! { dg-final { cleanup-tree-dump "graphite" } } diff --git a/gcc/testsuite/gfortran.dg/graphite/interchange-2.f b/gcc/testsuite/gfortran.dg/graphite/interchange-2.f new file mode 100644 index 000000000..8e2e87f12 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/graphite/interchange-2.f @@ -0,0 +1,43 @@ + subroutine foo(f1,f2,f3,f4,f5,f6,f7,f8,f9,f0,g1,g2,g3) + implicit none + integer f4,f3,f2,f1 + integer g4,g5,g6,g7,g8,g9 + integer i1,i2,i3,i4,i5 + + real*8 g1(f4,f3,f2,f1),g2(f4,f4,f3,f2,f1),g3(f4,f3,f2,f1) + real*8 f0(f4,f4,f3,f2,f1),f9(f4,f4,f3,f2,f1),f8(f4,f4,f3,f2,f1) + real*8 f7(f4,f4,f3,f2,f1),f6(f4,f4,f3,f2,f1),f5(f4,f4,f3,f2,f1) + + do i3=1,f1 + g8=mod(i3+f1-2,f1)+1 + g9=mod(i3,f1)+1 + do i4=1,f2 + g6=mod(i4+f2-2,f2)+1 + g7=mod(i4,f2)+1 + do i5=1,f3 + g4=mod(i5+f3-2,f3)+1 + g5=mod(i5,f3)+1 + do i1=1,f4 + g3(i1,i5,i4,i3)=0.0d0 + do i2=1,f4 + g3(i1,i5,i4,i3)=g3(i1,i5,i4,i3)+ + 1 g2(i1,i2,i5,i4,i3)*g1(i2,i5,i4,i3)+ + 2 f0(i1,i2,i5,i4,i3)*g1(i2,g5,i4,i3)+ + 3 f9(i1,i2,i5,i4,i3)*g1(i2,i5,g7,i3)+ + 4 f8(i1,i2,i5,i4,i3)*g1(i2,i5,i4,g9)+ + 5 f7(i1,i2,i5,i4,i3)*g1(i2,g4,i4,i3)+ + 6 f6(i1,i2,i5,i4,i3)*g1(i2,i5,g6,i3)+ + 7 f5(i1,i2,i5,i4,i3)*g1(i2,i5,i4,g8) + enddo + enddo + enddo + enddo + enddo + return + end + +! This is the kernel extracted from bwaves: this cannot be interchanged +! as the number of iterations for f4 is not known. + +! { dg-final { scan-tree-dump-times "will be interchanged" 0 "graphite" } } +! { dg-final { cleanup-tree-dump "graphite" } } diff --git a/gcc/testsuite/gfortran.dg/graphite/interchange-3.f90 b/gcc/testsuite/gfortran.dg/graphite/interchange-3.f90 new file mode 100644 index 000000000..06da2b3aa --- /dev/null +++ b/gcc/testsuite/gfortran.dg/graphite/interchange-3.f90 @@ -0,0 +1,28 @@ +! Formerly known as ltrans-7.f90 + +Program FOO + IMPLICIT INTEGER (I-N) + IMPLICIT REAL*8 (A-H, O-Z) + PARAMETER (N1=1335, N2=1335) + COMMON U(N1,N2), V(N1,N2), P(N1,N2) + + PC = 0.0D0 + UC = 0.0D0 + VC = 0.0D0 + + do I = 1, M + do J = 1, M + PC = PC + abs(P(I,J)) + UC = UC + abs(U(I,J)) + VC = VC + abs(V(I,J)) + end do + U(I,I) = U(I,I) * ( mod (I, 100) /100.) + end do + + write(6,366) PC, UC, VC +366 format(/, ' PC = ',E12.4,/,' UC = ',E12.4,/,' VC = ',E12.4,/) + +end Program FOO + +! { dg-final { scan-tree-dump-times "will be interchanged" 1 "graphite" } } +! { dg-final { cleanup-tree-dump "graphite" } } diff --git a/gcc/testsuite/gfortran.dg/graphite/interchange-4.f b/gcc/testsuite/gfortran.dg/graphite/interchange-4.f new file mode 100644 index 000000000..3d42811bc --- /dev/null +++ b/gcc/testsuite/gfortran.dg/graphite/interchange-4.f @@ -0,0 +1,29 @@ + subroutine s231 (ntimes,ld,n,ctime,dtime,a,b,c,d,e,aa,bb,cc) +c +c loop interchange +c loop with multiple dimension recursion +c + integer ntimes, ld, n, i, nl, j + double precision a(n), b(n), c(n), d(n), e(n), aa(ld,n), + + bb(ld,n), cc(ld,n) + double precision chksum, cs2d + real t1, t2, second, ctime, dtime + + call init(ld,n,a,b,c,d,e,aa,bb,cc,'s231 ') + t1 = second() + do 1 nl = 1,ntimes/n + do 10 i=1,n + do 20 j=2,n + aa(i,j) = aa(i,j-1) + bb(i,j) + 20 continue + 10 continue + call dummy(ld,n,a,b,c,d,e,aa,bb,cc,1.d0) + 1 continue + t2 = second() - t1 - ctime - ( dtime * float(ntimes/n) ) + chksum = cs2d(n,aa) + call check (chksum,(ntimes/n)*n*(n-1),n,t2,'s231 ') + return + end + +! { dg-final { scan-tree-dump-times "will be interchanged" 1 "graphite" { xfail *-*-* } } } +! { dg-final { cleanup-tree-dump "graphite" } } diff --git a/gcc/testsuite/gfortran.dg/graphite/interchange-5.f b/gcc/testsuite/gfortran.dg/graphite/interchange-5.f new file mode 100644 index 000000000..658f10a74 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/graphite/interchange-5.f @@ -0,0 +1,30 @@ + subroutine s235 (ntimes,ld,n,ctime,dtime,a,b,c,d,e,aa,bb,cc) +c +c loop interchanging +c imperfectly nested loops +c + integer ntimes, ld, n, i, nl, j + double precision a(n), b(n), c(n), d(n), e(n), aa(ld,n), + + bb(ld,n), cc(ld,n) + double precision chksum, cs1d, cs2d + real t1, t2, second, ctime, dtime + + call init(ld,n,a,b,c,d,e,aa,bb,cc,'s235 ') + t1 = second() + do 1 nl = 1,ntimes/n + do 10 i = 1,n + a(i) = a(i) + b(i) * c(i) + do 20 j = 2,n + aa(i,j) = aa(i,j-1) + bb(i,j) * a(i) + 20 continue + 10 continue + call dummy(ld,n,a,b,c,d,e,aa,bb,cc,1.d0) + 1 continue + t2 = second() - t1 - ctime - ( dtime * float(ntimes/n) ) + chksum = cs2d(n,aa) + cs1d(n,a) + call check (chksum,(ntimes/n)*n*(n-1),n,t2,'s235 ') + return + end + +! { dg-final { scan-tree-dump-times "will be interchanged" 1 "graphite" { xfail *-*-* } } } +! { dg-final { cleanup-tree-dump "graphite" } } diff --git a/gcc/testsuite/gfortran.dg/graphite/pr14741.f90 b/gcc/testsuite/gfortran.dg/graphite/pr14741.f90 new file mode 100644 index 000000000..3fe1d690c --- /dev/null +++ b/gcc/testsuite/gfortran.dg/graphite/pr14741.f90 @@ -0,0 +1,29 @@ +! { dg-options "-O3 -ffast-math -floop-interchange -floop-block -fdump-tree-graphite-all" } + + INTEGER, PARAMETER :: N=1024 + REAL*8 :: A(N,N), B(N,N), C(N,N) + REAL*8 :: t1,t2 + A=0.1D0 + B=0.1D0 + C=0.0D0 + CALL cpu_time(t1) + CALL mult(A,B,C,N) + CALL cpu_time(t2) + write(6,*) t2-t1,C(1,1) +END program + +SUBROUTINE mult(A,B,C,N) + REAL*8 :: A(N,N), B(N,N), C(N,N) + INTEGER :: I,J,K,N + DO J=1,N + DO I=1,N + DO K=1,N + C(I,J)=C(I,J)+A(I,K)*B(K,J) + ENDDO + ENDDO + ENDDO +END SUBROUTINE mult + +! { dg-final { scan-tree-dump-times "number of SCoPs: 1" 1 "graphite" { xfail *-*-* } } } +! { dg-final { scan-tree-dump-times "will be loop blocked" 1 "graphite" { xfail *-*-* } } } +! { dg-final { cleanup-tree-dump "graphite" } } diff --git a/gcc/testsuite/gfortran.dg/graphite/pr29290.f90 b/gcc/testsuite/gfortran.dg/graphite/pr29290.f90 new file mode 100644 index 000000000..8968d88c4 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/graphite/pr29290.f90 @@ -0,0 +1,9 @@ +! PR tree-optimization/29290 +! { dg-do compile } +! { dg-options "-O3 -ftree-loop-linear" } + +subroutine pr29290 (a, b, c, d) + integer c, d + real*8 a(c,c), b(c,c) + a(1:d,1:d) = b(1:d,1:d) +end diff --git a/gcc/testsuite/gfortran.dg/graphite/pr29581.f90 b/gcc/testsuite/gfortran.dg/graphite/pr29581.f90 new file mode 100644 index 000000000..3e4a39efb --- /dev/null +++ b/gcc/testsuite/gfortran.dg/graphite/pr29581.f90 @@ -0,0 +1,27 @@ +! PR tree-optimization/29581 +! { dg-do run } +! { dg-options "-O2 -ftree-loop-linear" } + + SUBROUTINE FOO (K) + INTEGER I, J, K, A(5,5), B + COMMON A + A(1,1) = 1 + 10 B = 0 + DO 30 I = 1, K + DO 20 J = 1, K + B = B + A(I,J) + 20 CONTINUE + A(I,I) = A(I,I) * 2 + 30 CONTINUE + IF (B.GE.3) RETURN + GO TO 10 + END SUBROUTINE + + PROGRAM BAR + INTEGER A(5,5) + COMMON A + CALL FOO (2) + IF (A(1,1).NE.8) CALL ABORT + A(1,1) = 0 + IF (ANY(A.NE.0)) CALL ABORT + END diff --git a/gcc/testsuite/gfortran.dg/graphite/pr29832.f90 b/gcc/testsuite/gfortran.dg/graphite/pr29832.f90 new file mode 100644 index 000000000..ab222ab03 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/graphite/pr29832.f90 @@ -0,0 +1,26 @@ +! { dg-do run } +! { dg-options "-O2 -ftree-loop-linear" } + +! Program to test the scalarizer +program testarray + implicit none + integer, dimension (6, 5) :: a, b + integer n + + a = 0 + do n = 1, 5 + a(4, n) = n + end do + + b(:, 5:1:-1) = a + a(1:5, 2) = a(4, :) + 1 + + ! The following expression should cause loop reordering + a(:, 2:4) = a(:, 1:3) + + do n = 1, 5 + if (a(n, 3) .ne. (n + 1)) call abort + if (b(4, n) .ne. (6 - n)) call abort + end do +end program + diff --git a/gcc/testsuite/gfortran.dg/graphite/pr36286.f90 b/gcc/testsuite/gfortran.dg/graphite/pr36286.f90 new file mode 100644 index 000000000..bcdef0850 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/graphite/pr36286.f90 @@ -0,0 +1,14 @@ +! { dg-do compile } +! { dg-options "-O1 -ftree-loop-linear" } +! PR tree-optimization/36286 + +program test_count + integer, dimension(2,3) :: a, b + a = reshape( (/ 1, 3, 5, 2, 4, 6 /), (/ 2, 3 /)) + b = reshape( (/ 0, 3, 5, 7, 4, 8 /), (/ 2, 3 /)) + print '(3l6)', a.ne.b + print *, a(1,:).ne.b(1,:) + print *, a(2,:).ne.b(2,:) + print *, count(a.ne.b) +end program test_count + diff --git a/gcc/testsuite/gfortran.dg/graphite/pr36922.f b/gcc/testsuite/gfortran.dg/graphite/pr36922.f new file mode 100644 index 000000000..6aa95beb6 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/graphite/pr36922.f @@ -0,0 +1,16 @@ +C PR tree-optimization/36922 +C { dg-do compile } +C { dg-options "-O2 -ftree-loop-linear" } + SUBROUTINE PR36922(N,F,Z,C) + IMPLICIT DOUBLE PRECISION(A-H,O-Z) + DIMENSION C(23821),Z(0:2*N+1),F(0:2*N) + I=0 + DO L=0,N + DO M=0,L + DO M2=M,L + I=I+1 + C(I)=F(L+M)*F(L-M)*Z(L-M2)/(F(M2+M)*F(M2-M)*F(L-M2)*F(L-M2)) + ENDDO + ENDDO + ENDDO + END diff --git a/gcc/testsuite/gfortran.dg/graphite/pr37852.f90 b/gcc/testsuite/gfortran.dg/graphite/pr37852.f90 new file mode 100644 index 000000000..a5d48b712 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/graphite/pr37852.f90 @@ -0,0 +1,13 @@ +! { dg-options "-O2 " } + +PROGRAM TEST_FPU +CHARACTER (LEN=36) :: invert_id(1) = & + (/ 'Test1 - Gauss 2000 (101x101) inverts'/) +END PROGRAM TEST_FPU + +SUBROUTINE Gauss (a,n) +INTEGER, PARAMETER :: RK8 = SELECTED_REAL_KIND(15, 300) +REAL(RK8) :: a(n,n) +INTEGER :: ipvt(n) +a(:,ipvt) = b +END SUBROUTINE Gauss diff --git a/gcc/testsuite/gfortran.dg/graphite/pr37857.f90 b/gcc/testsuite/gfortran.dg/graphite/pr37857.f90 new file mode 100644 index 000000000..c2cccb775 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/graphite/pr37857.f90 @@ -0,0 +1,9 @@ +! { dg-options "-O2 " } + +program superficie_proteina + integer, parameter :: LONGreal = selected_real_kind(12,90) + integer :: number_of_polypeptides, maximum_polypeptide_length + real (kind = LONGreal), dimension (:,:), allocatable :: individual_conformations + allocate (individual_conformations(-number_of_bins:0,number_of_polypeptides)) + individual_conformations = 0.0_LONGreal +end program superficie_proteina diff --git a/gcc/testsuite/gfortran.dg/graphite/pr37980.f90 b/gcc/testsuite/gfortran.dg/graphite/pr37980.f90 new file mode 100644 index 000000000..e964adec1 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/graphite/pr37980.f90 @@ -0,0 +1,12 @@ +! { dg-options "-O2 " } + +module INT_MODULE +contains + pure function spher_cartesians(in1) result(out1) + integer(kind=kind(1)) :: in1 + intent(in) :: in1 + real(kind=kind(1.0d0)), dimension(0:in1,0:in1,0:in1) :: mat0 + mat0 = 0.0d0 + end function spher_cartesians +end module INT_MODULE +! { dg-final { cleanup-modules "int_module" } } diff --git a/gcc/testsuite/gfortran.dg/graphite/pr38083.f90 b/gcc/testsuite/gfortran.dg/graphite/pr38083.f90 new file mode 100644 index 000000000..da8c3cc79 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/graphite/pr38083.f90 @@ -0,0 +1,16 @@ +! { dg-options "-O3 " } + +SUBROUTINE IVSORT (IL,IH,NSEGS,IOUNIT) + INTEGER IOUNIT + + INTEGER, PARAMETER :: MAXGS = 32 + +10 IF (IL .GE. IH) GO TO 80 +20 NSEGS = (IH + IL) / 2 + IF (NSEGS .GT. MAXSGS) THEN + WRITE (IOUNIT),MAXSGS + ENDIF +80 NSEGS = NSEGS - 1 +90 IF (IH - IL .GE. 11) GO TO 20 +110 IF (IL .EQ. IH) GO TO 80 +END SUBROUTINE IVSORT diff --git a/gcc/testsuite/gfortran.dg/graphite/pr38459.f90 b/gcc/testsuite/gfortran.dg/graphite/pr38459.f90 new file mode 100644 index 000000000..1feb6e503 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/graphite/pr38459.f90 @@ -0,0 +1,14 @@ +! { dg-options "-O2 -fgraphite-identity" } +# 1 "mltfftsg.F" +# 1 "<built-in>" +SUBROUTINE mltfftsg ( a, ldax, lday, b, ldbx, ldby, & + n, m) + INTEGER, PARAMETER :: dbl = SELECTED_REAL_KIND ( 14, 200 ) + +! Arguments + INTEGER, INTENT ( IN ) :: ldbx, ldby, n, m + COMPLEX ( dbl ), INTENT ( INOUT ) :: b ( ldbx, ldby ) + + B(N+1:LDBX,1:M) = CMPLX(0._dbl,0._dbl,dbl) + +END SUBROUTINE mltfftsg diff --git a/gcc/testsuite/gfortran.dg/graphite/pr38953.f90 b/gcc/testsuite/gfortran.dg/graphite/pr38953.f90 new file mode 100644 index 000000000..391549e3c --- /dev/null +++ b/gcc/testsuite/gfortran.dg/graphite/pr38953.f90 @@ -0,0 +1,116 @@ +! { dg-options "-O3 -fgraphite-identity" } + + MODULE MAIN1 + INTEGER , PARAMETER :: IFMAX = 40 , IKN = 85 , ISTRG = 132 , & + & IERRN = 170 , ILEN_FLD = 80 + CHARACTER PATH*2 , PPATH*2 , KEYWRD*8 , PKEYWD*8 , KEYWD*8 , & + & KTYPE*5 , RUNST*1 + DIMENSION FIELD(IFMAX) , KEYWD(IKN) , RUNST(ISTRG) + LOGICAL :: DFAULT , CONC , DEPOS , DDEP , WDEP , RURAL , URBAN , & + & GRDRIS , NOSTD , NOBID , CLMPRO , MSGPRO , PERIOD , & + & OLM=.FALSE. + INTEGER :: NSRC , NREC , NGRP , NQF, & + & NARC , NOLM + CHARACTER NETID*8 , NETIDT*8 , PNETID*8 , NTID*8 , NTTYP*8 , & + & RECTYP*2 , PXSOID*8 , PESOID*8 , ARCID*8 + ALLOCATABLE ::NETID(:) , RECTYP(:) , NTID(:) , NTTYP(:) , ARCID(:) + DATA (KEYWD(I),I=1,IKN)/'STARTING' , 'FINISHED' , 'TITLEONE' , & + & 'TITLETWO' , 'MODELOPT' , 'AVERTIME' , 'POLLUTID' , & + & 'HALFLIFE' , 'DCAYCOEF' , 'DEBUGOPT' , 'ELEVUNIT' , & + & 'FLAGPOLE' , 'RUNORNOT' , 'EVENTFIL' , 'SAVEFILE' , & + & 'INITFILE' , 'MULTYEAR' , 'ERRORFIL' , 'GASDEPDF' , & + & 'GDSEASON' , 'GASDEPVD' , 'GDLANUSE' , 'EVENTFIL' , & + & 'URBANOPT' , 'METHOD_2' , 'LOCATION' , 'SRCPARAM' , & + & 'BUILDHGT' , 'BUILDWID' , 'BUILDLEN' , 'XBADJ ' , & + & 'YBADJ ' , 'EMISFACT' , 'EMISUNIT' , 'PARTDIAM' , & + & 'MASSFRAX' , 'PARTDENS' , ' ' , ' ' , & + & ' ' , 'CONCUNIT' , 'DEPOUNIT' , 'HOUREMIS' , & + & 'GASDEPOS' , 'URBANSRC' , 'EVENTPER' , 'EVENTLOC' , & + & 'SRCGROUP' , 'GRIDCART' , 'GRIDPOLR' , 'DISCCART' , & + & 'DISCPOLR' , 'SURFFILE' , 'PROFFILE' , 'PROFBASE' , & + & ' ' , 'SURFDATA' , 'UAIRDATA' , 'SITEDATA' , & + & 'STARTEND' , 'DAYRANGE' , 'WDROTATE' , 'DTHETADZ' , & + & 'WINDCATS' , 'RECTABLE' , 'MAXTABLE' , 'DAYTABLE' , & + & 'MAXIFILE' , 'POSTFILE' , 'PLOTFILE' , 'TOXXFILE' , & + & 'EVENTOUT' , 'INCLUDED' , 'SCIMBYHR' , 'SEASONHR' , & + & 'AREAVERT' , 'PARTSIZE' , 'RANKFILE' , 'EVALCART' , & + & 'EVALFILE' , 'NO2EQUIL' , 'OZONEVAL' , 'OZONEFIL' , & + & 'NO2RATIO' , 'OLMGROUP'/ + DIMENSION RESTAB(9,6,5) , STAB(9) + DATA (((RESTAB(I,J,K),I=1,9),J=1,6),K=1,5)/1.E07 , 60. , 120. , & + & 100. , 200. , 150. , 1.E07 , 1.E07 , 80. , 1.E07 , 2000. , & + & 2000. , 2000. , 2000. , 2000. , 1.E07 , 1.E07 , 2500. , & + & 1.E07 , 1000. , 1000. , 1000. , 2000. , 2000. , 1.E07 , & + & 1.E07 , 1000. , 100. , 200. , 100. , 2000. , 100. , 1500. , & + & 0. , 0. , 300. , 400. , 150. , 350. , 300. , 500. , 450. , & + & 0. , 1000. , 0. , 300. , 150. , 200. , 200. , 300. , 300. , & + & 2000. , 400. , 1000. , 1.E07 , 1.E07 , 1.E07 , 350. , & + & 1.E07 , 700. , 1.E07 , 1.E07 , 1.E07 , 1.E07 , 6500. , & + & 6500. , 3000. , 2000. , 2000. , 1.E07 , 1.E07 , 6500. , & + & 1.E07 , 400. , 300. , 500. , 600. , 1000. , 1.E07 , 1.E07 , & + & 300. , 100. , 150. , 100. , 1700. , 100. , 1200. , 0. , 0. ,& + & 200. , 400. , 200. , 350. , 300. , 500. , 450. , 0. , & + & 1000. , 0. , 300. , 150. , 200. , 200. , 300. , 300. , & + & 2000. , 400. , 800. , 1.E07 , 1.E07 , 1.E07 , 500. , 1.E07 ,& + & 1000. , 1.E07 , 1.E07 , 1.E07 , 1.E07 , 1.E07 , 9000. , & + & 6000. , 2000. , 2000. , 1.E07 , 1.E07 , 9000. , 1.E07 , & + & 1.E07 , 400. , 600. , 800. , 1600. , 1.E07 , 1.E07 , 800. , & + & 100. , 0. , 100. , 1500. , 100. , 1000. , 0. , 0. , 100. , & + & 400. , 150. , 350. , 300. , 500. , 450. , 0. , 0. , 1000. , & + & 300. , 150. , 200. , 200. , 300. , 300. , 2000. , 400. , & + & 1000. , 1.E07 , 1.E07 , 1.E07 , 800. , 1.E07 , 1600. , & + & 1.E07 , 1.E07 , 1.E07 , 1.E07 , 1.E07 , 1.E07 , 400. , & + & 1.E07 , 800. , 1.E07 , 1.E07 , 9000. , 1.E07 , 2000. , & + & 1000. , 600. , 2000. , 1200. , 1.E07 , 1.E07 , 800. , 100. ,& + & 0. , 10. , 1500. , 100. , 1000. , 0. , 0. , 50. , 100. , & + & 100. , 100. , 100. , 200. , 200. , 0. , 1000. , 100. , & + & 600. , 3500. , 3500. , 3500. , 500. , 500. , 2000. , 400. , & + & 3500. , 1.E07 , 100. , 120. , 100. , 200. , 150. , 1.E07 , & + & 1.E07 , 80. , 1.E07 , 2000. , 2000. , 1500. , 2000. , & + & 2000. , 1.E07 , 1.E07 , 2000. , 1.E07 , 1000. , 250. , & + & 350. , 500. , 700. , 1.E07 , 1.E07 , 300. , 100. , 50. , & + & 80. , 1500. , 100. , 1000. , 0. , 0. , 200. , 500. , 150. , & + & 350. , 300. , 500. , 450. , 0. , 1000. , 0. , 300. , 150. , & + & 200. , 200. , 300. , 300. , 2000. , 400. , 1000./ + END + SUBROUTINE SHAVE + USE MAIN1 + IF ( PERIOD ) THEN + 9020 FORMAT ('(''*'',8X,''X'',13X,''Y'',4X,',I1, & + &'(2X,3A4),4X,''ZELEV'', 4X,''ZHILL'',4X,''ZFLAG'',4X,''AVE'',5X,& + &_______ ________ ________'')') + ENDIF + DO IGRP = 1 , NUMGRP + IF ( IANPST(IGRP).EQ.1 ) THEN + IF ( IANFRM(IGRP).EQ.0 ) THEN + DO IREC = 1 , NUMREC + ENDDO + ENDIF + DO IREC = 1 , NUMREC + IF ( RECTYP(IREC).EQ.'DC' ) THEN + WRITE (IOUNIT,9082) SRCID(ISRF) , SRCTYP(ISRF) , & + & AXS(ISRF) , AYS(ISRF) , AZS(ISRF) & + & , (J,AXR(IREC+J-1),AYR(IREC+J-1), & + & HCLMSG(IREC+J-1,IHNUM,IGRP,IAVE, & + & ITYP),J=1,36) + 9082 FORMAT (' BOUNDARY RECEPTOR NETWORK OF SOURCE ID: ', & + & 18(2(1X,I4,3X,F10.2,', ',F10.2,',',F13.5,A1, & + & '(',I8.8,')',7X),/),/) + ENDIF + ENDDO + ENDIF + ENDDO + END + USE MAIN1 + IF ( ICOUNT.NE.0 .AND. JCOUNT.NE.0 ) THEN + DO J = 1 , JCOUNT + DO I = 1 , ICOUNT + IF ( ISET.GT.NREC ) THEN + GOTO 999 + ENDIF + ENDDO + ENDDO + ENDIF + 999 CONTINUE + END +! { dg-final { cleanup-modules "main1" } } diff --git a/gcc/testsuite/gfortran.dg/graphite/pr39516.f b/gcc/testsuite/gfortran.dg/graphite/pr39516.f new file mode 100644 index 000000000..3d6104a8e --- /dev/null +++ b/gcc/testsuite/gfortran.dg/graphite/pr39516.f @@ -0,0 +1,20 @@ +C PR tree-optimization/39516 +C { dg-do compile } +C { dg-options "-O2 -ftree-loop-linear" } + SUBROUTINE SUB(A, B, M) + IMPLICIT NONE + DOUBLE PRECISION A(20,20), B(20) + INTEGER*8 I, J, K, M + DO I=1,M + DO J=1,M + A(I,J)=A(I,J)+1 + END DO + END DO + DO K=1,20 + DO I=1,M + DO J=1,M + B(I)=B(I)+A(I,J) + END DO + END DO + END DO + END SUBROUTINE diff --git a/gcc/testsuite/gfortran.dg/graphite/pr40982.f90 b/gcc/testsuite/gfortran.dg/graphite/pr40982.f90 new file mode 100644 index 000000000..c49def850 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/graphite/pr40982.f90 @@ -0,0 +1,71 @@ +! { dg-options "-O3 -fgraphite-identity -floop-interchange " } + +module mqc_m + + +implicit none + +private +public :: mutual_ind_quad_cir_coil + +integer, parameter, private :: longreal = selected_real_kind(15,90) +real (kind = longreal), parameter, private :: pi = 3.141592653589793_longreal +real (kind = longreal), parameter, private :: small = 1.0e-10_longreal + +contains + + subroutine mutual_ind_quad_cir_coil (r_coil, x_coil, y_coil, z_coil, h_coil, n_coil, & + rotate_coil, m, mu, l12) + real (kind = longreal), intent(in) :: r_coil, x_coil, y_coil, z_coil, h_coil, n_coil, & + mu + real (kind = longreal), dimension(:,:), intent(in) :: rotate_coil + integer, intent(in) :: m + real (kind = longreal), intent(out) :: l12 + real (kind = longreal), dimension(3,3) :: rotate_quad + real (kind = longreal), dimension(9), save :: x2gauss, y2gauss, w2gauss, z1gauss, & + w1gauss + real (kind = longreal) :: xxvec, xyvec, xzvec, yxvec, yyvec, yzvec, zxvec, zyvec, & + zzvec, magnitude, l12_lower, l12_upper, dx, dy, dz, theta, & + a, b1, b2, numerator, denominator, coefficient, angle + real (kind = longreal), dimension(3) :: c_vector, q_vector, rot_c_vector, & + rot_q_vector, current_vector, & + coil_current_vec, coil_tmp_vector + integer :: i, j, k + logical, save :: first = .true. + + do i = 1, 2*m + theta = pi*real(i,longreal)/real(m,longreal) + c_vector(1) = r_coil * cos(theta) + c_vector(2) = r_coil * sin(theta) + coil_tmp_vector(1) = -sin(theta) + coil_tmp_vector(2) = cos(theta) + coil_tmp_vector(3) = 0.0_longreal + coil_current_vec(1) = dot_product(rotate_coil(1,:),coil_tmp_vector(:)) + coil_current_vec(2) = dot_product(rotate_coil(2,:),coil_tmp_vector(:)) + coil_current_vec(3) = dot_product(rotate_coil(3,:),coil_tmp_vector(:)) + do j = 1, 9 + c_vector(3) = 0.5 * h_coil * z1gauss(j) + rot_c_vector(1) = dot_product(rotate_coil(1,:),c_vector(:)) + dx + rot_c_vector(2) = dot_product(rotate_coil(2,:),c_vector(:)) + dy + rot_c_vector(3) = dot_product(rotate_coil(3,:),c_vector(:)) + dz + do k = 1, 9 + q_vector(1) = 0.5_longreal * a * (x2gauss(k) + 1.0_longreal) + q_vector(2) = 0.5_longreal * b1 * (y2gauss(k) - 1.0_longreal) + q_vector(3) = 0.0_longreal + rot_q_vector(1) = dot_product(rotate_quad(1,:),q_vector(:)) + rot_q_vector(2) = dot_product(rotate_quad(2,:),q_vector(:)) + rot_q_vector(3) = dot_product(rotate_quad(3,:),q_vector(:)) + numerator = w1gauss(j) * w2gauss(k) * & + dot_product(coil_current_vec,current_vector) + denominator = sqrt(dot_product(rot_c_vector-rot_q_vector, & + rot_c_vector-rot_q_vector)) + l12_lower = l12_lower + numerator/denominator + end do + end do + end do + l12 = coefficient * (b1 * l12_lower + b2 * l12_upper) + end subroutine mutual_ind_quad_cir_coil + +end module mqc_m +! { dg-final { cleanup-modules "mqc_m" } } + diff --git a/gcc/testsuite/gfortran.dg/graphite/pr41924.f90 b/gcc/testsuite/gfortran.dg/graphite/pr41924.f90 new file mode 100644 index 000000000..2f248d0b8 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/graphite/pr41924.f90 @@ -0,0 +1,16 @@ +! { dg-options "-O2 -fgraphite-identity " } + +MODULE MAIN1 + REAL , ALLOCATABLE :: HRVALD(:) +END MODULE MAIN1 + +SUBROUTINE VOLCALC() + USE MAIN1 + INTEGER :: ITYP + LOGICAL :: WETSCIM + + DO ITYP = 1 , 100 + IF ( WETSCIM ) HRVALD(ITYP) = 0.0 + ENDDO +END SUBROUTINE VOLCALC +! { dg-final { cleanup-modules "main1" } } diff --git a/gcc/testsuite/gfortran.dg/graphite/pr42050.f90 b/gcc/testsuite/gfortran.dg/graphite/pr42050.f90 new file mode 100644 index 000000000..e01991741 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/graphite/pr42050.f90 @@ -0,0 +1,26 @@ +! { dg-options "-O2 -fgraphite-identity " } + +MODULE qs_ks_methods + INTEGER, PARAMETER :: sic_list_all=1 + TYPE dft_control_type + INTEGER :: sic_list_id + END TYPE +CONTAINS + SUBROUTINE sic_explicit_orbitals( ) + TYPE(dft_control_type), POINTER :: dft_control + INTEGER, ALLOCATABLE, DIMENSION(:, :) :: sic_orbital_list + INTEGER, DIMENSION(:), & + POINTER :: mo_derivs + SELECT CASE(dft_control%sic_list_id) + CASE(sic_list_all) + DO i=1,k_alpha + IF (SIZE(mo_derivs,1)==1) THEN + ELSE + sic_orbital_list(3,iorb)=2 + ENDIF + ENDDO + END SELECT + CALL test() + END SUBROUTINE sic_explicit_orbitals +END MODULE qs_ks_methods +! { dg-final { cleanup-modules "qs_ks_methods" } } diff --git a/gcc/testsuite/gfortran.dg/graphite/pr42180.f90 b/gcc/testsuite/gfortran.dg/graphite/pr42180.f90 new file mode 100644 index 000000000..bb5bc0c58 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/graphite/pr42180.f90 @@ -0,0 +1,23 @@ +! { dg-options "-ffast-math -O2 -fgraphite-identity" } + +module mcc_m + integer, parameter, private :: longreal = selected_real_kind(15,90) +contains + subroutine mutual_ind_cir_cir_coils (m, l12) + real (kind = longreal), intent(out) :: l12 + real (kind = longreal), dimension(1:9), save :: zw + gauss:do i = 1, 9 + theta_l12 = 0.0_longreal + theta1: do n1 = 1, 2*m + theta_1 = pi*real(n1,longreal)/real(m,longreal) + theta2: do n2 = 1, 2*m + numerator = -sin(theta_1)*tvx + cos(theta_1)*tvy + theta_l12 = theta_l12 + numerator/denominator + end do theta2 + end do theta1 + l12 = l12 + zw(i)*theta_l12 + end do gauss + l12 = coefficient * l12 + end subroutine mutual_ind_cir_cir_coils +end module mcc_m +! { dg-final { cleanup-modules "mcc_m" } } diff --git a/gcc/testsuite/gfortran.dg/graphite/pr42181.f90 b/gcc/testsuite/gfortran.dg/graphite/pr42181.f90 new file mode 100644 index 000000000..06ce47d9e --- /dev/null +++ b/gcc/testsuite/gfortran.dg/graphite/pr42181.f90 @@ -0,0 +1,20 @@ +! { dg-options "-O1 -fgraphite" } + +MODULE powell + INTEGER, PARAMETER :: dp=8 +CONTAINS + SUBROUTINE newuob (n,npt,x,rhobeg,rhoend,maxfun,xbase,& + xopt,xnew,xpt,fval,gq,hq,pq,bmat,zmat,ndim,d,vlag,w,opt) + REAL(dp), DIMENSION(npt, *), & + INTENT(inout) :: xpt + REAL(dp), DIMENSION(*), INTENT(inout) :: fval, gq, hq, pq +120 IF (dsq <= 1.0e-3_dp*xoptsq) THEN + DO k=1,npt + DO i=1,n + gq(i)=gq(i)+temp*xpt(k,i) + END DO + END DO + END IF + END SUBROUTINE newuob +END MODULE powell +! { dg-final { cleanup-modules "powell" } } diff --git a/gcc/testsuite/gfortran.dg/graphite/pr42185.f90 b/gcc/testsuite/gfortran.dg/graphite/pr42185.f90 new file mode 100644 index 000000000..6fa6e3036 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/graphite/pr42185.f90 @@ -0,0 +1,28 @@ +! { dg-do compile } +! { dg-options "-fgraphite -O -ffast-math" } + +MODULE powell + INTEGER, PARAMETER :: dp=8 +CONTAINS + SUBROUTINE trsapp (n,npt,xopt,xpt,gq,hq,pq,delta,step,d,g,hd,hs,crvmin) + REAL(dp), DIMENSION(*), INTENT(INOUT) :: step, d, g, hd, hs + LOGICAL :: jump1, jump2 + REAL(dp) :: alpha, angle, angtest, bstep, cf, cth, dd, delsq, dg, dhd, & + reduc, sg, sgk, shs, ss, sth, temp, tempa, tempb + DO i=1,n + dd=dd+d(i)**2 + END DO + mainloop : DO + IF ( .NOT. jump2 ) THEN + IF ( .NOT. jump1 ) THEN + bstep=temp/(ds+SQRT(ds*ds+dd*temp)) + IF (alpha < bstep) THEN + IF (ss < delsq) CYCLE mainloop + END IF + IF (gg <= 1.0e-4_dp*ggbeg) EXIT mainloop + END IF + END IF + END DO mainloop + END SUBROUTINE trsapp +END MODULE powell +! { dg-final { cleanup-modules "powell" } } diff --git a/gcc/testsuite/gfortran.dg/graphite/pr42186.f90 b/gcc/testsuite/gfortran.dg/graphite/pr42186.f90 new file mode 100644 index 000000000..0e3669bf5 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/graphite/pr42186.f90 @@ -0,0 +1,15 @@ +! { dg-options "-fgraphite-identity -g -O3 -ffast-math" } +MODULE erf_fn +CONTAINS + SUBROUTINE CALERF(ARG,RESULT,JINT) + DIMENSION A(5),B(4),C(9),D(8),P(6),Q(5) + IF (Y <= THRESH) THEN + DO I = 1, 3 + XNUM = (XNUM + A(I)) * YSQ + XDEN = (XDEN + B(I)) * YSQ + END DO + RESULT = X * (XNUM + A(4)) / (XDEN + B(4)) + END IF + END SUBROUTINE CALERF +END MODULE erf_fn +! { dg-final { cleanup-modules "erf_fn" } } diff --git a/gcc/testsuite/gfortran.dg/graphite/pr42285.f90 b/gcc/testsuite/gfortran.dg/graphite/pr42285.f90 new file mode 100644 index 000000000..d496d3724 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/graphite/pr42285.f90 @@ -0,0 +1,24 @@ +! { dg-options "-O2 -floop-interchange" } + +SUBROUTINE EFGRDM(NCF,NFRG,G,RTRMS,GM,IOPT,K1) + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + DIMENSION G(*),RTRMS(*),GM(*) + + DUM = 0 + DO I=1,NFRG + DO J=1,3 + IF (IOPT.EQ.0) THEN + GM(K1)=G(K1) + END IF + END DO + DO J=1,3 + JDX=NCF*9+IOPT*9*NFRG + DO M=1,3 + DUM=DUM+RTRMS(JDX+M) + END DO + GM(K1)=DUM + END DO + END DO + RETURN +END SUBROUTINE EFGRDM + diff --git a/gcc/testsuite/gfortran.dg/graphite/pr42326-1.f90 b/gcc/testsuite/gfortran.dg/graphite/pr42326-1.f90 new file mode 100644 index 000000000..8c9d110b2 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/graphite/pr42326-1.f90 @@ -0,0 +1,19 @@ +! { dg-do compile { target i?86-*-* x86_64-*-* } } +! { dg-require-effective-target ilp32 } +! { dg-require-effective-target sse2 } +! { dg-options "-O2 -floop-parallelize-all -fprefetch-loop-arrays -msse2" } + +subroutine phasad(t,i,ium) + implicit none + real t(5,4) + integer i,l,ll,ium + + do l=1,2 + ll=2*l + do i=1,ium + t(i,ll-1)=t(i,ll-1)+t(i,ll) + enddo + enddo + return +end subroutine phasad + diff --git a/gcc/testsuite/gfortran.dg/graphite/pr42326.f90 b/gcc/testsuite/gfortran.dg/graphite/pr42326.f90 new file mode 100644 index 000000000..06ef2b706 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/graphite/pr42326.f90 @@ -0,0 +1,36 @@ +! { dg-do compile { target i?86-*-* x86_64-*-* } } +! { dg-require-effective-target ilp32 } +! { dg-require-effective-target sse2 } +! { dg-options "-O2 -floop-strip-mine -fprefetch-loop-arrays -msse2" } + +subroutine blts ( ldmx, ldmy, v, tmp1, i, j, k) + implicit none + integer ldmx, ldmy, i, j, k, ip, m, l + real*8 tmp, tmp1, v( 5, ldmx, ldmy, *), tmat(5,5) + + do ip = 1, 4 + do m = ip+1, 5 + tmp = tmp1 * tmat( m, ip ) + do l = ip+1, 5 + tmat( m, l ) = tmat( m, l ) - tmat( ip, l ) + end do + v( m, i, j, k ) = tmp + end do + end do + return +end subroutine blts + +subroutine phasad(t,i,ium) + implicit none + real t(5,4) + integer i,l,ll,ium + + do l=1,2 + ll=2*l + do i=1,ium + t(i,ll-1)=t(i,ll-1)+t(i,ll) + enddo + enddo + return +end subroutine phasad + diff --git a/gcc/testsuite/gfortran.dg/graphite/pr42334-1.f b/gcc/testsuite/gfortran.dg/graphite/pr42334-1.f new file mode 100644 index 000000000..2503dc3e8 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/graphite/pr42334-1.f @@ -0,0 +1,16 @@ +! { dg-options "-O2 -floop-interchange" } + + subroutine linel(icmdl,stre,anisox) + real*8 stre(6),tkl(3,3),ekl(3,3),anisox(3,3,3,3) + do m1=1,3 + do m2=1,m1 + do m3=1,3 + do m4=1,3 + tkl(m1,m2)=tkl(m1,m2)+ + & anisox(m1,m2,m3,m4)*ekl(m3,m4) + enddo + enddo + enddo + enddo + stre(1)=tkl(1,1) + end diff --git a/gcc/testsuite/gfortran.dg/graphite/pr42334.f90 b/gcc/testsuite/gfortran.dg/graphite/pr42334.f90 new file mode 100644 index 000000000..4080c9f2a --- /dev/null +++ b/gcc/testsuite/gfortran.dg/graphite/pr42334.f90 @@ -0,0 +1,20 @@ +! { dg-options "-O2 -floop-interchange -ftree-loop-distribution" } + +subroutine blockdis(bl1eg,bl2eg) + implicit real*8 (a-h,o-z) + parameter(nblo=300) + common/str /mblo + common/str2 /mel(nblo) + dimension h(nblo,2,6),g(nblo,2,6) + dimension bl1eg(nblo,2,6),bl2eg(nblo,2,6) + do k=1,mblo + jm=mel(k) + do l=1,2 + do m=1,6 + bl1eg(k,l,m)=h(jm,l,m) + bl2eg(k,l,m)=g(jm,l,m) + enddo + enddo + enddo + return +end subroutine blockdis diff --git a/gcc/testsuite/gfortran.dg/graphite/pr42393-1.f90 b/gcc/testsuite/gfortran.dg/graphite/pr42393-1.f90 new file mode 100644 index 000000000..45c635b76 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/graphite/pr42393-1.f90 @@ -0,0 +1,25 @@ +! { dg-options "-O2 -fgraphite-identity -fno-loop-block -fno-loop-interchange -fno-loop-strip-mine" } + +MODULE beta_gamma_psi + INTEGER, PARAMETER :: dp=KIND(0.0D0) +CONTAINS + FUNCTION basym () RESULT(fn_val) + REAL(dp) :: b0(21), bsum, d(21) + DO n = 2, num, 2 + DO i = n, np1 + b0(1) = 1 + DO m = 2, i + mm1 = m - 1 + DO j = 1, mm1 + bsum = bsum + b0(j) + END DO + b0(m) = bsum + END DO + d(i) = -b0(i) + END DO + sum = sum + d(n) + END DO + fn_val = sum + END FUNCTION basym +END MODULE beta_gamma_psi +! { dg-final { cleanup-modules "beta_gamma_psi" } } diff --git a/gcc/testsuite/gfortran.dg/graphite/pr42393.f90 b/gcc/testsuite/gfortran.dg/graphite/pr42393.f90 new file mode 100644 index 000000000..da9a348dd --- /dev/null +++ b/gcc/testsuite/gfortran.dg/graphite/pr42393.f90 @@ -0,0 +1,31 @@ +! { dg-options "-O2 -fgraphite-identity -fno-loop-block -fno-loop-interchange -fno-loop-strip-mine" } + +MODULE beta_gamma_psi + INTEGER, PARAMETER :: dp=KIND(0.0D0) +CONTAINS + FUNCTION basym (a, b, lambda, eps) RESULT(fn_val) + REAL(dp) :: a0(21), b0(21), bsum, c(21), d(21), dsum, & + j0, j1, r, r0, r1, s, sum, t, t0, t1, & + u, w, w0, z, z0, z2, zn, znm1 + DO n = 2, num, 2 + DO i = n, np1 + b0(1) = r*a0(1) + DO m = 2, i + bsum = 0.0e0_dp + mm1 = m - 1 + DO j = 1, mm1 + mmj = m - j + bsum = bsum + (j*r - mmj)*a0(j)*b0(mmj) + END DO + b0(m) = r*a0(m) + bsum/m + END DO + c(i) = b0(i)/(i + 1.0e0_dp) + d(i) = -(dsum + c(i)) + END DO + t0 = d(n)*w*j0 + sum = sum + (t0 + t1) + END DO + fn_val = e0*t*u*sum + END FUNCTION basym +END MODULE beta_gamma_psi +! { dg-final { cleanup-modules "beta_gamma_psi" } } diff --git a/gcc/testsuite/gfortran.dg/graphite/pr42732.f b/gcc/testsuite/gfortran.dg/graphite/pr42732.f new file mode 100644 index 000000000..95c115076 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/graphite/pr42732.f @@ -0,0 +1,23 @@ +! { dg-options "-O2 -fgraphite-identity" } + + parameter(in = 128+5 + & , jn = 128+5 + & , kn = 128+5) + real*8 d (in,jn,kn) + real*8 dcopy(in,jn,kn) + call pdv (is, dcopy) + do k=ks,ke + do j=je+1,je+2 + do i=is-2,ie+2 + dcopy(i,j,k) = d(i,j,k) + enddo + enddo + enddo + do k=ks,ke + do j=js,je + do i=is-2,is-1 + dcopy(i,j,k) = d(i,j,k) + enddo + enddo + enddo + end diff --git a/gcc/testsuite/gfortran.dg/graphite/pr43097.f b/gcc/testsuite/gfortran.dg/graphite/pr43097.f new file mode 100644 index 000000000..4ddeed8ae --- /dev/null +++ b/gcc/testsuite/gfortran.dg/graphite/pr43097.f @@ -0,0 +1,25 @@ +! { dg-options "-O2 -fgraphite-identity" } + + subroutine foo (ldmx,ldmy,nx,ny,v) + implicit real*8 (a-h, o-z) + dimension v(5,ldmx,ldmy,*) + dimension tmat(5,5) + + k = 2 + do j = 2, ny-1 + do i = 2, nx-1 + do ip = 1, 4 + do m = ip+1, 5 + v(m,i,j,k) = v(m,i,j,k) * m + end do + end do + do m = 5, 1, -1 + do l = m+1, 5 + v(m,i,j,k) = v(l,i,j,k) + end do + v(m,i,j,k) = m + end do + end do + end do + return + end diff --git a/gcc/testsuite/gfortran.dg/graphite/pr43349.f b/gcc/testsuite/gfortran.dg/graphite/pr43349.f new file mode 100644 index 000000000..86e408f9b --- /dev/null +++ b/gcc/testsuite/gfortran.dg/graphite/pr43349.f @@ -0,0 +1,35 @@ +! { dg-options "-O2 -floop-interchange" } + + SUBROUTINE BUG(A,B,X,Y,Z,N) + IMPLICIT NONE + DOUBLE PRECISION A(*),B(*),X(*),Y(*),Z(*) + INTEGER N,J,K + K = 0 + DO J = 1,N + K = K+1 + X(K) = B(J+N*7) + Y(K) = B(J+N*8) + Z(K) = B(J+N*2) + A(J+N*2) + K = K+1 + X(K) = B(J+N*3) + A(J+N*3) + Y(K) = B(J+N*9) + A(J) + Z(K) = B(J+N*15) + K = K+1 + X(K) = B(J+N*4) + A(J+N*4) + Y(K) = B(J+N*15) + Z(K) = B(J+N*10) + A(J) + K = K+1 + X(K) = B(J+N*11) + A(J+N) + Y(K) = B(J+N*5) + A(J+N*5) + Z(K) = B(J+N*16) + K = K+1 + X(K) = B(J+N*16) + Y(K) = B(J+N*6) + A(J+N*6) + Z(K) = B(J+N*12) + A(J+N) + K = K+1 + X(K) = B(J+N*13) + A(J+N*2) + Y(K) = B(J+N*17) + Z(K) = B(J+N*7) + A(J+N*7) + ENDDO + RETURN + END diff --git a/gcc/testsuite/gfortran.dg/graphite/pr45758.f90 b/gcc/testsuite/gfortran.dg/graphite/pr45758.f90 new file mode 100644 index 000000000..b0e0a3d2c --- /dev/null +++ b/gcc/testsuite/gfortran.dg/graphite/pr45758.f90 @@ -0,0 +1,41 @@ +! { dg-options "-O3 -floop-block" } + +MODULE util + INTEGER, PARAMETER :: int_4=4 + INTERFACE sort + MODULE PROCEDURE sort_int_4v + END INTERFACE +CONTAINS + SUBROUTINE sort_int_4v ( arr, n, index ) + INTEGER(KIND=int_4), INTENT(INOUT) :: arr(1:n) + INTEGER, INTENT(OUT) :: INDEX(1:n) + DO i = 1, n + INDEX(i) = i + END DO +1 IF (ir-l<m) THEN + DO j = l + 1, ir + DO i = j - 1, 1, -1 + IF (arr(i)<=a) GO TO 2 + arr(i+1) = arr(i) + INDEX(i+1) = INDEX(i) + END DO +2 arr(i+1) = a + END DO + END IF + END SUBROUTINE sort_int_4v + SUBROUTINE create_destination_list(list) + INTEGER, DIMENSION(:, :, :), POINTER :: list + INTEGER :: icpu, ncpu, stat, ultimate_max + INTEGER, ALLOCATABLE, DIMENSION(:) :: index, sublist + ultimate_max=7 + ALLOCATE(INDEX(ultimate_max),STAT=stat) + CALL t(stat==0) + ALLOCATE(sublist(ultimate_max),STAT=stat) + DO icpu=0,ncpu-1 + CALL sort(sublist,ultimate_max,index) + list(1,:,icpu)=sublist + list(2,:,icpu)=0 + ENDDO + END SUBROUTINE create_destination_list +END MODULE + diff --git a/gcc/testsuite/gfortran.dg/graphite/pr47019.f b/gcc/testsuite/gfortran.dg/graphite/pr47019.f new file mode 100644 index 000000000..69067e9c5 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/graphite/pr47019.f @@ -0,0 +1,12 @@ +! { dg-options "-O -ftree-pre -fgraphite-identity -fno-tree-copy-prop" } + + subroutine foo (ldmx,ldmy,v) + integer :: ldmx, ldmy, v, l, m + dimension v(5,ldmx,ldmy) + do m = 5, 1, -1 + do l = m+1, 5 + v(m,3,2) = v(1,3,2) + end do + v(m,3,2) = m + end do + end diff --git a/gcc/testsuite/gfortran.dg/graphite/run-id-1.f b/gcc/testsuite/gfortran.dg/graphite/run-id-1.f new file mode 100644 index 000000000..521d268f3 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/graphite/run-id-1.f @@ -0,0 +1,47 @@ + subroutine mul66(rt,rtt,r) + real*8 rt(6,6),r(6,6),rtt(6,6) + do i=1,6 + do j=1,6 + do ia=1,6 + rtt(i,ia)=rt(i,j)*r(j,ia)+rtt(i,ia) + end do + end do + end do + end + + program test + real*8 xj(6,6),w(6,6),w1(6,6) + parameter(idump=0) + integer i,j + + do i=1,6 + do j=1,6 + xj(i,j) = 0.0d0 + w1(i,j) = 0.0d0 + w(i,j) = i * 10.0d0 + j; + end do + end do + + xj(1,2) = 1.0d0 + xj(2,1) = -1.0d0 + xj(3,4) = 1.0d0 + xj(4,3) = -1.0d0 + xj(5,6) = 1.0d0 + xj(6,5) = -1.0d0 + + call mul66(xj,w1,w) + + if (idump.ne.0) then + write(6,*) 'w1 after call to mul66' + do i = 1,6 + do j = 1,6 + write(6,'(D15.7)') w1(i,j) + end do + end do + end if + + if (w1(1,1).ne.21.0d0) then + call abort() + end if + + end diff --git a/gcc/testsuite/gfortran.dg/graphite/run-id-2.f90 b/gcc/testsuite/gfortran.dg/graphite/run-id-2.f90 new file mode 100644 index 000000000..c4fa1d061 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/graphite/run-id-2.f90 @@ -0,0 +1,66 @@ + IMPLICIT NONE + INTEGER, PARAMETER :: dp=KIND(0.0D0) + REAL(KIND=dp) :: res + + res=exp_radius_very_extended( 0 , 1 , 0 , 1, & + (/0.0D0,0.0D0,0.0D0/),& + (/1.0D0,0.0D0,0.0D0/),& + (/1.0D0,0.0D0,0.0D0/),& + 1.0D0,1.0D0,1.0D0,1.0D0) + if (res.ne.1.0d0) call abort() + +CONTAINS + + FUNCTION exp_radius_very_extended(la_min,la_max,lb_min,lb_max,ra,rb,rp,& + zetp,eps,prefactor,cutoff) RESULT(radius) + + INTEGER, INTENT(IN) :: la_min, la_max, lb_min, lb_max + REAL(KIND=dp), INTENT(IN) :: ra(3), rb(3), rp(3), zetp, & + eps, prefactor, cutoff + REAL(KIND=dp) :: radius + + INTEGER :: i, ico, j, jco, la(3), lb(3), & + lxa, lxb, lya, lyb, lza, lzb + REAL(KIND=dp) :: bini, binj, coef(0:20), & + epsin_local, polycoef(0:60), & + prefactor_local, rad_a, & + rad_b, s1, s2 + + epsin_local=1.0E-2_dp + + prefactor_local=prefactor*MAX(1.0_dp,cutoff) + rad_a=SQRT(SUM((ra-rp)**2)) + rad_b=SQRT(SUM((rb-rp)**2)) + + polycoef(0:la_max+lb_max)=0.0_dp + DO lxa=0,la_max + DO lxb=0,lb_max + coef(0:la_max+lb_max)=0.0_dp + bini=1.0_dp + s1=1.0_dp + DO i=0,lxa + binj=1.0_dp + s2=1.0_dp + DO j=0,lxb + coef(lxa+lxb-i-j)=coef(lxa+lxb-i-j) + bini*binj*s1*s2 + binj=(binj*(lxb-j))/(j+1) + s2=s2*(rad_b) + ENDDO + bini=(bini*(lxa-i))/(i+1) + s1=s1*(rad_a) + ENDDO + DO i=0,lxa+lxb + polycoef(i)=MAX(polycoef(i),coef(i)) + ENDDO + ENDDO + ENDDO + + polycoef(0:la_max+lb_max)=polycoef(0:la_max+lb_max)*prefactor_local + radius=0.0_dp + DO i=0,la_max+lb_max + radius=MAX(radius,polycoef(i)**(i+1)) + ENDDO + + END FUNCTION exp_radius_very_extended + +END diff --git a/gcc/testsuite/gfortran.dg/graphite/scop-1.f b/gcc/testsuite/gfortran.dg/graphite/scop-1.f new file mode 100644 index 000000000..5bd463c4e --- /dev/null +++ b/gcc/testsuite/gfortran.dg/graphite/scop-1.f @@ -0,0 +1,13 @@ + dimension p1(2),t(6,4),b1(2),b2(2),al1(2),al2(2),g1(2),g2(2) + save + if(nlin.eq.0) then + do 20 l=1,2 + ll=2*l + b2(l)=t(6-ll,ll-1)*t(6-ll,ll-1)+t(7-ll,ll-1)*t(7-ll,ll-1) + write(*,*) b2(l) + 20 continue + endif + end + +! { dg-final { scan-tree-dump-times "number of SCoPs: 1" 1 "graphite" { xfail *-*-* } } } +! { dg-final { cleanup-tree-dump "graphite" } } diff --git a/gcc/testsuite/gfortran.dg/graphite/vect-pr40979.f90 b/gcc/testsuite/gfortran.dg/graphite/vect-pr40979.f90 new file mode 100644 index 000000000..662b82a12 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/graphite/vect-pr40979.f90 @@ -0,0 +1,26 @@ +! { dg-do compile } +! { dg-require-effective-target vect_double } + +module mqc_m +integer, parameter, private :: longreal = selected_real_kind(15,90) +contains + subroutine mutual_ind_quad_cir_coil (m, l12) + real (kind = longreal), dimension(9), save :: w2gauss, w1gauss + real (kind = longreal) :: l12_lower, num, l12 + real (kind = longreal), dimension(3) :: current, coil + w2gauss(1) = 16.0_longreal/81.0_longreal + w1gauss(5) = 0.3302393550_longreal + do i = 1, 2*m + do j = 1, 9 + do k = 1, 9 + num = w1gauss(j) * w2gauss(k) * dot_product(coil,current) + l12_lower = l12_lower + num + end do + end do + end do + l12 = l12_lower + end subroutine mutual_ind_quad_cir_coil +end module mqc_m + +! { dg-final { scan-tree-dump-times "vectorized 1 loops" 1 "vect" } } +! { dg-final { cleanup-tree-dump "vect" } } |