From e1834b5a6fed17915ed3edadf2302157f2d19053 Mon Sep 17 00:00:00 2001 From: Robert Lipe Date: Tue, 10 Mar 1998 22:07:48 +0000 Subject: [PATCH] 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 --- gcc/testsuite/ChangeLog | 7 + gcc/testsuite/g77.f-torture/compile/980310-1.f | 24 ++ gcc/testsuite/g77.f-torture/compile/980310-2.f | 43 +++ gcc/testsuite/g77.f-torture/compile/980310-3.f | 259 ++++++++++++++++++ gcc/testsuite/g77.f-torture/compile/980310-4.f | 348 +++++++++++++++++++++++++ gcc/testsuite/g77.f-torture/compile/980310-6.f | 21 ++ gcc/testsuite/g77.f-torture/compile/980310-7.f | 50 ++++ gcc/testsuite/g77.f-torture/compile/980310-8.f | 39 +++ gcc/testsuite/g77.f-torture/execute/980310-5.f | 62 +++++ 9 files changed, 853 insertions(+) create mode 100644 gcc/testsuite/g77.f-torture/compile/980310-1.f create mode 100644 gcc/testsuite/g77.f-torture/compile/980310-2.f create mode 100644 gcc/testsuite/g77.f-torture/compile/980310-3.f create mode 100644 gcc/testsuite/g77.f-torture/compile/980310-4.f create mode 100644 gcc/testsuite/g77.f-torture/compile/980310-6.f create mode 100644 gcc/testsuite/g77.f-torture/compile/980310-7.f create mode 100644 gcc/testsuite/g77.f-torture/compile/980310-8.f create mode 100644 gcc/testsuite/g77.f-torture/execute/980310-5.f diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 879c53c..ae099dc 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,10 @@ +Wed Mar 11 00:03:49 1998 Robert Lipe + + * 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 diff --git a/gcc/testsuite/g77.f-torture/compile/980310-1.f b/gcc/testsuite/g77.f-torture/compile/980310-1.f new file mode 100644 index 0000000..32d77ca --- /dev/null +++ b/gcc/testsuite/g77.f-torture/compile/980310-1.f @@ -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 +C Date: 02 Dec 1997 18:11:35 +0000 +C Message-ID: +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 + diff --git a/gcc/testsuite/g77.f-torture/compile/980310-2.f b/gcc/testsuite/g77.f-torture/compile/980310-2.f new file mode 100644 index 0000000..5077c55 --- /dev/null +++ b/gcc/testsuite/g77.f-torture/compile/980310-2.f @@ -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 +C To: egcs-bugs@cygnus.com +C Subject: g77 crashes compiling Dungeon +C Message-ID: +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 diff --git a/gcc/testsuite/g77.f-torture/compile/980310-3.f b/gcc/testsuite/g77.f-torture/compile/980310-3.f new file mode 100644 index 0000000..ddfb4c4 --- /dev/null +++ b/gcc/testsuite/g77.f-torture/compile/980310-3.f @@ -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 +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 diff --git a/gcc/testsuite/g77.f-torture/compile/980310-4.f b/gcc/testsuite/g77.f-torture/compile/980310-4.f new file mode 100644 index 0000000..b169845 --- /dev/null +++ b/gcc/testsuite/g77.f-torture/compile/980310-4.f @@ -0,0 +1,348 @@ + +C To: egcs-bugs@cygnus.com +C Subject: -fPIC problem showing up with fortran on x86 +C From: Dave Love +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 diff --git a/gcc/testsuite/g77.f-torture/compile/980310-6.f b/gcc/testsuite/g77.f-torture/compile/980310-6.f new file mode 100644 index 0000000..fd91500 --- /dev/null +++ b/gcc/testsuite/g77.f-torture/compile/980310-6.f @@ -0,0 +1,21 @@ +C From: Norbert Conrad +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 '*'. + diff --git a/gcc/testsuite/g77.f-torture/compile/980310-7.f b/gcc/testsuite/g77.f-torture/compile/980310-7.f new file mode 100644 index 0000000..9cfbaed --- /dev/null +++ b/gcc/testsuite/g77.f-torture/compile/980310-7.f @@ -0,0 +1,50 @@ +C From: "David C. Doherty" +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. diff --git a/gcc/testsuite/g77.f-torture/compile/980310-8.f b/gcc/testsuite/g77.f-torture/compile/980310-8.f new file mode 100644 index 0000000..9501012 --- /dev/null +++ b/gcc/testsuite/g77.f-torture/compile/980310-8.f @@ -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 +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 diff --git a/gcc/testsuite/g77.f-torture/execute/980310-5.f b/gcc/testsuite/g77.f-torture/execute/980310-5.f new file mode 100644 index 0000000..a496cf7 --- /dev/null +++ b/gcc/testsuite/g77.f-torture/execute/980310-5.f @@ -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 ] bug with -fcaller-saves +C From: Dave Love +C Date: 29 Jan 1998 18:20:47 +0000 +C Message-ID: + +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 +C To: fortran@gnu.org +C Subject: bug with -fcaller-saves +C Message-ID: +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 -- 2.7.4