--- /dev/null
+# Expect driver script for GCC Regression Tests
+# Copyright (C) 1993, 1995, 1997 Free Software Foundation
+#
+# This file 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 2 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 this program; if not, write to the Free Software
+# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+# These tests come from Torbjorn Granlund's (tege@cygnus.com)
+# F torture test suite, and other contributors.
+
+if $tracelevel then {
+ strace $tracelevel
+}
+
+# load support procs
+load_lib f-torture.exp
+
+foreach testcase [glob -nocomplain $srcdir/$subdir/*.f] {
+ # If we're only testing specific files and this isn't one of them, skip it.
+ if ![runtest_file_p $runtests $testcase] then {
+ continue
+ }
+
+ f-torture $testcase
+}
+
+foreach testcase [glob -nocomplain $srcdir/$subdir/*.F] {
+ # If we're only testing specific files and this isn't one of them, skip it.
+ if ![runtest_file_p $runtests $testcase] then {
+ continue
+ }
+
+ f-torture $testcase
+}
--- /dev/null
+ SUBROUTINE AAP(NOOT)
+ DIMENSION NOOT(*)
+ END
--- /dev/null
+ REAL*8 A,B,C
+ REAL*4 RARRAY(19)/19*(-1)/
+ INTEGER BOTTOM,RIGHT
+ INTEGER IARRAY(19)/0,0,0,0,0,0,0,0,0,0,0,0,13,14,0,0,0,0,0/
+ EQUIVALENCE (RARRAY(13),BOTTOM),(RARRAY(14),RIGHT)
+C
+ IF(I.NE.0) call exit(1)
+C gcc: Internal compiler error: program f771 got fatal signal 11
+C at this point!
+ END
--- /dev/null
+ IMPLICIT REAL*8 (A-H,O-Z)
+ COMMON /C/ A(9), INT
+ DATA A /
+ 1 0.49999973986348730D01, 0.40000399113084100D01,
+ 2 0.29996921166596490D01, 0.20016917082678680D01,
+ 3 0.99126390351864390D00, 0.97963256554443300D-01,
+ 4 -0.87360964813570100D-02, 0.16917082678692080D-02,
+ 5 -0.26013651283774820D-05 /
+ END
--- /dev/null
+ program cabs_1
+ complex z0
+ real r0
+ complex*16 z1
+ real*8 r1
+
+ z0 = cmplx(3.,4.)
+ r0 = cabs(z0)
+ if (r0 .ne. 5.) call exit(1)
+
+ z1 = dcmplx(3.d0,4.d0)
+ r1 = zabs(z1)
+ if (r1 .ne. 5.d0) call exit(1)
+ end
--- /dev/null
+ PROGRAM TEST
+ REAL AB(3)
+ do i=1,3
+ AB(i)=i
+ enddo
+ k=1
+ n=2
+ ind=k-n+2
+ if (ind /= 1) call exit(1)
+ if (ab(ind) /= 1) call exit(1)
+ if (k-n+2 /= 1) call exit(1)
+ if (ab(k-n+2) /= 1) call exit(1)
+ END
--- /dev/null
+ program complex_1
+ complex z0, z1, z2
+
+ z0 = cmplx(0.,.5)
+ z1 = 1./z0
+ if (z1 .ne. cmplx(0.,-2)) call exit(1)
+
+ z0 = 10.*z0
+ if (z0 .ne. cmplx(0.,5.)) call exit(1)
+
+ z2 = cmplx(1.,2.)
+ z1 = z0/z2
+ if (z1 .ne. cmplx(2.,1.)) call exit(1)
+
+ z1 = z0*z2
+ if (z1 .ne. cmplx(-10.,5.)) call exit(1)
+ end
+
--- /dev/null
+! Some versions of cpp will delete "//'World' as a C++ comment.
+ character*40 title
+ title = 'Hello '//'World'
+ if (title .ne. 'Hello World') stop 1
+ end
--- /dev/null
+ program foo
+ complex*16 z0, z1, z2
+
+ z0 = dcmplx(0.,.5)
+ z1 = 1./z0
+ if (z1 .ne. dcmplx(0.,-2)) call exit(1)
+
+ z0 = 10.*z0
+ if (z0 .ne. dcmplx(0.,5.)) call exit(1)
+
+ z2 = cmplx(1.,2.)
+ z1 = z0/z2
+ if (z1 .ne. dcmplx(2.,1.)) call exit(1)
+
+ z1 = z0*z2
+ if (z1 .ne. dcmplx(-10.,5.)) call exit(1)
+ end
+
--- /dev/null
+c============================================== test.f
+ real x, y
+ real*8 x1, y1
+ x=0.
+ y = erfc(x)
+ if (y .ne. 1.) call exit(1)
+
+ x=1.1
+ y = erfc(x)
+ if (abs(y - .1197949) .ge. 1.e-6) call exit(1)
+
+ x=10
+ y = erfc(x)
+ if (y .gt. 1.5e-44) call exit(1)
+
+ x1=0.
+ y1 = erfc(x1)
+ if (y1 .ne. 1.) call exit(1)
+
+ x1=1.1d0
+ y1 = erfc(x1)
+ if (abs(y1 - .1197949d0) .ge. 1.d-6) call exit(1)
+
+ x1=10
+ y1 = erfc(x1)
+ if (y1 .gt. 1.5d-44) call exit(1)
+ end
+c=================================================
+!output:
+! 0. 1.875
+! 1.10000002 1.48958981
+! 10. 5.00220949E-06
+!
+!The values should be:
+!erfc(0)=1
+!erfc(1.1)= 0.1197949
+!erfc(10)<1.543115467311259E-044
--- /dev/null
+# Copyright (C) 1991, 1992, 1993, 1995, 1997 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 2 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 this program; if not, write to the Free Software
+# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+# Please email any bugs, comments, and/or additions to this file to:
+# bug-g77@prep.ai.mit.edu
+
+# This file was written by Rob Savoye. (rob@cygnus.com)
+# Modified and maintained by Jeffrey Wheat (cassidy@cygnus.com)
+
+#
+# These tests come from Torbjorn Granlund (tege@cygnus.com)
+# Fortran torture test suite.
+#
+
+if $tracelevel then {
+ strace $tracelevel
+}
+
+# load support procs
+load_lib f-torture.exp
+
+#
+# main test loop
+#
+
+foreach src [lsort [glob -nocomplain $srcdir/$subdir/*.f]] {
+ # If we're only testing specific files and this isn't one of them, skip it.
+ if ![runtest_file_p $runtests $src] then {
+ continue
+ }
+
+ f-torture-execute $src
+}
+
+foreach src [lsort [glob -nocomplain $srcdir/$subdir/*.F]] {
+ # If we're only testing specific files and this isn't one of them, skip it.
+ if ![runtest_file_p $runtests $src] then {
+ continue
+ }
+
+ f-torture-execute $src
+}
--- /dev/null
+ a = 2**-2*1.
+ if (a .ne. .25) call exit(1)
+ end
--- /dev/null
+ parameter (nmax=165000)
+ double precision x(nmax)
+ end
--- /dev/null
+ program fool
+
+ real foo
+ integer n
+ logical t
+
+ foo = 2.5
+ n = 5
+
+ t = (n > foo)
+ if (t .neqv. .true.) call exit(1)
+ t = (n >= foo)
+ if (t .neqv. .true.) call exit(1)
+ t = (n < foo)
+ if (t .neqv. .false.) call exit(1)
+ t = (n <= 5)
+ if (t .neqv. .true.) call exit(1)
+ t = (n >= 5 )
+ if (t .neqv. .true.) call exit(1)
+ t = (n == 5)
+ if (t .neqv. .true.) call exit(1)
+ t = (n /= 5)
+ if (t .neqv. .false.) call exit(1)
+ t = (n /= foo)
+ if (t .neqv. .true.) call exit(1)
+ t = (n == foo)
+ if (t .neqv. .false.) call exit(1)
+
+ end
--- /dev/null
+ program short
+
+ parameter ( N=2 )
+ common /chb/ pi,sig(0:N)
+ common /parm/ h(2,2)
+
+c initialize some variables
+ h(2,2) = 1117
+ h(2,1) = 1178
+ h(1,2) = 1568
+ h(1,1) = 1621
+ sig(0) = -1.
+ sig(1) = 0.
+ sig(2) = 1.
+
+ call printout
+ stop
+ end
+
+c ******************************************************************
+
+ subroutine printout
+ parameter ( N=2 )
+ common /chb/ pi,sig(0:N)
+ common /parm/ h(2,2)
+ dimension yzin1(0:N), yzin2(0:N)
+
+c function subprograms
+ z(i,j,k) = 0.5*h(i,j)*(sig(k)-1.)
+
+c a four-way average of rhobar
+ do 260 k=0,N
+ yzin1(k) = 0.25 *
+ & ( z(2,2,k) + z(1,2,k) +
+ & z(2,1,k) + z(1,1,k) )
+ 260 continue
+
+c another four-way average of rhobar
+ do 270 k=0,N
+ rtmp1 = z(2,2,k)
+ rtmp2 = z(1,2,k)
+ rtmp3 = z(2,1,k)
+ rtmp4 = z(1,1,k)
+ yzin2(k) = 0.25 *
+ & ( rtmp1 + rtmp2 + rtmp3 + rtmp4 )
+ 270 continue
+
+ do k=0,N
+ if (yzin1(k) .ne. yzin2(k)) call exit(1)
+ enddo
+ if (yzin1(0) .ne. -1371.) call exit(1)
+ if (yzin1(1) .ne. -685.5) call exit(1)
+ if (yzin1(2) .ne. 0.) call exit(1)
+
+ return
+ end
+
projects / gcc.git / commitdiff