980310-1.f, [...]: New tests from egcs-bugs archives.
* g77.f-torture/compile/980310-1.f, g77.f-torture/compile/980310-2.f g77.f-torture/compile/980310-3.f, g77.f-torture/compile/980310-4.f g77.f-torture/compile/980310-6.f, g77.f-torture/compile/980310-7.f g77.f-torture/compile/980310-8.f: New tests from egcs-bugs archives. * g77.f-torture/execute/980310-5.f: New test from egcs-bugs archives. From-SVN: r18466
This commit is contained in:
parent
af9c2d8a25
commit
e1834b5a6f
9 changed files with 853 additions and 0 deletions
|
@ -1,3 +1,10 @@
|
|||
Wed Mar 11 00:03:49 1998 Robert Lipe <robertl@dgii.com>
|
||||
|
||||
* g77.f-torture/compile/980310-1.f, g77.f-torture/compile/980310-2.f
|
||||
g77.f-torture/compile/980310-3.f, g77.f-torture/compile/980310-4.f
|
||||
g77.f-torture/compile/980310-6.f, g77.f-torture/compile/980310-7.f
|
||||
g77.f-torture/compile/980310-8.f: New tests from egcs-bugs archives.
|
||||
* g77.f-torture/execute/980310-5.f: New test from egcs-bugs archives.
|
||||
|
||||
Tue Mar 10 00:31:51 1998 Alexandre Oliva <oliva@dcc.unicamp.br>
|
||||
|
||||
|
|
24
gcc/testsuite/g77.f-torture/compile/980310-1.f
Normal file
24
gcc/testsuite/g77.f-torture/compile/980310-1.f
Normal file
|
@ -0,0 +1,24 @@
|
|||
C Causes internal compiler error on egcs 1.0.1 on i586-pc-sco3.2v5.0.4
|
||||
C To: egcs-bugs@cygnus.com
|
||||
C Subject: backend case range problem/fix
|
||||
C From: Dave Love <d.love@dl.ac.uk>
|
||||
C Date: 02 Dec 1997 18:11:35 +0000
|
||||
C Message-ID: <rzqpvnfboo8.fsf@djlvig.dl.ac.uk>
|
||||
C
|
||||
C The following Fortran test case aborts the compiler because
|
||||
C tree_int_cst_lt dereferences a null tree; this is a regression from
|
||||
C gcc 2.7.
|
||||
C
|
||||
C The patch is against egcs sources. I don't know if it's still
|
||||
C relevant to mainline gcc, which I no longer follow.
|
||||
|
||||
INTEGER N
|
||||
READ(*,*) N
|
||||
SELECT CASE (N)
|
||||
CASE (1:)
|
||||
WRITE(*,*) 'case 1'
|
||||
CASE (0)
|
||||
WRITE(*,*) 'case 0'
|
||||
END SELECT
|
||||
END
|
||||
|
43
gcc/testsuite/g77.f-torture/compile/980310-2.f
Normal file
43
gcc/testsuite/g77.f-torture/compile/980310-2.f
Normal file
|
@ -0,0 +1,43 @@
|
|||
C unable to confirm this bug on egcs 1.0.1 for i586-pc-sco3.2v5.0.4 robertl
|
||||
C
|
||||
C Date: Sat, 23 Aug 1997 00:47:53 -0400 (EDT)
|
||||
C From: David Bristow <dbristow@lynx.dac.neu.edu>
|
||||
C To: egcs-bugs@cygnus.com
|
||||
C Subject: g77 crashes compiling Dungeon
|
||||
C Message-ID: <Pine.OSF.3.91.970823003521.11281A-100000@lynx.dac.neu.edu>
|
||||
C
|
||||
C The following small segment of Dungeon (the adventure that became the
|
||||
C commercial hit Zork) causes an internal error in f771. The platform is
|
||||
C i586-pc-linux-gnulibc1, the compiler is egcs-ss-970821 (g77-GNU Fortran
|
||||
C 0.5.21-19970811)
|
||||
C
|
||||
C --cut here--cut here--cut here--cut here--cut here--cut here--
|
||||
C g77 --verbose -fugly -fvxt -c subr_.f
|
||||
C g77 version 0.5.21-19970811
|
||||
C gcc --verbose -fugly -fvxt -xf77 subr_.f -xnone -lf2c -lm
|
||||
C Reading specs from /usr/lib/gcc-lib/i586-pc-linux-gnulibc1/egcs-2.90.01/specs
|
||||
C gcc version egcs-2.90.01 970821 (gcc2-970802 experimental)
|
||||
C /usr/lib/gcc-lib/i586-pc-linux-gnulibc1/egcs-2.90.01/f771 subr_.f -fset-g77-defaults -quiet -dumpbase subr_.f -version -fversion -fugly -fvxt -o /tmp/cca23974.s
|
||||
C f771: warning: -fugly is overloaded with meanings and likely to be removed;
|
||||
C f771: warning: use only the specific -fugly-* options you need
|
||||
C GNU F77 version egcs-2.90.01 970821 (gcc2-970802 experimental) (i586-pc-linux-gnulibc1) compiled by GNU C version egcs-2.90.01 970821 (gcc2-970802 experimental).
|
||||
C GNU Fortran Front End version 0.5.21-19970811
|
||||
C f/com.c:941: failed assertion `TYPE_PRECISION (type) <= TYPE_PRECISION (TREE_TYPE (e))'
|
||||
C gcc: Internal compiler error: program f771 got fatal signal 6
|
||||
C --cut here--cut here--cut here--cut here--cut here--cut here--
|
||||
C
|
||||
C Here's the FORTRAN code, it's basically a single subroutine from subr.f
|
||||
C in the Dungeon source, slightly altered (the original calls RAN(), which
|
||||
C doesn't exist in the g77 runtime)
|
||||
C
|
||||
C RND - Return a random integer mod n
|
||||
C
|
||||
INTEGER FUNCTION RND (N)
|
||||
IMPLICIT INTEGER (A-Z)
|
||||
REAL RAND
|
||||
COMMON /SEED/ RNSEED
|
||||
|
||||
RND = RAND(RNSEED)*FLOAT(N)
|
||||
RETURN
|
||||
|
||||
END
|
259
gcc/testsuite/g77.f-torture/compile/980310-3.f
Normal file
259
gcc/testsuite/g77.f-torture/compile/980310-3.f
Normal file
|
@ -0,0 +1,259 @@
|
|||
c
|
||||
c This demonstrates a problem with g77 and pic on x86 where
|
||||
c egcs 1.0.1 and earlier will generate bogus assembler output.
|
||||
c unfortunately, gas accepts the bogus acssembler output and
|
||||
c generates code that almost works.
|
||||
c
|
||||
|
||||
|
||||
C Date: Wed, 17 Dec 1997 23:20:29 +0000
|
||||
C From: Joao Cardoso <jcardoso@inescn.pt>
|
||||
C To: egcs-bugs@cygnus.com
|
||||
C Subject: egcs-1.0 f77 bug on OSR5
|
||||
C When trying to compile the Fortran file that I enclose bellow,
|
||||
C I got an assembler error:
|
||||
C
|
||||
C ./g77 -B./ -fpic -O -c scaleg.f
|
||||
C /usr/tmp/cca002D8.s:123:syntax error at (
|
||||
C
|
||||
C ./g77 -B./ -fpic -O0 -c scaleg.f
|
||||
C /usr/tmp/cca002EW.s:246:invalid operand combination: leal
|
||||
C
|
||||
C Compiling without the -fpic flag runs OK.
|
||||
|
||||
subroutine scaleg (n,ma,a,mb,b,low,igh,cscale,cperm,wk)
|
||||
c
|
||||
c *****parameters:
|
||||
integer igh,low,ma,mb,n
|
||||
double precision a(ma,n),b(mb,n),cperm(n),cscale(n),wk(n,6)
|
||||
c
|
||||
c *****local variables:
|
||||
integer i,ir,it,j,jc,kount,nr,nrp2
|
||||
double precision alpha,basl,beta,cmax,coef,coef2,coef5,cor,
|
||||
* ew,ewc,fi,fj,gamma,pgamma,sum,t,ta,tb,tc
|
||||
c
|
||||
c *****fortran functions:
|
||||
double precision dabs, dlog10, dsign
|
||||
c float
|
||||
c
|
||||
c *****subroutines called:
|
||||
c none
|
||||
c
|
||||
c ---------------------------------------------------------------
|
||||
c
|
||||
c *****purpose:
|
||||
c scales the matrices a and b in the generalized eigenvalue
|
||||
c problem a*x = (lambda)*b*x such that the magnitudes of the
|
||||
c elements of the submatrices of a and b (as specified by low
|
||||
c and igh) are close to unity in the least squares sense.
|
||||
c ref.: ward, r. c., balancing the generalized eigenvalue
|
||||
c problem, siam j. sci. stat. comput., vol. 2, no. 2, june 1981,
|
||||
c 141-152.
|
||||
c
|
||||
c *****parameter description:
|
||||
c
|
||||
c on input:
|
||||
c
|
||||
c ma,mb integer
|
||||
c row dimensions of the arrays containing matrices
|
||||
c a and b respectively, as declared in the main calling
|
||||
c program dimension statement;
|
||||
c
|
||||
c n integer
|
||||
c order of the matrices a and b;
|
||||
c
|
||||
c a real(ma,n)
|
||||
c contains the a matrix of the generalized eigenproblem
|
||||
c defined above;
|
||||
c
|
||||
c b real(mb,n)
|
||||
c contains the b matrix of the generalized eigenproblem
|
||||
c defined above;
|
||||
c
|
||||
c low integer
|
||||
c specifies the beginning -1 for the rows and
|
||||
c columns of a and b to be scaled;
|
||||
c
|
||||
c igh integer
|
||||
c specifies the ending -1 for the rows and columns
|
||||
c of a and b to be scaled;
|
||||
c
|
||||
c cperm real(n)
|
||||
c work array. only locations low through igh are
|
||||
c referenced and altered by this subroutine;
|
||||
c
|
||||
c wk real(n,6)
|
||||
c work array that must contain at least 6*n locations.
|
||||
c only locations low through igh, n+low through n+igh,
|
||||
c ..., 5*n+low through 5*n+igh are referenced and
|
||||
c altered by this subroutine.
|
||||
c
|
||||
c on output:
|
||||
c
|
||||
c a,b contain the scaled a and b matrices;
|
||||
c
|
||||
c cscale real(n)
|
||||
c contains in its low through igh locations the integer
|
||||
c exponents of 2 used for the column scaling factors.
|
||||
c the other locations are not referenced;
|
||||
c
|
||||
c wk contains in its low through igh locations the integer
|
||||
c exponents of 2 used for the row scaling factors.
|
||||
c
|
||||
c *****algorithm notes:
|
||||
c none.
|
||||
c
|
||||
c *****history:
|
||||
c written by r. c. ward.......
|
||||
c modified 8/86 by bobby bodenheimer so that if
|
||||
c sum = 0 (corresponding to the case where the matrix
|
||||
c doesn't need to be scaled) the routine returns.
|
||||
c
|
||||
c ---------------------------------------------------------------
|
||||
c
|
||||
if (low .eq. igh) go to 410
|
||||
do 210 i = low,igh
|
||||
wk(i,1) = 0.0d0
|
||||
wk(i,2) = 0.0d0
|
||||
wk(i,3) = 0.0d0
|
||||
wk(i,4) = 0.0d0
|
||||
wk(i,5) = 0.0d0
|
||||
wk(i,6) = 0.0d0
|
||||
cscale(i) = 0.0d0
|
||||
cperm(i) = 0.0d0
|
||||
210 continue
|
||||
c
|
||||
c compute right side vector in resulting linear equations
|
||||
c
|
||||
basl = dlog10(2.0d0)
|
||||
do 240 i = low,igh
|
||||
do 240 j = low,igh
|
||||
tb = b(i,j)
|
||||
ta = a(i,j)
|
||||
if (ta .eq. 0.0d0) go to 220
|
||||
ta = dlog10(dabs(ta)) / basl
|
||||
220 continue
|
||||
if (tb .eq. 0.0d0) go to 230
|
||||
tb = dlog10(dabs(tb)) / basl
|
||||
230 continue
|
||||
wk(i,5) = wk(i,5) - ta - tb
|
||||
wk(j,6) = wk(j,6) - ta - tb
|
||||
240 continue
|
||||
nr = igh-low+1
|
||||
coef = 1.0d0/float(2*nr)
|
||||
coef2 = coef*coef
|
||||
coef5 = 0.5d0*coef2
|
||||
nrp2 = nr+2
|
||||
beta = 0.0d0
|
||||
it = 1
|
||||
c
|
||||
c start generalized conjugate gradient iteration
|
||||
c
|
||||
250 continue
|
||||
ew = 0.0d0
|
||||
ewc = 0.0d0
|
||||
gamma = 0.0d0
|
||||
do 260 i = low,igh
|
||||
gamma = gamma + wk(i,5)*wk(i,5) + wk(i,6)*wk(i,6)
|
||||
ew = ew + wk(i,5)
|
||||
ewc = ewc + wk(i,6)
|
||||
260 continue
|
||||
gamma = coef*gamma - coef2*(ew**2 + ewc**2)
|
||||
+ - coef5*(ew - ewc)**2
|
||||
if (it .ne. 1) beta = gamma / pgamma
|
||||
t = coef5*(ewc - 3.0d0*ew)
|
||||
tc = coef5*(ew - 3.0d0*ewc)
|
||||
do 270 i = low,igh
|
||||
wk(i,2) = beta*wk(i,2) + coef*wk(i,5) + t
|
||||
cperm(i) = beta*cperm(i) + coef*wk(i,6) + tc
|
||||
270 continue
|
||||
c
|
||||
c apply matrix to vector
|
||||
c
|
||||
do 300 i = low,igh
|
||||
kount = 0
|
||||
sum = 0.0d0
|
||||
do 290 j = low,igh
|
||||
if (a(i,j) .eq. 0.0d0) go to 280
|
||||
kount = kount+1
|
||||
sum = sum + cperm(j)
|
||||
280 continue
|
||||
if (b(i,j) .eq. 0.0d0) go to 290
|
||||
kount = kount+1
|
||||
sum = sum + cperm(j)
|
||||
290 continue
|
||||
wk(i,3) = float(kount)*wk(i,2) + sum
|
||||
300 continue
|
||||
do 330 j = low,igh
|
||||
kount = 0
|
||||
sum = 0.0d0
|
||||
do 320 i = low,igh
|
||||
if (a(i,j) .eq. 0.0d0) go to 310
|
||||
kount = kount+1
|
||||
sum = sum + wk(i,2)
|
||||
310 continue
|
||||
if (b(i,j) .eq. 0.0d0) go to 320
|
||||
kount = kount+1
|
||||
sum = sum + wk(i,2)
|
||||
320 continue
|
||||
wk(j,4) = float(kount)*cperm(j) + sum
|
||||
330 continue
|
||||
sum = 0.0d0
|
||||
do 340 i = low,igh
|
||||
sum = sum + wk(i,2)*wk(i,3) + cperm(i)*wk(i,4)
|
||||
340 continue
|
||||
if(sum.eq.0.0d0) return
|
||||
alpha = gamma / sum
|
||||
c
|
||||
c determine correction to current iterate
|
||||
c
|
||||
cmax = 0.0d0
|
||||
do 350 i = low,igh
|
||||
cor = alpha * wk(i,2)
|
||||
if (dabs(cor) .gt. cmax) cmax = dabs(cor)
|
||||
wk(i,1) = wk(i,1) + cor
|
||||
cor = alpha * cperm(i)
|
||||
if (dabs(cor) .gt. cmax) cmax = dabs(cor)
|
||||
cscale(i) = cscale(i) + cor
|
||||
350 continue
|
||||
if (cmax .lt. 0.5d0) go to 370
|
||||
do 360 i = low,igh
|
||||
wk(i,5) = wk(i,5) - alpha*wk(i,3)
|
||||
wk(i,6) = wk(i,6) - alpha*wk(i,4)
|
||||
360 continue
|
||||
pgamma = gamma
|
||||
it = it+1
|
||||
if (it .le. nrp2) go to 250
|
||||
c
|
||||
c end generalized conjugate gradient iteration
|
||||
c
|
||||
370 continue
|
||||
do 380 i = low,igh
|
||||
ir = wk(i,1) + dsign(0.5d0,wk(i,1))
|
||||
wk(i,1) = ir
|
||||
jc = cscale(i) + dsign(0.5d0,cscale(i))
|
||||
cscale(i) = jc
|
||||
380 continue
|
||||
c
|
||||
c scale a and b
|
||||
c
|
||||
do 400 i = 1,igh
|
||||
ir = wk(i,1)
|
||||
fi = 2.0d0**ir
|
||||
if (i .lt. low) fi = 1.0d0
|
||||
do 400 j =low,n
|
||||
jc = cscale(j)
|
||||
fj = 2.0d0**jc
|
||||
if (j .le. igh) go to 390
|
||||
if (i .lt. low) go to 400
|
||||
fj = 1.0d0
|
||||
390 continue
|
||||
a(i,j) = a(i,j)*fi*fj
|
||||
b(i,j) = b(i,j)*fi*fj
|
||||
400 continue
|
||||
410 continue
|
||||
return
|
||||
c
|
||||
c last line of scaleg
|
||||
c
|
||||
end
|
348
gcc/testsuite/g77.f-torture/compile/980310-4.f
Normal file
348
gcc/testsuite/g77.f-torture/compile/980310-4.f
Normal file
|
@ -0,0 +1,348 @@
|
|||
|
||||
C To: egcs-bugs@cygnus.com
|
||||
C Subject: -fPIC problem showing up with fortran on x86
|
||||
C From: Dave Love <d.love@dl.ac.uk>
|
||||
C Date: 19 Dec 1997 19:31:41 +0000
|
||||
C
|
||||
C
|
||||
C This illustrates a long-standing problem noted at the end of the g77
|
||||
C `Actual Bugs' info node and thought to be in the back end. Although
|
||||
C the report is against gcc 2.7 I can reproduce it (specifically on
|
||||
C redhat 4.2) with the 971216 egcs snapshot.
|
||||
C
|
||||
C g77 version 0.5.21
|
||||
C gcc -v -fnull-version -o /tmp/gfa00415 -xf77-cpp-input /tmp/gfa00415.f -xnone
|
||||
C -lf2c -lm
|
||||
C
|
||||
|
||||
C ------------
|
||||
subroutine dqage(f,a,b,epsabs,epsrel,limit,result,abserr,
|
||||
* neval,ier,alist,blist,rlist,elist,iord,last)
|
||||
C --------------------------------------------------
|
||||
C
|
||||
C Modified Feb 1989 by Barry W. Brown to eliminate key
|
||||
C as argument (use key=1) and to eliminate all Fortran
|
||||
C output.
|
||||
C
|
||||
C Purpose: to make this routine usable from within S.
|
||||
C
|
||||
C --------------------------------------------------
|
||||
c***begin prologue dqage
|
||||
c***date written 800101 (yymmdd)
|
||||
c***revision date 830518 (yymmdd)
|
||||
c***category no. h2a1a1
|
||||
c***keywords automatic integrator, general-purpose,
|
||||
c integrand examinator, globally adaptive,
|
||||
c gauss-kronrod
|
||||
c***author piessens,robert,appl. math. & progr. div. - k.u.leuven
|
||||
c de doncker,elise,appl. math. & progr. div. - k.u.leuven
|
||||
c***purpose the routine calculates an approximation result to a given
|
||||
c definite integral i = integral of f over (a,b),
|
||||
c hopefully satisfying following claim for accuracy
|
||||
c abs(i-reslt).le.max(epsabs,epsrel*abs(i)).
|
||||
c***description
|
||||
c
|
||||
c computation of a definite integral
|
||||
c standard fortran subroutine
|
||||
c double precision version
|
||||
c
|
||||
c parameters
|
||||
c on entry
|
||||
c f - double precision
|
||||
c function subprogram defining the integrand
|
||||
c function f(x). the actual name for f needs to be
|
||||
c declared e x t e r n a l in the driver program.
|
||||
c
|
||||
c a - double precision
|
||||
c lower limit of integration
|
||||
c
|
||||
c b - double precision
|
||||
c upper limit of integration
|
||||
c
|
||||
c epsabs - double precision
|
||||
c absolute accuracy requested
|
||||
c epsrel - double precision
|
||||
c relative accuracy requested
|
||||
c if epsabs.le.0
|
||||
c and epsrel.lt.max(50*rel.mach.acc.,0.5d-28),
|
||||
c the routine will end with ier = 6.
|
||||
c
|
||||
c key - integer
|
||||
c key for choice of local integration rule
|
||||
c a gauss-kronrod pair is used with
|
||||
c 7 - 15 points if key.lt.2,
|
||||
c 10 - 21 points if key = 2,
|
||||
c 15 - 31 points if key = 3,
|
||||
c 20 - 41 points if key = 4,
|
||||
c 25 - 51 points if key = 5,
|
||||
c 30 - 61 points if key.gt.5.
|
||||
c
|
||||
c limit - integer
|
||||
c gives an upperbound on the number of subintervals
|
||||
c in the partition of (a,b), limit.ge.1.
|
||||
c
|
||||
c on return
|
||||
c result - double precision
|
||||
c approximation to the integral
|
||||
c
|
||||
c abserr - double precision
|
||||
c estimate of the modulus of the absolute error,
|
||||
c which should equal or exceed abs(i-result)
|
||||
c
|
||||
c neval - integer
|
||||
c number of integrand evaluations
|
||||
c
|
||||
c ier - integer
|
||||
c ier = 0 normal and reliable termination of the
|
||||
c routine. it is assumed that the requested
|
||||
c accuracy has been achieved.
|
||||
c ier.gt.0 abnormal termination of the routine
|
||||
c the estimates for result and error are
|
||||
c less reliable. it is assumed that the
|
||||
c requested accuracy has not been achieved.
|
||||
c error messages
|
||||
c ier = 1 maximum number of subdivisions allowed
|
||||
c has been achieved. one can allow more
|
||||
c subdivisions by increasing the value
|
||||
c of limit.
|
||||
c however, if this yields no improvement it
|
||||
c is rather advised to analyze the integrand
|
||||
c in order to determine the integration
|
||||
c difficulties. if the position of a local
|
||||
c difficulty can be determined(e.g.
|
||||
c singularity, discontinuity within the
|
||||
c interval) one will probably gain from
|
||||
c splitting up the interval at this point
|
||||
c and calling the integrator on the
|
||||
c subranges. if possible, an appropriate
|
||||
c special-purpose integrator should be used
|
||||
c which is designed for handling the type of
|
||||
c difficulty involved.
|
||||
c = 2 the occurrence of roundoff error is
|
||||
c detected, which prevents the requested
|
||||
c tolerance from being achieved.
|
||||
c = 3 extremely bad integrand behaviour occurs
|
||||
c at some points of the integration
|
||||
c interval.
|
||||
c = 6 the input is invalid, because
|
||||
c (epsabs.le.0 and
|
||||
c epsrel.lt.max(50*rel.mach.acc.,0.5d-28),
|
||||
c result, abserr, neval, last, rlist(1) ,
|
||||
c elist(1) and iord(1) are set to zero.
|
||||
c alist(1) and blist(1) are set to a and b
|
||||
c respectively.
|
||||
c
|
||||
c alist - double precision
|
||||
c vector of dimension at least limit, the first
|
||||
c last elements of which are the left
|
||||
c end points of the subintervals in the partition
|
||||
c of the given integration range (a,b)
|
||||
c
|
||||
c blist - double precision
|
||||
c vector of dimension at least limit, the first
|
||||
c last elements of which are the right
|
||||
c end points of the subintervals in the partition
|
||||
c of the given integration range (a,b)
|
||||
c
|
||||
c rlist - double precision
|
||||
c vector of dimension at least limit, the first
|
||||
c last elements of which are the
|
||||
c integral approximations on the subintervals
|
||||
c
|
||||
c elist - double precision
|
||||
c vector of dimension at least limit, the first
|
||||
c last elements of which are the moduli of the
|
||||
c absolute error estimates on the subintervals
|
||||
c
|
||||
c iord - integer
|
||||
c vector of dimension at least limit, the first k
|
||||
c elements of which are pointers to the
|
||||
c error estimates over the subintervals,
|
||||
c such that elist(iord(1)), ...,
|
||||
c elist(iord(k)) form a decreasing sequence,
|
||||
c with k = last if last.le.(limit/2+2), and
|
||||
c k = limit+1-last otherwise
|
||||
c
|
||||
c last - integer
|
||||
c number of subintervals actually produced in the
|
||||
c subdivision process
|
||||
c
|
||||
c***references (none)
|
||||
c***routines called d1mach,dqk15,dqk21,dqk31,
|
||||
c dqk41,dqk51,dqk61,dqpsrt
|
||||
c***end prologue dqage
|
||||
c
|
||||
double precision a,abserr,alist,area,area1,area12,area2,a1,a2,b,
|
||||
* blist,b1,b2,dabs,defabs,defab1,defab2,dmax1,d1mach,elist,epmach,
|
||||
* epsabs,epsrel,errbnd,errmax,error1,error2,erro12,errsum,f,
|
||||
* resabs,result,rlist,uflow
|
||||
integer ier,iord,iroff1,iroff2,k,last,limit,maxerr,neval,
|
||||
* nrmax
|
||||
c
|
||||
dimension alist(limit),blist(limit),elist(limit),iord(limit),
|
||||
* rlist(limit)
|
||||
c
|
||||
external f
|
||||
c
|
||||
c list of major variables
|
||||
c -----------------------
|
||||
c
|
||||
c alist - list of left end points of all subintervals
|
||||
c considered up to now
|
||||
c blist - list of right end points of all subintervals
|
||||
c considered up to now
|
||||
c rlist(i) - approximation to the integral over
|
||||
c (alist(i),blist(i))
|
||||
c elist(i) - error estimate applying to rlist(i)
|
||||
c maxerr - pointer to the interval with largest
|
||||
c error estimate
|
||||
c errmax - elist(maxerr)
|
||||
c area - sum of the integrals over the subintervals
|
||||
c errsum - sum of the errors over the subintervals
|
||||
c errbnd - requested accuracy max(epsabs,epsrel*
|
||||
c abs(result))
|
||||
c *****1 - variable for the left subinterval
|
||||
c *****2 - variable for the right subinterval
|
||||
c last - index for subdivision
|
||||
c
|
||||
c
|
||||
c machine dependent constants
|
||||
c ---------------------------
|
||||
c
|
||||
c epmach is the largest relative spacing.
|
||||
c uflow is the smallest positive magnitude.
|
||||
c
|
||||
c***first executable statement dqage
|
||||
epmach = d1mach(4)
|
||||
uflow = d1mach(1)
|
||||
c
|
||||
c test on validity of parameters
|
||||
c ------------------------------
|
||||
c
|
||||
ier = 0
|
||||
neval = 0
|
||||
last = 0
|
||||
result = 0.0d+00
|
||||
abserr = 0.0d+00
|
||||
alist(1) = a
|
||||
blist(1) = b
|
||||
rlist(1) = 0.0d+00
|
||||
elist(1) = 0.0d+00
|
||||
iord(1) = 0
|
||||
if(epsabs.le.0.0d+00.and.
|
||||
* epsrel.lt.dmax1(0.5d+02*epmach,0.5d-28)) ier = 6
|
||||
if(ier.eq.6) go to 999
|
||||
c
|
||||
c first approximation to the integral
|
||||
c -----------------------------------
|
||||
c
|
||||
neval = 0
|
||||
call dqk15(f,a,b,result,abserr,defabs,resabs)
|
||||
last = 1
|
||||
rlist(1) = result
|
||||
elist(1) = abserr
|
||||
iord(1) = 1
|
||||
c
|
||||
c test on accuracy.
|
||||
c
|
||||
errbnd = dmax1(epsabs,epsrel*dabs(result))
|
||||
if(abserr.le.0.5d+02*epmach*defabs.and.abserr.gt.errbnd) ier = 2
|
||||
if(limit.eq.1) ier = 1
|
||||
if(ier.ne.0.or.(abserr.le.errbnd.and.abserr.ne.resabs)
|
||||
* .or.abserr.eq.0.0d+00) go to 60
|
||||
c
|
||||
c initialization
|
||||
c --------------
|
||||
c
|
||||
c
|
||||
errmax = abserr
|
||||
maxerr = 1
|
||||
area = result
|
||||
errsum = abserr
|
||||
nrmax = 1
|
||||
iroff1 = 0
|
||||
iroff2 = 0
|
||||
c
|
||||
c main do-loop
|
||||
c ------------
|
||||
c
|
||||
do 30 last = 2,limit
|
||||
c
|
||||
c bisect the subinterval with the largest error estimate.
|
||||
c
|
||||
a1 = alist(maxerr)
|
||||
b1 = 0.5d+00*(alist(maxerr)+blist(maxerr))
|
||||
a2 = b1
|
||||
b2 = blist(maxerr)
|
||||
call dqk15(f,a1,b1,area1,error1,resabs,defab1)
|
||||
call dqk15(f,a2,b2,area2,error2,resabs,defab2)
|
||||
c
|
||||
c improve previous approximations to integral
|
||||
c and error and test for accuracy.
|
||||
c
|
||||
neval = neval+1
|
||||
area12 = area1+area2
|
||||
erro12 = error1+error2
|
||||
errsum = errsum+erro12-errmax
|
||||
area = area+area12-rlist(maxerr)
|
||||
if(defab1.eq.error1.or.defab2.eq.error2) go to 5
|
||||
if(dabs(rlist(maxerr)-area12).le.0.1d-04*dabs(area12)
|
||||
* .and.erro12.ge.0.99d+00*errmax) iroff1 = iroff1+1
|
||||
if(last.gt.10.and.erro12.gt.errmax) iroff2 = iroff2+1
|
||||
5 rlist(maxerr) = area1
|
||||
rlist(last) = area2
|
||||
errbnd = dmax1(epsabs,epsrel*dabs(area))
|
||||
if(errsum.le.errbnd) go to 8
|
||||
c
|
||||
c test for roundoff error and eventually set error flag.
|
||||
c
|
||||
if(iroff1.ge.6.or.iroff2.ge.20) ier = 2
|
||||
c
|
||||
c set error flag in the case that the number of subintervals
|
||||
c equals limit.
|
||||
c
|
||||
if(last.eq.limit) ier = 1
|
||||
c
|
||||
c set error flag in the case of bad integrand behaviour
|
||||
c at a point of the integration range.
|
||||
c
|
||||
if(dmax1(dabs(a1),dabs(b2)).le.(0.1d+01+0.1d+03*
|
||||
* epmach)*(dabs(a2)+0.1d+04*uflow)) ier = 3
|
||||
c
|
||||
c append the newly-created intervals to the list.
|
||||
c
|
||||
8 if(error2.gt.error1) go to 10
|
||||
alist(last) = a2
|
||||
blist(maxerr) = b1
|
||||
blist(last) = b2
|
||||
elist(maxerr) = error1
|
||||
elist(last) = error2
|
||||
go to 20
|
||||
10 alist(maxerr) = a2
|
||||
alist(last) = a1
|
||||
blist(last) = b1
|
||||
rlist(maxerr) = area2
|
||||
rlist(last) = area1
|
||||
elist(maxerr) = error2
|
||||
elist(last) = error1
|
||||
c
|
||||
c call subroutine dqpsrt to maintain the descending ordering
|
||||
c in the list of error estimates and select the subinterval
|
||||
c with the largest error estimate (to be bisected next).
|
||||
c
|
||||
20 call dqpsrt(limit,last,maxerr,errmax,elist,iord,nrmax)
|
||||
c ***jump out of do-loop
|
||||
if(ier.ne.0.or.errsum.le.errbnd) go to 40
|
||||
30 continue
|
||||
c
|
||||
c compute final result.
|
||||
c ---------------------
|
||||
c
|
||||
40 result = 0.0d+00
|
||||
do 50 k=1,last
|
||||
result = result+rlist(k)
|
||||
50 continue
|
||||
abserr = errsum
|
||||
60 neval = 30*neval+15
|
||||
999 return
|
||||
end
|
21
gcc/testsuite/g77.f-torture/compile/980310-6.f
Normal file
21
gcc/testsuite/g77.f-torture/compile/980310-6.f
Normal file
|
@ -0,0 +1,21 @@
|
|||
C From: Norbert Conrad <Norbert.Conrad@hrz.uni-giessen.de>
|
||||
C Message-Id: <199711131008.LAA12272@marvin.hrz.uni-giessen.de>
|
||||
C Subject: 971105 g77 bug
|
||||
C To: egcs-bugs@cygnus.com
|
||||
C Date: Thu, 13 Nov 1997 11:08:19 +0100 (CET)
|
||||
|
||||
C I found a bug in g77 in snapshot 971105
|
||||
|
||||
subroutine ai (a)
|
||||
dimension a(-1:*)
|
||||
return
|
||||
end
|
||||
C ai.f: In subroutine `ai':
|
||||
C ai.f:1:
|
||||
C subroutine ai (a)
|
||||
C ^
|
||||
C Array `a' at (^) is too large to handle
|
||||
C
|
||||
C This happens whenever the lower index boundary is negative and the upper index
|
||||
C boundary is '*'.
|
||||
|
50
gcc/testsuite/g77.f-torture/compile/980310-7.f
Normal file
50
gcc/testsuite/g77.f-torture/compile/980310-7.f
Normal file
|
@ -0,0 +1,50 @@
|
|||
C From: "David C. Doherty" <doherty@networkcs.com>
|
||||
C Message-Id: <199711171846.MAA27947@uh.msc.edu>
|
||||
C Subject: g77: auto arrays + goto = no go
|
||||
C To: egcs-bugs@cygnus.com
|
||||
C Date: Mon, 17 Nov 1997 12:46:27 -0600 (CST)
|
||||
|
||||
C I sent the following to fortran@gnu.ai.mit.edu, and Dave Love
|
||||
C replied that he was able to reproduce it on rs6000-aix; not on
|
||||
C others. He suggested that I send it to egcs-bugs.
|
||||
|
||||
C Hi - I've observed the following behavior regarding
|
||||
C automatic arrays and gotos. Seems similar to what I found
|
||||
C in the docs about computed gotos (but not exactly the same).
|
||||
C
|
||||
C I suspect from the nature of the error msg that it's in the GBE.
|
||||
C
|
||||
C I'm using egcs-971105, under linux-ppc.
|
||||
C
|
||||
C I also observed the same in g77-0.5.19 (and gcc 2.7.2?).
|
||||
C
|
||||
C I'd appreciate any advice on this. thanks for the great work.
|
||||
C --
|
||||
C >cat testg77.f
|
||||
subroutine testg77(n, a)
|
||||
c
|
||||
implicit none
|
||||
c
|
||||
integer n
|
||||
real a(n)
|
||||
real b(n)
|
||||
integer i
|
||||
c
|
||||
do i = 1, 10
|
||||
if (i .gt. 4) goto 100
|
||||
write(0, '(i2)')i
|
||||
enddo
|
||||
c
|
||||
goto 200
|
||||
100 continue
|
||||
200 continue
|
||||
c
|
||||
return
|
||||
end
|
||||
C >g77 -c testg77.f
|
||||
C testg77.f: In subroutine `testg77':
|
||||
C testg77.f:19: label `200' used before containing binding contour
|
||||
C testg77.f:18: label `100' used before containing binding contour
|
||||
C --
|
||||
C If I comment out the b(n) line or replace it with, e.g., b(10),
|
||||
C it compiles fine.
|
39
gcc/testsuite/g77.f-torture/compile/980310-8.f
Normal file
39
gcc/testsuite/g77.f-torture/compile/980310-8.f
Normal file
|
@ -0,0 +1,39 @@
|
|||
C To: egcs-bugs@cygnus.com
|
||||
C Subject: egcs-g77 and array indexing
|
||||
C Reply-To: etseidl@jutland.ca.sandia.gov
|
||||
C Date: Wed, 26 Nov 1997 10:38:27 -0800
|
||||
C From: Edward Seidl <etseidl@jutland.ca.sandia.gov>
|
||||
C
|
||||
C I have some horrible spaghetti code I'm trying compile with egcs-g77,
|
||||
C but it's puking on code like the example below. I have no idea if it's
|
||||
C legal fortran or not, and I'm in no position to change it. All I do know
|
||||
C is it compiles with a number of other compilers, including f2c and
|
||||
C g77-0.5.19.1/gcc-2.7.2.1. When I try to compile with egcs-2.90.18 971122
|
||||
C I get the following (on both i686-pc-linux-gnu and alphaev56-unknown-linux-gnu):
|
||||
C
|
||||
C foo.f: In subroutine `foobar':
|
||||
C foo.f:11:
|
||||
C subroutine foobar(norb,nnorb)
|
||||
C ^
|
||||
C Array `norb' at (^) is too large to handle
|
||||
|
||||
program foo
|
||||
implicit integer(A-Z)
|
||||
dimension norb(6)
|
||||
nnorb=6
|
||||
|
||||
call foobar(norb,nnorb)
|
||||
|
||||
stop
|
||||
end
|
||||
|
||||
subroutine foobar(norb,nnorb)
|
||||
implicit integer(A-Z)
|
||||
dimension norb(-1:*)
|
||||
|
||||
do 10 i=-1,nnorb-2
|
||||
norb(i) = i+999
|
||||
10 continue
|
||||
|
||||
return
|
||||
end
|
62
gcc/testsuite/g77.f-torture/execute/980310-5.f
Normal file
62
gcc/testsuite/g77.f-torture/execute/980310-5.f
Normal file
|
@ -0,0 +1,62 @@
|
|||
C Confirmed on EGCS 1.0.1 on i586-pc-sco3.2v5.0.4
|
||||
C To: egcs-bugs@cygnus.com
|
||||
C Subject: [Vladimir Eltsov <ve@boojum.hut.fi>] bug with -fcaller-saves
|
||||
C From: Dave Love <d.love@dl.ac.uk>
|
||||
C Date: 29 Jan 1998 18:20:47 +0000
|
||||
C Message-ID: <rzq67n3cfb4.fsf@djlvig.dl.ac.uk>
|
||||
|
||||
C This appears to be a (non-critical?) backend problem reported as a g77
|
||||
C bug. I can reproduce it, but (only) with -O[2]. Any ideas other than
|
||||
C `don't do that, then'? :-)
|
||||
C
|
||||
C ------- Start of forwarded message -------
|
||||
C Date: Tue, 27 Jan 1998 19:25:19 +0200 (EET)
|
||||
C From: Vladimir Eltsov <ve@boojum.hut.fi>
|
||||
C To: fortran@gnu.org
|
||||
C Subject: bug with -fcaller-saves
|
||||
C Message-ID: <Pine.LNX.3.96.980127190257.1606A-100000@slon.hut.fi>
|
||||
C MIME-Version: 1.0
|
||||
C Content-Type: TEXT/PLAIN; charset=US-ASCII
|
||||
C
|
||||
C Hello!
|
||||
C
|
||||
C Following program would hang after printing 6 lines when compiled with
|
||||
C 'g77 -O2 test.f' on x86 architecture, but would work OK when compiled with
|
||||
C 'g77 -O2 -fno-caller-saves test.f' both for gnu and egcs variants of the
|
||||
C compiler.
|
||||
C
|
||||
C Details follow:
|
||||
C ------- test.f -------
|
||||
program test
|
||||
implicit double precision (a-h,o-z)
|
||||
|
||||
t = 0
|
||||
C Was: tend=1. Changed to shorten runtime. robertl
|
||||
tend = .0320d-3
|
||||
dt = 6d-7
|
||||
h = 0.314d-7
|
||||
k = 1
|
||||
ti = dt
|
||||
|
||||
do while (t.lt.tend)
|
||||
do while(t.lt.ti)
|
||||
if (t+h.gt.ti) then
|
||||
h = ti-t
|
||||
end if
|
||||
call fun(t,h)
|
||||
end do
|
||||
print *,k,t,t/5d-7
|
||||
k = k+1
|
||||
ti = k*dt
|
||||
end do
|
||||
|
||||
end
|
||||
|
||||
subroutine fun(t,h)
|
||||
implicit double precision (a-h,o-z)
|
||||
|
||||
t = t+h
|
||||
h = 0.314d-7
|
||||
|
||||
return
|
||||
end
|
Loading…
Add table
Reference in a new issue