OSDN Git Service

* g77.f-torture/compile/980310-1.f, g77.f-torture/compile/980310-2.f
authorrobertl <robertl@138bc75d-0d04-0410-961f-82ee72b054a4>
Tue, 10 Mar 1998 22:07:48 +0000 (22:07 +0000)
committerrobertl <robertl@138bc75d-0d04-0410-961f-82ee72b054a4>
Tue, 10 Mar 1998 22:07:48 +0000 (22:07 +0000)
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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@18466 138bc75d-0d04-0410-961f-82ee72b054a4

gcc/testsuite/ChangeLog
gcc/testsuite/g77.f-torture/compile/980310-1.f [new file with mode: 0644]
gcc/testsuite/g77.f-torture/compile/980310-2.f [new file with mode: 0644]
gcc/testsuite/g77.f-torture/compile/980310-3.f [new file with mode: 0644]
gcc/testsuite/g77.f-torture/compile/980310-4.f [new file with mode: 0644]
gcc/testsuite/g77.f-torture/compile/980310-6.f [new file with mode: 0644]
gcc/testsuite/g77.f-torture/compile/980310-7.f [new file with mode: 0644]
gcc/testsuite/g77.f-torture/compile/980310-8.f [new file with mode: 0644]
gcc/testsuite/g77.f-torture/execute/980310-5.f [new file with mode: 0644]

index 879c53c..ae099dc 100644 (file)
@@ -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>
 
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 (file)
index 0000000..32d77ca
--- /dev/null
@@ -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
+
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 (file)
index 0000000..5077c55
--- /dev/null
@@ -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
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 (file)
index 0000000..ddfb4c4
--- /dev/null
@@ -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
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 (file)
index 0000000..b169845
--- /dev/null
@@ -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
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 (file)
index 0000000..fd91500
--- /dev/null
@@ -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 '*'. 
+
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 (file)
index 0000000..9cfbaed
--- /dev/null
@@ -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.
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 (file)
index 0000000..9501012
--- /dev/null
@@ -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
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 (file)
index 0000000..a496cf7
--- /dev/null
@@ -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