mirror of
git://gcc.gnu.org/git/gcc.git
synced 2025-04-10 21:41:14 +08:00
004-07-12 David Billinghurst (David.Billinghurst@riotinto.com)
* gfortran.dg/g77/12002.f: Copy from g77.f-torture/compile.
Add {dg-do compile} directive.
* gfortran.dg/g77/13060.f: Likewise
* gfortran.dg/g77/19990218-0.f: Likewise
* gfortran.dg/g77/19990305-0.f: Likewise
* gfortran.dg/g77/19990419-0.f: Likewise
* gfortran.dg/g77/19990502-0.f: Likewise
* gfortran.dg/g77/19990502-1.f: Likewise
* gfortran.dg/g77/19990525-0.f: Likewise
* gfortran.dg/g77/19990826-1.f: Likewise
* gfortran.dg/g77/19990826-3.f: Likewise
* gfortran.dg/g77/19990905-2.f: Likewise
* gfortran.dg/g77/20000412-1.f: Likewise
* gfortran.dg/g77/20000511-1.f: Likewise
* gfortran.dg/g77/20000511-2.f: Likewise
* gfortran.dg/g77/20000518.f: Likewise
* gfortran.dg/g77/20000601-1.f: Likewise
* gfortran.dg/g77/20000601-2.f: Likewise
* gfortran.dg/g77/20000629-1.f: Likewise
* gfortran.dg/g77/20000630-2.f: Likewise
* gfortran.dg/g77/20010115.f: Likewise
* gfortran.dg/g77/20010321-1.f: Likewise
* gfortran.dg/g77/20010426.f: Likewise
* gfortran.dg/g77/20020307-1.f: Likewise
* gfortran.dg/g77/8485.f: Likewise
* gfortran.dg/g77/960317-1.f: Likewise
* gfortran.dg/g77/970915-0.f: Likewise
* gfortran.dg/g77/980310-1.f: Likewise
* gfortran.dg/g77/980310-2.f: Likewise
* gfortran.dg/g77/980310-3.f: Likewise
* gfortran.dg/g77/980310-4.f: Likewise
* gfortran.dg/g77/980310-6.f: Likewise
* gfortran.dg/g77/980310-7.f: Likewise
* gfortran.dg/g77/980310-8.f: Likewise
* gfortran.dg/g77/980419-2.f: Likewise
* gfortran.dg/g77/980424-0.f: Likewise
* gfortran.dg/g77/980427-0.f: Likewise
* gfortran.dg/g77/980729-0.f: Likewise
* gfortran.dg/g77/981117-1.f: Likewise
* gfortran.dg/g77/toon_1.f: Likewise
From-SVN: r84553
This commit is contained in:
David Billinghurst
David Billinghurst
parent
7fb213d8e9
commit
62e39334a0
@ -1,3 +1,46 @@
|
||||
2004-07-12 David Billinghurst (David.Billinghurst@riotinto.com)
|
||||
|
||||
* gfortran.dg/g77/12002.f: Copy from g77.f-torture/compile .
|
||||
Add {dg-do compile} directive.
|
||||
* gfortran.dg/g77/13060.f: Likewise
|
||||
* gfortran.dg/g77/19990218-0.f: Likewise
|
||||
* gfortran.dg/g77/19990305-0.f: Likewise
|
||||
* gfortran.dg/g77/19990419-0.f: Likewise
|
||||
* gfortran.dg/g77/19990502-0.f: Likewise
|
||||
* gfortran.dg/g77/19990502-1.f: Likewise
|
||||
* gfortran.dg/g77/19990525-0.f: Likewise
|
||||
* gfortran.dg/g77/19990826-1.f: Likewise
|
||||
* gfortran.dg/g77/19990826-3.f: Likewise
|
||||
* gfortran.dg/g77/19990905-2.f: Likewise
|
||||
* gfortran.dg/g77/20000412-1.f: Likewise
|
||||
* gfortran.dg/g77/20000511-1.f: Likewise
|
||||
* gfortran.dg/g77/20000511-2.f: Likewise
|
||||
* gfortran.dg/g77/20000518.f: Likewise
|
||||
* gfortran.dg/g77/20000601-1.f: Likewise
|
||||
* gfortran.dg/g77/20000601-2.f: Likewise
|
||||
* gfortran.dg/g77/20000629-1.f: Likewise
|
||||
* gfortran.dg/g77/20000630-2.f: Likewise
|
||||
* gfortran.dg/g77/20010115.f: Likewise
|
||||
* gfortran.dg/g77/20010321-1.f: Likewise
|
||||
* gfortran.dg/g77/20010426.f: Likewise
|
||||
* gfortran.dg/g77/20020307-1.f: Likewise
|
||||
* gfortran.dg/g77/8485.f: Likewise
|
||||
* gfortran.dg/g77/960317-1.f: Likewise
|
||||
* gfortran.dg/g77/970915-0.f: Likewise
|
||||
* gfortran.dg/g77/980310-1.f: Likewise
|
||||
* gfortran.dg/g77/980310-2.f: Likewise
|
||||
* gfortran.dg/g77/980310-3.f: Likewise
|
||||
* gfortran.dg/g77/980310-4.f: Likewise
|
||||
* gfortran.dg/g77/980310-6.f: Likewise
|
||||
* gfortran.dg/g77/980310-7.f: Likewise
|
||||
* gfortran.dg/g77/980310-8.f: Likewise
|
||||
* gfortran.dg/g77/980419-2.f: Likewise
|
||||
* gfortran.dg/g77/980424-0.f: Likewise
|
||||
* gfortran.dg/g77/980427-0.f: Likewise
|
||||
* gfortran.dg/g77/980729-0.f: Likewise
|
||||
* gfortran.dg/g77/981117-1.f: Likewise
|
||||
* gfortran.dg/g77/toon_1.f: Likewise
|
||||
|
||||
2004-07-12 Giovanni Bajo <giovannibajo@gcc.gnu.org>
|
||||
|
||||
PR c++/2204
|
||||
|
||||
6
gcc/testsuite/gfortran.dg/g77/12002.f
Normal file
6
gcc/testsuite/gfortran.dg/g77/12002.f
Normal file
@ -0,0 +1,6 @@
|
||||
C PR middle-end/12002
|
||||
C {dg-do compile }
|
||||
COMPLEX TE1
|
||||
TE1=-2.
|
||||
TE1=TE1+TE1
|
||||
END
|
||||
14
gcc/testsuite/gfortran.dg/g77/13060.f
Normal file
14
gcc/testsuite/gfortran.dg/g77/13060.f
Normal file
@ -0,0 +1,14 @@
|
||||
c { dg-do compile }
|
||||
subroutine geo2()
|
||||
implicit none
|
||||
|
||||
integer ms,n,ne(2)
|
||||
|
||||
ne(1) = 1
|
||||
ne(2) = 2
|
||||
ms = 1
|
||||
|
||||
call call_me(ne(1)*ne(1))
|
||||
|
||||
n = ne(ms)
|
||||
end
|
||||
14
gcc/testsuite/gfortran.dg/g77/19990218-0.f
Normal file
14
gcc/testsuite/gfortran.dg/g77/19990218-0.f
Normal file
@ -0,0 +1,14 @@
|
||||
c { dg-do compile }
|
||||
program test
|
||||
double precision a,b,c
|
||||
data a,b/1.0d-46,1.0d0/
|
||||
c=fun(a,b)
|
||||
print*,'in main: fun=',c
|
||||
end
|
||||
double precision function fun(a,b)
|
||||
double precision a,b
|
||||
print*,'in sub: a,b=',a,b
|
||||
fun=a*b
|
||||
print*,'in sub: fun=',fun
|
||||
return
|
||||
end
|
||||
56
gcc/testsuite/gfortran.dg/g77/19990305-0.f
Normal file
56
gcc/testsuite/gfortran.dg/g77/19990305-0.f
Normal file
@ -0,0 +1,56 @@
|
||||
c { dg-do compile }
|
||||
* Date: Fri, 5 Mar 1999 00:35:44 -0500 (EST)
|
||||
* From: Denes Molnar <molnard@phys.columbia.edu>
|
||||
* To: fortran@gnu.org
|
||||
* Subject: f771 gets fatal signal 6
|
||||
* Content-Type: TEXT/PLAIN; charset=US-ASCII
|
||||
* X-UIDL: 8d81e9cbdcc96209c6e9b298d966ba7f
|
||||
*
|
||||
* Hi,
|
||||
*
|
||||
*
|
||||
* Comiling object from the source code below WORKS FINE with
|
||||
* 'g77 -o hwuci2 -c hwuci2.F'
|
||||
* but FAILS with fatal signal 6
|
||||
* 'g77 -o hwuci2 -O -c hwuci2.F'
|
||||
*
|
||||
* Any explanations?
|
||||
*
|
||||
* I am running GNU Fortran 0.5.23 with GCC 2.8.1 (glibc1).
|
||||
*
|
||||
*
|
||||
* Denes Molnar
|
||||
*
|
||||
* %%%%%%%%%%%%%%%%%%%%%%%%%
|
||||
* %the source:
|
||||
* %%%%%%%%%%%%%%%%%%%%%%%%%
|
||||
*
|
||||
CDECK ID>, HWUCI2.
|
||||
*CMZ :- -23/08/94 13.22.29 by Mike Seymour
|
||||
*-- Author : Ulrich Baur & Nigel Glover, adapted by Ian Knowles
|
||||
C-----------------------------------------------------------------------
|
||||
FUNCTION HWUCI2(A,B,Y0)
|
||||
C-----------------------------------------------------------------------
|
||||
C Integral LOG(A-EPSI-BY(1-Y))/(Y-Y0)
|
||||
C-----------------------------------------------------------------------
|
||||
IMPLICIT NONE
|
||||
DOUBLE COMPLEX HWUCI2,HWULI2,EPSI,Y1,Y2,Z1,Z2,Z3,Z4
|
||||
DOUBLE PRECISION A,B,Y0,ZERO,ONE,FOUR,HALF
|
||||
EXTERNAL HWULI2
|
||||
COMMON/SMALL/EPSI
|
||||
PARAMETER (ZERO=0.D0, ONE =1.D0, FOUR= 4.D0, HALF=0.5D0)
|
||||
IF(B.EQ.ZERO)THEN
|
||||
HWUCI2=CMPLX(ZERO,ZERO)
|
||||
ELSE
|
||||
Y1=HALF*(ONE+SQRT(ONE-FOUR*(A+EPSI)/B))
|
||||
Y2=ONE-Y1
|
||||
Z1=Y0/(Y0-Y1)
|
||||
Z2=(Y0-ONE)/(Y0-Y1)
|
||||
Z3=Y0/(Y0-Y2)
|
||||
Z4=(Y0-ONE)/(Y0-Y2)
|
||||
HWUCI2=HWULI2(Z1)-HWULI2(Z2)+HWULI2(Z3)-HWULI2(Z4)
|
||||
ENDIF
|
||||
RETURN
|
||||
END
|
||||
*
|
||||
* %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
||||
8
gcc/testsuite/gfortran.dg/g77/19990419-0.f
Normal file
8
gcc/testsuite/gfortran.dg/g77/19990419-0.f
Normal file
@ -0,0 +1,8 @@
|
||||
c { dg-do compile }
|
||||
* Test case Toon submitted, cut down to expose the one bug.
|
||||
* Belongs in compile/.
|
||||
SUBROUTINE INIERS1
|
||||
IMPLICIT LOGICAL(L)
|
||||
COMMON/COMIOD/ NHIERS1, LERS1
|
||||
inquire(nhiers1, exist=lers1)
|
||||
END
|
||||
67
gcc/testsuite/gfortran.dg/g77/19990502-0.f
Normal file
67
gcc/testsuite/gfortran.dg/g77/19990502-0.f
Normal file
@ -0,0 +1,67 @@
|
||||
c { dg-do compile }
|
||||
* Mailing-List: contact egcs-bugs-help@egcs.cygnus.com; run by ezmlm
|
||||
* Precedence: bulk
|
||||
* Sender: owner-egcs-bugs@egcs.cygnus.com
|
||||
* From: Norbert Conrad <Norbert.Conrad@hrz.uni-giessen.de>
|
||||
* Subject: egcs g77 19990524pre Internal compiler error in `print_operand'
|
||||
* To: egcs-bugs@egcs.cygnus.com
|
||||
* Date: Mon, 31 May 1999 11:46:52 +0200 (CET)
|
||||
* Content-Type: text/plain; charset=US-ASCII
|
||||
* X-UIDL: 9a00095a5fe4d774b7223de071157374
|
||||
*
|
||||
* Hi,
|
||||
*
|
||||
* I ./configure --prefix=/opt and bootstrapped egcs g77 snapshot 19990524
|
||||
* on an i686-pc-linux-gnu. The program below gives an internal compiler error.
|
||||
*
|
||||
*
|
||||
* Script started on Mon May 31 11:30:01 1999
|
||||
* lx{g010}:/tmp>/opt/bin/g77 -v -O3 -malign-double -c e3.f
|
||||
* g77 version gcc-2.95 19990524 (prerelease) (from FSF-g77 version 0.5.24-19990515)
|
||||
* Reading specs from /opt/lib/gcc-lib/i686-pc-linux-gnu/gcc-2.95/specs
|
||||
* gcc version gcc-2.95 19990524 (prerelease)
|
||||
* /opt/lib/gcc-lib/i686-pc-linux-gnu/gcc-2.95/f771 e3.f -quiet -dumpbase e3.f -malign-double -O3 -version -fversion -o /tmp/ccQgeaaa.s
|
||||
* GNU F77 version gcc-2.95 19990524 (prerelease) (i686-pc-linux-gnu) compiled by GNU C version gcc-2.95 19990524 (prerelease).
|
||||
* GNU Fortran Front End version 0.5.24-19990515
|
||||
* e3.f:25: Internal compiler error in `print_operand', at ./config/i386/i386.c:3405
|
||||
* Please submit a full bug report to `egcs-bugs@egcs.cygnus.com'.
|
||||
* See <URL:http://egcs.cygnus.com/faq.html#bugreport> for details.
|
||||
* lx{g010}:/tmp>cat e3.f
|
||||
SUBROUTINE DLASQ2( QQ, EE, TOL2, SMALL2 )
|
||||
DOUBLE PRECISION SMALL2, TOL2
|
||||
DOUBLE PRECISION EE( * ), QQ( * )
|
||||
INTEGER ICONV, N, OFF
|
||||
DOUBLE PRECISION QEMAX, XINF
|
||||
EXTERNAL DLASQ3
|
||||
INTRINSIC MAX, SQRT
|
||||
XINF = 0.0D0
|
||||
ICONV = 0
|
||||
IF( EE( N ).LE.MAX( QQ( N ), XINF, SMALL2 )*TOL2 ) THEN
|
||||
END IF
|
||||
IF( EE( N-2 ).LE.MAX( XINF, SMALL2,
|
||||
$ ( QQ( N ) / ( QQ( N )+EE( N-1 ) ) )* QQ( N-1 ))*TOL2 ) THEN
|
||||
QEMAX = MAX( QQ( N ), QQ( N-1 ), EE( N-1 ) )
|
||||
END IF
|
||||
IF( N.EQ.0 ) THEN
|
||||
IF( OFF.EQ.0 ) THEN
|
||||
RETURN
|
||||
ELSE
|
||||
XINF =0.0D0
|
||||
END IF
|
||||
ELSE IF( N.EQ.2 ) THEN
|
||||
END IF
|
||||
CALL DLASQ3(ICONV)
|
||||
END
|
||||
* lx{g010}:/tmp>exit
|
||||
*
|
||||
* Script done on Mon May 31 11:30:23 1999
|
||||
*
|
||||
* Best regards,
|
||||
*
|
||||
* Norbert.
|
||||
* --
|
||||
* Norbert Conrad phone: ++49 641 9913021
|
||||
* Hochschulrechenzentrum email: conrad@hrz.uni-giessen.de
|
||||
* Heinrich-Buff-Ring 44
|
||||
* 35392 Giessen
|
||||
* Germany
|
||||
7
gcc/testsuite/gfortran.dg/g77/19990502-1.f
Normal file
7
gcc/testsuite/gfortran.dg/g77/19990502-1.f
Normal file
@ -0,0 +1,7 @@
|
||||
c { dg-do compile }
|
||||
SUBROUTINE G(IGAMS,IWRK,NADC,NCellsInY)
|
||||
INTEGER*2 IGAMS(2,NADC)
|
||||
in = 1
|
||||
do while (in.le.nadc.and.IGAMS(2,in).le.in)
|
||||
enddo
|
||||
END
|
||||
51
gcc/testsuite/gfortran.dg/g77/19990525-0.f
Normal file
51
gcc/testsuite/gfortran.dg/g77/19990525-0.f
Normal file
@ -0,0 +1,51 @@
|
||||
c { dg-do compile }
|
||||
* Mailing-List: contact egcs-bugs-help@egcs.cygnus.com; run by ezmlm
|
||||
* Precedence: bulk
|
||||
* Sender: owner-egcs-bugs@egcs.cygnus.com
|
||||
* From: "Bjorn R. Bjornsson" <brb@halo.hi.is>
|
||||
* Subject: g77 char expr. as arg to subroutine bug
|
||||
* To: egcs-bugs@egcs.cygnus.com
|
||||
* Date: Tue, 25 May 1999 14:45:56 +0000 (GMT)
|
||||
* Content-Type: text/plain; charset=US-ASCII
|
||||
* X-UIDL: 06000c94269ed6dfe826493e52a818b9
|
||||
*
|
||||
* The following bug is in all snapshots starting
|
||||
* from April 18. I have only tested this on Alpha linux,
|
||||
* and with FFECOM_FASTER_ARRAY_REFS set to 1.
|
||||
*
|
||||
* Run the following through g77:
|
||||
*
|
||||
subroutine a
|
||||
character*2 string1
|
||||
character*2 string2
|
||||
character*4 string3
|
||||
string1 = 's1'
|
||||
string2 = 's2'
|
||||
c
|
||||
c the next 2 lines are ok.
|
||||
string3 = (string1 // string2)
|
||||
call b(string1//string2)
|
||||
c
|
||||
c this line gives gcc/f/com.c:10660: failed assertion `hook'
|
||||
call b((string1//string2))
|
||||
end
|
||||
*
|
||||
* the output from:
|
||||
*
|
||||
* /usr/local/egcs-19990418/bin/g77 --verbose -c D.f
|
||||
*
|
||||
* is:
|
||||
*
|
||||
* on egcs-2.93.19 19990418 (gcc2 ss-980929 experimental) (from FSF-g77 version 0.5.24-19990418)
|
||||
* Reading specs from /usr/local/egcs-19990418/lib/gcc-lib/alphaev56-unknown-linux-gnu/egcs-2.93.19/specs
|
||||
* gcc version egcs-2.93.19 19990418 (gcc2 ss-980929 experimental)
|
||||
* /usr/local/egcs-19990418/lib/gcc-lib/alphaev56-unknown-linux-gnu/egcs-2.93.19/f771 D.f -quiet -dumpbase D.f -version -fversion -o /tmp/ccNpaaaa.s
|
||||
* GNU F77 version egcs-2.93.19 19990418 (gcc2 ss-980929 experimental) (alphaev56-unknown-linux-gnu) compiled by GNU C version egcs-2.93.19 19990418 (gcc2 ss-980929 experimental).
|
||||
* GNU Fortran Front End version 0.5.24-19990418
|
||||
* ../../../egcs-19990418/gcc/f/com.c:10351: failed assertion `hook'
|
||||
* g77: Internal compiler error: program f771 got fatal signal 6
|
||||
*
|
||||
* Yours,
|
||||
*
|
||||
* Bjorn R. Bjornsson
|
||||
* brb@halo.hi.is
|
||||
287
gcc/testsuite/gfortran.dg/g77/19990826-1.f
Normal file
287
gcc/testsuite/gfortran.dg/g77/19990826-1.f
Normal file
@ -0,0 +1,287 @@
|
||||
c { dg-do compile }
|
||||
* Date: Tue, 24 Aug 1999 12:25:41 +1200 (NZST)
|
||||
* From: Jonathan Ravens <ravens@whio.gns.cri.nz>
|
||||
* To: gcc-bugs@gcc.gnu.org
|
||||
* Subject: g77 bug report
|
||||
* X-UIDL: a0bf5ecc21487cde48d9104983ab04d6
|
||||
|
||||
! This fortran source will not compile - if the penultimate elseif block is 0
|
||||
! included then the message appears :
|
||||
!
|
||||
! /usr/src/egcs//gcc-2.95.1/gcc/f/stw.c:308: failed assertion `b->uses_ > 0'
|
||||
! g77: Internal compiler error: program f771 got fatal signal 6
|
||||
!
|
||||
! The command was : g77 -c <prog.f>
|
||||
!
|
||||
! The OS is Red Hat 6, and the output from uname -a is
|
||||
! Linux grfw1452.gns.cri.nz 2.2.5-15 #1 Mon Apr 19 23:00:46 EDT 1999 i686 unknown
|
||||
!
|
||||
! The configure script I used was
|
||||
! /usr/src/egcs/gcc/gcc-2.95.1/configure --enable-languages=f77 i585-unknown-linux
|
||||
!
|
||||
! I was installing 2.95 because under EGCS 2.1.1 none of my code was working
|
||||
! with optimisation turned on, and there were still bugs with no optimisation
|
||||
! (all of which code works fine under g77 0.5.21 and Sun/IBM/Dec/HP fortrans).
|
||||
!
|
||||
! The version of g77 is :
|
||||
!
|
||||
!g77 version 2.95.1 19990816 (release) (from FSF-g77 version 0.5.25 19990816 (release))
|
||||
|
||||
program main
|
||||
if (i.eq.1) then
|
||||
call abc(1)
|
||||
else if (i.eq. 1) then
|
||||
call abc( 1)
|
||||
else if (i.eq. 2) then
|
||||
call abc( 2)
|
||||
else if (i.eq. 3) then
|
||||
call abc( 3)
|
||||
else if (i.eq. 4) then
|
||||
call abc( 4)
|
||||
else if (i.eq. 5) then
|
||||
call abc( 5)
|
||||
else if (i.eq. 6) then
|
||||
call abc( 6)
|
||||
else if (i.eq. 7) then
|
||||
call abc( 7)
|
||||
else if (i.eq. 8) then
|
||||
call abc( 8)
|
||||
else if (i.eq. 9) then
|
||||
call abc( 9)
|
||||
else if (i.eq. 10) then
|
||||
call abc( 10)
|
||||
else if (i.eq. 11) then
|
||||
call abc( 11)
|
||||
else if (i.eq. 12) then
|
||||
call abc( 12)
|
||||
else if (i.eq. 13) then
|
||||
call abc( 13)
|
||||
else if (i.eq. 14) then
|
||||
call abc( 14)
|
||||
else if (i.eq. 15) then
|
||||
call abc( 15)
|
||||
else if (i.eq. 16) then
|
||||
call abc( 16)
|
||||
else if (i.eq. 17) then
|
||||
call abc( 17)
|
||||
else if (i.eq. 18) then
|
||||
call abc( 18)
|
||||
else if (i.eq. 19) then
|
||||
call abc( 19)
|
||||
else if (i.eq. 20) then
|
||||
call abc( 20)
|
||||
else if (i.eq. 21) then
|
||||
call abc( 21)
|
||||
else if (i.eq. 22) then
|
||||
call abc( 22)
|
||||
else if (i.eq. 23) then
|
||||
call abc( 23)
|
||||
else if (i.eq. 24) then
|
||||
call abc( 24)
|
||||
else if (i.eq. 25) then
|
||||
call abc( 25)
|
||||
else if (i.eq. 26) then
|
||||
call abc( 26)
|
||||
else if (i.eq. 27) then
|
||||
call abc( 27)
|
||||
else if (i.eq. 28) then
|
||||
call abc( 28)
|
||||
else if (i.eq. 29) then
|
||||
call abc( 29)
|
||||
else if (i.eq. 30) then
|
||||
call abc( 30)
|
||||
else if (i.eq. 31) then
|
||||
call abc( 31)
|
||||
else if (i.eq. 32) then
|
||||
call abc( 32)
|
||||
else if (i.eq. 33) then
|
||||
call abc( 33)
|
||||
else if (i.eq. 34) then
|
||||
call abc( 34)
|
||||
else if (i.eq. 35) then
|
||||
call abc( 35)
|
||||
else if (i.eq. 36) then
|
||||
call abc( 36)
|
||||
else if (i.eq. 37) then
|
||||
call abc( 37)
|
||||
else if (i.eq. 38) then
|
||||
call abc( 38)
|
||||
else if (i.eq. 39) then
|
||||
call abc( 39)
|
||||
else if (i.eq. 40) then
|
||||
call abc( 40)
|
||||
else if (i.eq. 41) then
|
||||
call abc( 41)
|
||||
else if (i.eq. 42) then
|
||||
call abc( 42)
|
||||
else if (i.eq. 43) then
|
||||
call abc( 43)
|
||||
else if (i.eq. 44) then
|
||||
call abc( 44)
|
||||
else if (i.eq. 45) then
|
||||
call abc( 45)
|
||||
else if (i.eq. 46) then
|
||||
call abc( 46)
|
||||
else if (i.eq. 47) then
|
||||
call abc( 47)
|
||||
else if (i.eq. 48) then
|
||||
call abc( 48)
|
||||
else if (i.eq. 49) then
|
||||
call abc( 49)
|
||||
else if (i.eq. 50) then
|
||||
call abc( 50)
|
||||
else if (i.eq. 51) then
|
||||
call abc( 51)
|
||||
else if (i.eq. 52) then
|
||||
call abc( 52)
|
||||
else if (i.eq. 53) then
|
||||
call abc( 53)
|
||||
else if (i.eq. 54) then
|
||||
call abc( 54)
|
||||
else if (i.eq. 55) then
|
||||
call abc( 55)
|
||||
else if (i.eq. 56) then
|
||||
call abc( 56)
|
||||
else if (i.eq. 57) then
|
||||
call abc( 57)
|
||||
else if (i.eq. 58) then
|
||||
call abc( 58)
|
||||
else if (i.eq. 59) then
|
||||
call abc( 59)
|
||||
else if (i.eq. 60) then
|
||||
call abc( 60)
|
||||
else if (i.eq. 61) then
|
||||
call abc( 61)
|
||||
else if (i.eq. 62) then
|
||||
call abc( 62)
|
||||
else if (i.eq. 63) then
|
||||
call abc( 63)
|
||||
else if (i.eq. 64) then
|
||||
call abc( 64)
|
||||
else if (i.eq. 65) then
|
||||
call abc( 65)
|
||||
else if (i.eq. 66) then
|
||||
call abc( 66)
|
||||
else if (i.eq. 67) then
|
||||
call abc( 67)
|
||||
else if (i.eq. 68) then
|
||||
call abc( 68)
|
||||
else if (i.eq. 69) then
|
||||
call abc( 69)
|
||||
else if (i.eq. 70) then
|
||||
call abc( 70)
|
||||
else if (i.eq. 71) then
|
||||
call abc( 71)
|
||||
else if (i.eq. 72) then
|
||||
call abc( 72)
|
||||
else if (i.eq. 73) then
|
||||
call abc( 73)
|
||||
else if (i.eq. 74) then
|
||||
call abc( 74)
|
||||
else if (i.eq. 75) then
|
||||
call abc( 75)
|
||||
else if (i.eq. 76) then
|
||||
call abc( 76)
|
||||
else if (i.eq. 77) then
|
||||
call abc( 77)
|
||||
else if (i.eq. 78) then
|
||||
call abc( 78)
|
||||
else if (i.eq. 79) then
|
||||
call abc( 79)
|
||||
else if (i.eq. 80) then
|
||||
call abc( 80)
|
||||
else if (i.eq. 81) then
|
||||
call abc( 81)
|
||||
else if (i.eq. 82) then
|
||||
call abc( 82)
|
||||
else if (i.eq. 83) then
|
||||
call abc( 83)
|
||||
else if (i.eq. 84) then
|
||||
call abc( 84)
|
||||
else if (i.eq. 85) then
|
||||
call abc( 85)
|
||||
else if (i.eq. 86) then
|
||||
call abc( 86)
|
||||
else if (i.eq. 87) then
|
||||
call abc( 87)
|
||||
else if (i.eq. 88) then
|
||||
call abc( 88)
|
||||
else if (i.eq. 89) then
|
||||
call abc( 89)
|
||||
else if (i.eq. 90) then
|
||||
call abc( 90)
|
||||
else if (i.eq. 91) then
|
||||
call abc( 91)
|
||||
else if (i.eq. 92) then
|
||||
call abc( 92)
|
||||
else if (i.eq. 93) then
|
||||
call abc( 93)
|
||||
else if (i.eq. 94) then
|
||||
call abc( 94)
|
||||
else if (i.eq. 95) then
|
||||
call abc( 95)
|
||||
else if (i.eq. 96) then
|
||||
call abc( 96)
|
||||
else if (i.eq. 97) then
|
||||
call abc( 97)
|
||||
else if (i.eq. 98) then
|
||||
call abc( 98)
|
||||
else if (i.eq. 99) then
|
||||
call abc( 99)
|
||||
else if (i.eq. 100) then
|
||||
call abc( 100)
|
||||
else if (i.eq. 101) then
|
||||
call abc( 101)
|
||||
else if (i.eq. 102) then
|
||||
call abc( 102)
|
||||
else if (i.eq. 103) then
|
||||
call abc( 103)
|
||||
else if (i.eq. 104) then
|
||||
call abc( 104)
|
||||
else if (i.eq. 105) then
|
||||
call abc( 105)
|
||||
else if (i.eq. 106) then
|
||||
call abc( 106)
|
||||
else if (i.eq. 107) then
|
||||
call abc( 107)
|
||||
else if (i.eq. 108) then
|
||||
call abc( 108)
|
||||
else if (i.eq. 109) then
|
||||
call abc( 109)
|
||||
else if (i.eq. 110) then
|
||||
call abc( 110)
|
||||
else if (i.eq. 111) then
|
||||
call abc( 111)
|
||||
else if (i.eq. 112) then
|
||||
call abc( 112)
|
||||
else if (i.eq. 113) then
|
||||
call abc( 113)
|
||||
else if (i.eq. 114) then
|
||||
call abc( 114)
|
||||
else if (i.eq. 115) then
|
||||
call abc( 115)
|
||||
else if (i.eq. 116) then
|
||||
call abc( 116)
|
||||
else if (i.eq. 117) then
|
||||
call abc( 117)
|
||||
else if (i.eq. 118) then
|
||||
call abc( 118)
|
||||
else if (i.eq. 119) then
|
||||
call abc( 119)
|
||||
else if (i.eq. 120) then
|
||||
call abc( 120)
|
||||
else if (i.eq. 121) then
|
||||
call abc( 121)
|
||||
else if (i.eq. 122) then
|
||||
call abc( 122)
|
||||
else if (i.eq. 123) then
|
||||
call abc( 123)
|
||||
else if (i.eq. 124) then
|
||||
call abc( 124)
|
||||
else if (i.eq. 125) then !< Miscompiles if present
|
||||
call abc( 125) !<
|
||||
|
||||
c else if (i.eq. 126) then
|
||||
c call abc( 126)
|
||||
endif
|
||||
end
|
||||
321
gcc/testsuite/gfortran.dg/g77/19990826-3.f
Normal file
321
gcc/testsuite/gfortran.dg/g77/19990826-3.f
Normal file
@ -0,0 +1,321 @@
|
||||
c { dg-do compile }
|
||||
* Date: Thu, 19 Aug 1999 10:02:32 +0200
|
||||
* From: Frederic Devernay <devernay@istar.fr>
|
||||
* Organization: ISTAR
|
||||
* X-Accept-Language: French, fr, en
|
||||
* To: gcc-bugs@gcc.gnu.org
|
||||
* Subject: g77 2.95 bug (Internal compiler error in `final_scan_insn')
|
||||
* X-UIDL: 08443f5c374ffa382a05573281482f4f
|
||||
|
||||
* Here's a bug that happens only when I compile with -O (disappears with
|
||||
* -O2)
|
||||
|
||||
* > g77 -v --save-temps -O -c pcapop.f
|
||||
* g77 version 2.95 19990728 (release) (from FSF-g77 version 0.5.25
|
||||
* 19990728 (release))
|
||||
* Reading specs from
|
||||
* /usr/local/lib/gcc-lib/sparc-sun-solaris2.6/2.95/specs
|
||||
* gcc version 2.95 19990728 (release)
|
||||
* /usr/local/lib/gcc-lib/sparc-sun-solaris2.6/2.95/f771 pcapop.f -quiet
|
||||
* -dumpbase pcapop.f -O -version -fversion -o pcapop.s
|
||||
* GNU F77 version 2.95 19990728 (release) (sparc-sun-solaris2.6) compiled
|
||||
* by GNU C version 2.95 19990728 (release).
|
||||
* GNU Fortran Front End version 0.5.25 19990728 (release)
|
||||
* pcapop.f: In subroutine `pcapop':
|
||||
* pcapop.f:291: Internal compiler error in `final_scan_insn', at
|
||||
* final.c:2920
|
||||
* Please submit a full bug report.
|
||||
* See <URL:http://egcs.cygnus.com/faq.html#bugreport> for instructions.
|
||||
|
||||
C* PCAPOP
|
||||
SUBROUTINE PCAPOP(M1,M2,L1,L2,NMEM,N1,N2,IB,IBB,K3,TF,TS,TC,TTO)
|
||||
DIMENSION NVA(6),C(6),I(6)
|
||||
C
|
||||
C CALCUL DES PARAMETRES OPTIMAUX N1 N2 IB IBB
|
||||
C
|
||||
TACC=.035
|
||||
TTRANS=.000004
|
||||
RAD=.000001
|
||||
RMI=.000001
|
||||
RMU=.0000015
|
||||
RDI=.000003
|
||||
RTE=.000003
|
||||
REQ=.000005
|
||||
VY1=3*RTE+RDI+8*REQ+3*(RAD+RMI+RMU)
|
||||
VY2=REQ+2*RAD
|
||||
AR2=M2*(2*(REQ+RMI)+3*RMU+M1*(2*RAD+REQ))
|
||||
C VARIATION DE L1,L2,
|
||||
C
|
||||
TTOTOP=1.E+10
|
||||
N1CO=0
|
||||
N2CO=0
|
||||
IBCO=0
|
||||
IBBCO=0
|
||||
K3CO=0
|
||||
TESOP=0.
|
||||
TCOP=0.
|
||||
TFOP=0.
|
||||
INUN=7
|
||||
INDE=7
|
||||
IF(M1.LT.128)INUN=6
|
||||
IF(M1.LT.64)INUN=5
|
||||
IF(M1.LT.32)INUN=4
|
||||
IF(M2.LT.128)INDE=6
|
||||
IF(M2.LT.64)INDE=5
|
||||
IF(M2.LT.32)INDE=4
|
||||
DO 3 NUN =3,INUN
|
||||
DO 3 NDE=3,INDE
|
||||
N10=2**NUN
|
||||
N20=2**NDE
|
||||
NDIF=(N10-N20)
|
||||
NDIF=IABS(NDIF)
|
||||
C POUR AVOIR CES RESULTATS FAIRE TOURNER LE PROGRAMME VEFFT1
|
||||
TCFFTU=0.
|
||||
IF(N10.EQ.128.AND.N20.EQ.128)TCFFTU=3.35
|
||||
IF(N10.EQ.64.AND.N20.EQ.64)TCFFTU=.70
|
||||
IF(N10.EQ.32.AND.N20.EQ.32)TCFFTU=.138
|
||||
IF(N10.EQ.16.AND.N20.EQ.16)TCFFTU=.0332
|
||||
IF(N10.EQ.8.AND.N20.EQ.8)TCFFTU=.00688
|
||||
IF(NDIF.EQ.64)TCFFTU=1.566
|
||||
IF(NDIF.EQ.96)TCFFTU=.709
|
||||
IF(NDIF.EQ.112)TCFFTU=.349
|
||||
IF(NDIF.EQ.120)TCFFTU=.160
|
||||
IF(NDIF.EQ.32)TCFFTU=.315
|
||||
IF(NDIF.EQ.48)TCFFTU=.154
|
||||
IF(NDIF.EQ.56)TCFFTU=.07
|
||||
IF(NDIF.EQ.16)TCFFTU=.067
|
||||
IF(NDIF.EQ.24)TCFFTU=.030
|
||||
IF(NDIF.EQ.8)TCFFTU=.016
|
||||
N30=N10-L1+1
|
||||
N40=N20-L2+1
|
||||
WW=VY1+N30*VY2
|
||||
NDOU=2*N10*N20
|
||||
IF((N10.LT.L1).OR.(N20.LT.L2)) GOTO 3
|
||||
NB=NMEM-NDOU-N20*(L1-1)
|
||||
NVC=2*N10*(N20-1)+M1
|
||||
IF(NB.LT.(NVC)) GOTO 3
|
||||
CALL VALENT(M1,N30,K1)
|
||||
CALL VALENT(M2,N40,K2)
|
||||
IS=K1/2
|
||||
IF((2*IS).NE.K1)K1=K1+1
|
||||
TFF=TCFFTU*K1*K2
|
||||
CALL VALENT(M2,N40,JOFI)
|
||||
IF(NB.GE.(K1*N20*N30+2*N20*(L1-1))) GOTO 4
|
||||
TIOOP=1.E+10
|
||||
IC=1
|
||||
18 IB1=2*IC
|
||||
MAX=(NB-2*N20*(L1-1))/(N20*N30)
|
||||
IN=MAX/2
|
||||
IF(MAX.NE.2*IN) MAX=MAX-1
|
||||
K3=K1/IB1
|
||||
IBB1=K1-K3*IB1
|
||||
IOFI=M1/(IB1*N30)
|
||||
IRZ=0
|
||||
IF(IOFI*IB1*N30.EQ.M1) GOTO1234
|
||||
IRZ=1
|
||||
IOFI=IOFI+1
|
||||
IF(IBB1.EQ.0) GOTO 1234
|
||||
IF(M1.EQ.((IOFI-1)*IB1*N30+IBB1*N30)) GOTO 1233
|
||||
IRZ=2
|
||||
GOTO 1234
|
||||
1233 IRZ=3
|
||||
1234 IBX1=IBB1
|
||||
IF(IBX1.EQ.0)IBX1=IB1
|
||||
AR1=M2*(2*(RAD+RMI+RMU+REQ)+(M1-(IOFI-1)*IB1*N30)*2*(REQ+RAD))
|
||||
%+M2*(3*(REQ+RMU+RAD)+4*RMI+(M1-(IOFI-1)*IB1*N30)*(2*RAD+REQ)
|
||||
%+(IOFI-1)*IB1*N30*(2*RMI+REQ+RAD))
|
||||
AR5=(JOFI-1)*(N20-L2)*(M1-(IOFI-1)*IB1*N30)*(2*(RAD+RMU)+REQ)
|
||||
%*IOFI+(M2-(JOFI-1)*N40+L2-2)*(M1-(IOFI-1)*IB1*N30)*(2*(RAD+RMU
|
||||
%)+REQ)*IOFI
|
||||
WQ=((IOFI-1)*IB1+IBX1)*JOFI*WW
|
||||
AT1=N20*WQ
|
||||
AT2=N40*WQ
|
||||
QW=JOFI*(VY1+VY2*IB1*N30)
|
||||
AT3=IOFI*N40*QW
|
||||
AT4=(IOFI-1)*N40*QW
|
||||
AT5=JOFI*((IOFI-1)*N40*(IB1/IBX1)*(VY1+IBX1*N30*VY2)
|
||||
%+N40*((IB1/IBX1)*(IOFI-1)+1)*(VY1+IBX1*N30*VY2))
|
||||
AT6=JOFI*((IOFI-1)*N40*(IB1/2)*(VY1+2*N30*VY2)+N40*(
|
||||
%IB1*(IOFI-1)/2+IBX1/2)*(VY1+2*N30*VY2))
|
||||
T1=JOFI*N20*(L1-1)*REQ
|
||||
T2=M1*(L2-1)*REQ
|
||||
T3=JOFI*N20*IBX1*N30*(RAD+REQ)
|
||||
T4=JOFI*((IOFI-1)*IB1*N30*N20*(2*RMI+REQ)+IBX1*N30*N20*(2*RMI+R
|
||||
%EQ))
|
||||
T5=JOFI*((IOFI-1)*IB1/2+IBX1/2)*N20*N30*(2*RAD+REQ)
|
||||
T6=2*JOFI*(((IOFI-1)*IB1+IBX1)*N20)*((5*(RMI+RMU)+4*RAD
|
||||
%)+(L1-1)*(2*RAD+REQ)+N30*(2*RAD+REQ))
|
||||
T7=JOFI*2*((IOFI-1)*IB1+IBX1)*(L1-1)*(2*RAD+REQ)
|
||||
T8=JOFI*N10*N20*((IOFI-1)*IB1/2+IBX1/2)*(3*REQ+9*RAD+4*RMU+RMI)
|
||||
T9=N10*N20*JOFI*((IOFI-1)*IB1/2+IBX1/2)*(REQ+RMI)+M1*M2*(REQ+R
|
||||
%DI+2*RAD)
|
||||
T10=JOFI*((IOFI-1)*IB1/2+IBX1/2)*2*(3*RMU+2*(RMI+RAD)+N40*(3*RMI
|
||||
%+4*RMU+3*(RAD+REQ)+N30*(2*RAD+REQ)))
|
||||
POI=JOFI
|
||||
IF(POI.LE.2)POI=2
|
||||
TNRAN=(N40+(POI-2)*N20+(M2-(JOFI-1)*N40+L2-1))*(RMI+RMU+RAD
|
||||
%+REQ+N30*(2*RAD+2*REQ)*(IB1*(IOFI-1)+IBX1))
|
||||
IF(TNRAN.LT.0.)TNRAN=0.
|
||||
TCPU=T1+T2+T3+T4+T5+T6+T7+T8+T9+T10+TNRAN
|
||||
NVA(1)=N40
|
||||
NVA(2)=N40
|
||||
NVA(3)=N20
|
||||
NVA(4)=N20
|
||||
NVA(5)=M2-(JOFI-1)*N40
|
||||
NVA(6)=NVA(5)
|
||||
C(1)=FLOAT(IB1*N30)/FLOAT(M1)
|
||||
C(2)=FLOAT(M1-(IOFI-1)*IB1*N30)/FLOAT(M1)
|
||||
C(3)=C(1)
|
||||
C(4)=C(2)
|
||||
C(5)=C(1)
|
||||
C(6)=C(2)
|
||||
K=1
|
||||
P1=FLOAT(NB)/FLOAT(M1)
|
||||
10 IP1=P1
|
||||
I(K)=1
|
||||
IF(IP1.GE.NVA(K)) GOTO 7
|
||||
P2=P1
|
||||
IP2=P2
|
||||
8 P2=P2-FLOAT(IP2)*C(K)
|
||||
IP2=P2
|
||||
IF(IP2.EQ.0) GOTO 3
|
||||
IP1=IP1+IP2
|
||||
I(K)=I(K)+1
|
||||
IF(IP1.GE.NVA(K))GOTO 7
|
||||
GOTO 8
|
||||
7 IF(K.EQ.6) GOTO 11
|
||||
K=K+1
|
||||
GOTO 10
|
||||
11 IP1=0
|
||||
IP2=0
|
||||
IP3=0
|
||||
POFI=JOFI
|
||||
IF(POFI.LE.2)POFI=2
|
||||
TIOL=(I(2)+(IOFI-1)*I(1)+(POFI-2)*(IOFI-1)*I(3)+(POFI-
|
||||
%2)*I(4)+(IOFI-1)*I(5)+I(6))*TACC+(IOFI*M1*N40+(POFI-2)*IOFI*
|
||||
%M1*N20+(M2-(JOFI-1)*N40+L2-1)*M1*IOFI)*TTRANS
|
||||
IF(IBB1.EQ.0) GOTO 33
|
||||
IF(IB1.EQ.IBB1) GOTO 33
|
||||
IF(IBB1.EQ.2)GOTO 34
|
||||
IP3=1
|
||||
INL=NMEM/((IOFI-1)*IB1*N30+IBB1*N30)
|
||||
55 IF(INL.GT.N40)INL=N40
|
||||
GOTO 35
|
||||
33 IF(IB1.GT.2) GOTO 36
|
||||
IF((M1-(IOFI-1)*IB1*N30).GE.N30) GOTO 36
|
||||
34 IP1=1
|
||||
INL=NMEM/(2*M1-(IOFI-1)*IB1*N30)
|
||||
GOTO 55
|
||||
36 IP2=1
|
||||
INL=NMEM/(IOFI*IB1*N30)
|
||||
IF(INL.GT.N40)INL=N40
|
||||
35 CALL VALENT(N40,INL,KN1)
|
||||
CALL VALENT(M2-(JOFI-1)*N40,INL,KN2)
|
||||
CALL VALENT(INL*IBB1,IB1,KN3)
|
||||
CALL VALENT((N40-(KN1-1)*INL)*IBB1,IB1,KN4)
|
||||
IF((IP1+IP2+IP3).NE.1) CALL ERMESF(14)
|
||||
TIO1=0.
|
||||
IF(IP3.EQ.1)TIO1=N30*M2*TTRANS*(IB1*(IOFI-1)+IBB1)
|
||||
IF(IP1.EQ.1)TIO1=M1*M2*TTRANS
|
||||
IF(IP2.EQ.1) TIO1=(IB1*N30*M2*IOFI*TTRANS)
|
||||
TTIO=2.*TIO1+(KN1*IOFI*(JOFI-1)+KN2*IOFI+(KN1-1)*(
|
||||
%JOFI-1)+IOFI*(JOFI-1)+KN2-1.+IOFI+(KN1*(JOFI-1)+KN2))*TACC
|
||||
%+M1*M2*TTRANS+TIOL
|
||||
IF((IP1.EQ.1).AND.(IRZ.EQ.0))TCPU=TCPU+AT1+AT2+AT3
|
||||
IF((IP1.EQ.1).AND.(IRZ.NE.0))TCPU=TCPU+AT1+AT2+AT4+AR1
|
||||
IF((IP2.EQ.1).AND.(IRZ.EQ.0))TCPU=TCPU+AT1+AT2+AT3
|
||||
IF((IP2.EQ.1).AND.(IRZ.NE.0))TCPU=TCPU+AT1+AT2+AT3+AR2
|
||||
IFOIS=IB1/IBX1
|
||||
IF((IP3.EQ.1).AND.(IFOIS*IBX1.EQ.IB1))TCPU=TCPU+AT1+AT2+AT5+AR2
|
||||
IF((IP3.EQ.1).AND.(IFOIS*IBX1.NE.IB1))TCPU=TCPU+AT1+AT2+AT6+AR2
|
||||
IF((IP1.EQ.1).AND.(IRZ.EQ.1))TCPU=TCPU+AR5
|
||||
IF((IP1.EQ.1).AND.(IRZ.EQ.2))TCPU=TCPU+AR5
|
||||
TTIOG=TTIO+TCPU
|
||||
IF(TTIOG.LE.0.) GOTO 99
|
||||
IF(TTIOG.GE.TIOOP) GOTO 99
|
||||
IBOP=IB1
|
||||
IBBOP=IBB1
|
||||
K3OP=K3
|
||||
TIOOP=TTIOG
|
||||
TIOOP1=TTIO
|
||||
TIOOP2=TCPU
|
||||
99 IF(IB1.GE.MAX)GOTO17
|
||||
IC=IC+1
|
||||
GOTO 18
|
||||
4 T1=JOFI*N20*(L1-1)*REQ
|
||||
T2=M1*(L2-1)*REQ
|
||||
T3=JOFI*N20*N30*(RAD+REQ)*K1
|
||||
T4=JOFI*(K1*N30*N20*(2*RMI+REQ))
|
||||
T5=JOFI*N20*N30*(2*RAD+REQ)*K1/2
|
||||
T6=2*JOFI*(K1*N20)*((5*RMI+RMU)+4*RAD+(L1-1)*(2*RAD+REQ)+N30*2*
|
||||
%RAD+REQ)
|
||||
T7=JOFI*2*K1*(L1-1)*(2*RAD+REQ)
|
||||
T9=JOFI*N10*N20*K1*(REQ+RMI)/2+M1*M2*(REQ+RDI+2*RAD)
|
||||
T8=JOFI*N10*N20*K1*(3*REQ+9*RAD+4*RMU+RMI)/2
|
||||
T10=JOFI*K1*(3*RMU+2*(RMI+RAD)+N40*(3*RMI
|
||||
%+4*RMU+3*(RAD+REQ)+N30*(2*RAD+REQ)))
|
||||
PIO=JOFI
|
||||
IF(PIO.LE.2)PIO=2
|
||||
TNR=(N40+(PIO-2)*N20+(M2-(JOFI-1)*N40+L2-1))*(RMU+RMI+RAD+REQ+
|
||||
%N30*(2*RAD+2*REQ)*K1)
|
||||
IF(TNR.LE.0.)TNR=0.
|
||||
BT1=JOFI*N20*WW*K1
|
||||
BT2=JOFI*N40*WW*K1
|
||||
BT3=JOFI*N40*(VY1+K1*N30*VY2)
|
||||
BR1=M2*(2*(RAD+RMI+RMU+REQ)+(M1*2*(REQ+RAD)))+M2*(3*(
|
||||
$REQ+RAD+RMU)+4*(RMI)+M1*(2*(RAD)+REQ))
|
||||
BR2=M2*(2*(REQ+RMI)+3*RMU+M1*(2*RAD+REQ))
|
||||
TCPU=T1+T2+T3+T4+T5+T6+T7+T8+T9+T10
|
||||
TCPU=TCPU+TNR+BT1+BT2
|
||||
LIOF=M1/(N30)
|
||||
IRZ=0
|
||||
IF(LIOF*N30.EQ.M1) GOTO 2344
|
||||
IRZ=1
|
||||
2344 IF(IRZ.EQ.0)TCPU=TCPU+BT3
|
||||
IF(IRZ.NE.0)TCPU=TCPU+BT3+BR2
|
||||
TIOOP=2.*FLOAT(M1)*FLOAT(M2)*TTRANS+2.*FLOAT(K2)*TACC+TCPU
|
||||
IBOP=1
|
||||
IBBOP=0
|
||||
K3OP=1
|
||||
TIOOP2=TCPU
|
||||
TIOOP1=TIOOP-TCPU
|
||||
17 TTOT=TIOOP+TFF
|
||||
IF(TTOT.LE.0.) GOTO 3
|
||||
IF(TTOT.GE.TTOTOP)GOTO3
|
||||
N1CO=N10
|
||||
N2CO=N20
|
||||
IBCO=IBOP
|
||||
IBBCO=IBBOP
|
||||
K3CO=K3OP
|
||||
TTOTOP=TTOT
|
||||
TESOP=TIOOP1
|
||||
TCOP=TIOOP2
|
||||
TFOP=TFF
|
||||
3 CONTINUE
|
||||
|
||||
C
|
||||
N1=N1CO
|
||||
N2=N2CO
|
||||
TTO=TTOTOP
|
||||
IB=IBCO
|
||||
IBB=IBBCO
|
||||
K3=K3CO
|
||||
TC=TCOP
|
||||
TS=TESOP
|
||||
TF=TFOP
|
||||
TT=TCOP+TFOP
|
||||
TWER=TTO-TT
|
||||
IF(N1.EQ.0.OR.N2.EQ.0) CALL OUTSTR(0,'PAS DE PLACE MEMOIRE SUFFISA
|
||||
$NTE POUR UNE MISE EN OEUVRE PAR BLOCS$')
|
||||
IF(IB.NE.1)RETURN
|
||||
IHJ=(M1/(N1-L1+1))
|
||||
IF(IHJ*(N1-L1+1).NE.M1)IHJ=IHJ+1
|
||||
IHJ1=IHJ/2
|
||||
IF(IHJ1*2.NE.IHJ)GOTO7778
|
||||
IB=IHJ
|
||||
IBB=0
|
||||
RETURN
|
||||
7778 IB=IHJ+1
|
||||
IBB=0
|
||||
RETURN
|
||||
END
|
||||
23
gcc/testsuite/gfortran.dg/g77/19990905-2.f
Normal file
23
gcc/testsuite/gfortran.dg/g77/19990905-2.f
Normal file
@ -0,0 +1,23 @@
|
||||
c { dg-do compile }
|
||||
* =watson11.f in Burley's g77 test suite.
|
||||
* Probably originally submitted by Ian Watson.
|
||||
* Too small to worry about copyright issues, IMO, since it
|
||||
* doesn't do anything substantive.
|
||||
SUBROUTINE OUTDNS(A,B,LCONV)
|
||||
IMPLICIT REAL*8(A-H,O-Z),INTEGER*4(I-N)
|
||||
COMMON/ARRAYS/Z(64,8),AB(30,30),PAIRS(9,9),T(9,9),TEMP(9,9),C1(3),
|
||||
> C2(3),AA(30),BB(30)
|
||||
EQUIVALENCE (X1,C1(1)),(Y1,C1(2)),(Z1,C1(3))
|
||||
EQUIVALENCE (X2,C2(1)),(Y2,C2(2)),(Z2,C2(3))
|
||||
COMMON /CONTRL/
|
||||
> SHIFT,CONV,SCION,DIVERG,
|
||||
> IOPT,KCNDO,KINDO,KMINDO,I2EINT,KOHNO,KSLATE,
|
||||
> N,NG,NUMAT,NSEK,NELECS,NIT,OCCA,OCCB,NOLDAT,NOLDFN
|
||||
INTEGER*4 OCCA,OCCB
|
||||
DIMENSION W(N),A(N,N),B(N,N)
|
||||
DIMENSION BUF(100)
|
||||
occb=5
|
||||
ENTRY INDNS (A,B)
|
||||
40 READ(IREAD) BUF
|
||||
STOP
|
||||
END
|
||||
6
gcc/testsuite/gfortran.dg/g77/20000412-1.f
Normal file
6
gcc/testsuite/gfortran.dg/g77/20000412-1.f
Normal file
@ -0,0 +1,6 @@
|
||||
c { dg-do compile }
|
||||
subroutine aap(k)
|
||||
equivalence (i,r)
|
||||
i = k
|
||||
print*,r
|
||||
end
|
||||
22
gcc/testsuite/gfortran.dg/g77/20000511-1.f
Normal file
22
gcc/testsuite/gfortran.dg/g77/20000511-1.f
Normal file
@ -0,0 +1,22 @@
|
||||
c { dg-do compile }
|
||||
subroutine saxpy(n,sa,sx,incx,sy,incy)
|
||||
C
|
||||
C constant times a vector plus a vector.
|
||||
C uses unrolled loop for increments equal to one.
|
||||
C jack dongarra, linpack, 3/11/78.
|
||||
C modified 12/3/93, array(1) declarations changed to array(*)
|
||||
C
|
||||
real sx(*),sy(*),sa
|
||||
integer i,incx,incy,ix,iy,m,mp1,n
|
||||
C
|
||||
C -ffast-math ICE provoked by this conditional
|
||||
if(sa /= 0.0)then
|
||||
C
|
||||
C code for both increments equal to 1
|
||||
C
|
||||
do i= 1,n
|
||||
sy(i)= sy(i)+sa*sx(i)
|
||||
enddo
|
||||
endif
|
||||
return
|
||||
end
|
||||
62
gcc/testsuite/gfortran.dg/g77/20000511-2.f
Normal file
62
gcc/testsuite/gfortran.dg/g77/20000511-2.f
Normal file
@ -0,0 +1,62 @@
|
||||
c { dg-do compile }
|
||||
subroutine sgbcon(norm,n,kl,ku,ab,ldab,ipiv,anorm,rcond,work,iwork
|
||||
&,info)
|
||||
C
|
||||
C -- LAPACK routine (version 3.0) --
|
||||
C Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
|
||||
C Courant Institute, Argonne National Lab, and Rice University
|
||||
C September 30, 1994
|
||||
C
|
||||
C .. Scalar Arguments ..
|
||||
character norm
|
||||
integer info,kl,ku,ldab,n
|
||||
real anorm,rcond
|
||||
C ..
|
||||
C .. Array Arguments ..
|
||||
integer ipiv(n),iwork(n)
|
||||
real ab(ldab,n),work(n)
|
||||
C ..
|
||||
C
|
||||
C Purpose
|
||||
C =======
|
||||
C demonstrate g77 bug at -O -funroll-loops
|
||||
C =====================================================================
|
||||
C
|
||||
C .. Parameters ..
|
||||
real one,zero
|
||||
parameter(one= 1.0e+0,zero= 0.0e+0)
|
||||
C ..
|
||||
C .. Local Scalars ..
|
||||
logical lnoti,onenrm
|
||||
character normin
|
||||
integer ix,j,jp,kase,kase1,kd,lm
|
||||
real ainvnm,scale,smlnum,t
|
||||
C ..
|
||||
C .. External Functions ..
|
||||
logical lsame
|
||||
integer isamax
|
||||
real sdot,slamch
|
||||
externallsame,isamax,sdot,slamch
|
||||
C ..
|
||||
C .. External Subroutines ..
|
||||
externalsaxpy,slacon,slatbs,srscl,xerbla
|
||||
C ..
|
||||
C .. Executable Statements ..
|
||||
C
|
||||
C Multiply by inv(L).
|
||||
C
|
||||
do j= 1,n-1
|
||||
C the following min() intrinsic provokes this bug
|
||||
lm= min(kl,n-j)
|
||||
jp= ipiv(j)
|
||||
t= work(jp)
|
||||
if(jp.ne.j)then
|
||||
C but only when combined with this if block
|
||||
work(jp)= work(j)
|
||||
work(j)= t
|
||||
endif
|
||||
C and this subroutine call
|
||||
call saxpy(lm,-t,ab(kd+1,j),1,work(j+1),1)
|
||||
enddo
|
||||
return
|
||||
end
|
||||
17
gcc/testsuite/gfortran.dg/g77/20000518.f
Normal file
17
gcc/testsuite/gfortran.dg/g77/20000518.f
Normal file
@ -0,0 +1,17 @@
|
||||
c { dg-do compile }
|
||||
SUBROUTINE SORG2R( K, A, N, LDA )
|
||||
* ICE in `verify_wide_reg_1', at flow.c:2605 at -O2
|
||||
* g77 version 2.96 20000515 (experimental) on i686-pc-linux-gnu
|
||||
*
|
||||
* Originally derived from LAPACK 3.0 test suite failure.
|
||||
*
|
||||
* David Billinghurst, (David.Billinghurst@riotinto.com.au)
|
||||
* 18 May 2000
|
||||
INTEGER I, K, LDA, N
|
||||
REAL A( LDA, * )
|
||||
DO I = K, 1, -1
|
||||
IF( I.LT.N ) A( I, I ) = 1.0
|
||||
A( I, I ) = 1.0
|
||||
END DO
|
||||
RETURN
|
||||
END
|
||||
29
gcc/testsuite/gfortran.dg/g77/20000601-1.f
Normal file
29
gcc/testsuite/gfortran.dg/g77/20000601-1.f
Normal file
@ -0,0 +1,29 @@
|
||||
c { dg-do compile }
|
||||
SUBROUTINE SGBTRF( M, KL, KU, AB, LDAB )
|
||||
|
||||
* PR fortran/275
|
||||
* ICE in `change_address', at emit-rtl.c:1589 with -O1 and above
|
||||
* g77 version 2.96 20000530 (experimental) on mips-sgi-irix6.5/-mabi=64
|
||||
*
|
||||
* Originally derived from LAPACK 3.0 test suite failure.
|
||||
*
|
||||
* David Billinghurst, (David.Billinghurst@riotinto.com.au)
|
||||
* 1 June 2000
|
||||
|
||||
INTEGER KL, KU, LDAB, M
|
||||
REAL AB( LDAB, * )
|
||||
|
||||
INTEGER J, JB, JJ, JP, KV, KM
|
||||
REAL WORK13(65,64), WORK31(65,64)
|
||||
KV = KU + KL
|
||||
DO J = 1, M
|
||||
JB = MIN( 1, M-J+1 )
|
||||
DO JJ = J, J + JB - 1
|
||||
KM = MIN( KL, M-JJ )
|
||||
JP = KM+1
|
||||
CALL SSWAP( JB, AB( KV+1+JJ-J, J ), LDAB-1,
|
||||
$ AB( KV+JP+JJ-J, J ), LDAB-1 )
|
||||
END DO
|
||||
END DO
|
||||
RETURN
|
||||
END
|
||||
28
gcc/testsuite/gfortran.dg/g77/20000601-2.f
Normal file
28
gcc/testsuite/gfortran.dg/g77/20000601-2.f
Normal file
@ -0,0 +1,28 @@
|
||||
c { dg-do compile }
|
||||
SUBROUTINE SGBTRF( M, KL, KU, AB, LDAB )
|
||||
|
||||
* Slightly modified version of 20000601-1.f that still ICES with
|
||||
* CVS 20010118 g77 on mips-sgi-irix6.5/-mabi=64.
|
||||
*
|
||||
* Originally derived from LAPACK 3.0 test suite failure.
|
||||
*
|
||||
* David Billinghurst, (David.Billinghurst@riotinto.com.au)
|
||||
* 18 January 2001
|
||||
|
||||
INTEGER KL, KU, LDAB, M
|
||||
REAL AB( LDAB, * )
|
||||
|
||||
INTEGER J, JB, JJ, JP, KV, KM, F
|
||||
REAL WORK13(65,64), WORK31(65,64)
|
||||
KV = KU + KL
|
||||
DO J = 1, M
|
||||
JB = MIN( 1, M-J+1 )
|
||||
DO JJ = J, J + JB - 1
|
||||
KM = MIN( KL, M-JJ )
|
||||
JP = F( KM+1, AB( KV+1, JJ ) )
|
||||
CALL SSWAP( JB, AB( KV+1+JJ-J, J ), LDAB-1,
|
||||
$ AB( KV+JP+JJ-J, J ), LDAB-1 )
|
||||
END DO
|
||||
END DO
|
||||
RETURN
|
||||
END
|
||||
12
gcc/testsuite/gfortran.dg/g77/20000629-1.f
Normal file
12
gcc/testsuite/gfortran.dg/g77/20000629-1.f
Normal file
@ -0,0 +1,12 @@
|
||||
c { dg-do compile }
|
||||
SUBROUTINE MIST(N, BETA)
|
||||
IMPLICIT REAL*8 (A-H,O-Z)
|
||||
INTEGER IA, IQ, M1
|
||||
DIMENSION BETA(N)
|
||||
DO 80 IQ=1,M1
|
||||
IF (BETA(IQ).EQ.0.0D0) GO TO 120
|
||||
80 CONTINUE
|
||||
120 IF (IQ.NE.1) GO TO 160
|
||||
160 M1 = IA(IQ)
|
||||
RETURN
|
||||
END
|
||||
10
gcc/testsuite/gfortran.dg/g77/20000630-2.f
Normal file
10
gcc/testsuite/gfortran.dg/g77/20000630-2.f
Normal file
@ -0,0 +1,10 @@
|
||||
c { dg-do compile }
|
||||
SUBROUTINE CHOUT(CHR,ICNT)
|
||||
C ICE: failed assertion `expr != NULL'
|
||||
C Reduced version of GNATS PR fortran/329 from trond.bo@dnmi.no
|
||||
INTEGER CHR(ICNT)
|
||||
CHARACTER*255 BUF
|
||||
BUF(1:1)=CHAR(CHR(1))
|
||||
CALL FPUTC(1,BUF(1:1))
|
||||
RETURN
|
||||
END
|
||||
10
gcc/testsuite/gfortran.dg/g77/20010115.f
Normal file
10
gcc/testsuite/gfortran.dg/g77/20010115.f
Normal file
@ -0,0 +1,10 @@
|
||||
c { dg-do compile }
|
||||
* GNATS PR Fortran/1636
|
||||
PRINT 42, 'HELLO'
|
||||
42 FORMAT(A)
|
||||
CALL WORLD
|
||||
END
|
||||
SUBROUTINE WORLD
|
||||
PRINT 42, 'WORLD'
|
||||
42 FORMAT(A)
|
||||
END
|
||||
9
gcc/testsuite/gfortran.dg/g77/20010321-1.f
Normal file
9
gcc/testsuite/gfortran.dg/g77/20010321-1.f
Normal file
@ -0,0 +1,9 @@
|
||||
c { dg-do compile }
|
||||
# 1 "20010321-1.f"
|
||||
SUBROUTINE TWOEXP
|
||||
# 1 "include/implicit.h" 1 3
|
||||
IMPLICIT DOUBLE PRECISION (A-H)
|
||||
# 3 "20010321-1.f" 2 3
|
||||
LOGICAL ANTI
|
||||
ANTI = .FALSE.
|
||||
END
|
||||
7
gcc/testsuite/gfortran.dg/g77/20010426.f
Normal file
7
gcc/testsuite/gfortran.dg/g77/20010426.f
Normal file
@ -0,0 +1,7 @@
|
||||
c { dg-do compile }
|
||||
function f(c)
|
||||
implicit none
|
||||
real*8 c, f
|
||||
f = sqrt(c)
|
||||
return
|
||||
end
|
||||
22
gcc/testsuite/gfortran.dg/g77/20020307-1.f
Normal file
22
gcc/testsuite/gfortran.dg/g77/20020307-1.f
Normal file
@ -0,0 +1,22 @@
|
||||
c { dg-do compile }
|
||||
SUBROUTINE SWEEP
|
||||
PARAMETER(MAXDIM=4,MAXVEC=4**3*8,MAXT=20)
|
||||
REAL*8 B,W1,W2,BNORM,BINV,WT,W0,C1,C2,R1,R2
|
||||
DIMENSION B(MAXVEC,0:3),W1(MAXVEC,0:3),W2(MAXVEC,0:3)
|
||||
DIMENSION BNORM(MAXVEC),BINV(MAXVEC),WT(MAXVEC),W0(MAXVEC)
|
||||
DIMENSION C1(MAXVEC),C2(MAXVEC),R1(MAXVEC),R2(MAXVEC)
|
||||
DO 200 ILAT=1,2**IDIM
|
||||
DO 200 I1=1,IDIM
|
||||
DO 220 I2=1,IDIM
|
||||
CALL INTACT(ILAT,I1,I1,W1)
|
||||
220 CONTINUE
|
||||
DO 310 IATT=1,IDIM
|
||||
DO 311 I=1,100
|
||||
WT(I)=ONE + C1(I)*LOG(EPS+R1(I))
|
||||
IF( R2(I)**2 .LE. (ONE-WT(I)**2) )THEN
|
||||
W0(I)=WT(I)
|
||||
ENDIF
|
||||
311 CONTINUE
|
||||
310 CONTINUE
|
||||
200 CONTINUE
|
||||
END
|
||||
9
gcc/testsuite/gfortran.dg/g77/8485.f
Normal file
9
gcc/testsuite/gfortran.dg/g77/8485.f
Normal file
@ -0,0 +1,9 @@
|
||||
c { dg-do compile }
|
||||
C Extracted from PR fortran/8485
|
||||
PARAMETER (PPMULT = 1.0E5)
|
||||
INTEGER*8 NWRONG
|
||||
PARAMETER (NWRONG = 8)
|
||||
PARAMETER (DDMULT = PPMULT * NWRONG)
|
||||
PRINT 10, DDMULT
|
||||
10 FORMAT (F10.3)
|
||||
END
|
||||
104
gcc/testsuite/gfortran.dg/g77/960317-1.f
Normal file
104
gcc/testsuite/gfortran.dg/g77/960317-1.f
Normal file
@ -0,0 +1,104 @@
|
||||
c { dg-do compile }
|
||||
* Date: Sat, 16 Mar 1996 19:58:37 -0500 (EST)
|
||||
* From: Kate Hedstrom <kate@ahab.Rutgers.EDU>
|
||||
* To: burley@gnu.ai.mit.edu
|
||||
* Subject: g77 bug in assign
|
||||
*
|
||||
* I found some files in the NCAR graphics source code which used to
|
||||
* compile with g77 and now don't. All contain the following combination
|
||||
* of "save" and "assign". It fails on a Sun running SunOS 4.1.3 and a
|
||||
* Sun running SunOS 5.5 (slightly older g77), but compiles on an
|
||||
* IBM/RS6000:
|
||||
*
|
||||
C
|
||||
SUBROUTINE QUICK
|
||||
SAVE
|
||||
C
|
||||
ASSIGN 101 TO JUMP ! { dg-warning "Obsolete: ASSIGN" "" }
|
||||
101 Continue
|
||||
C
|
||||
RETURN
|
||||
END
|
||||
*
|
||||
* Everything else in the NCAR distribution compiled, including quite a
|
||||
* few C routines.
|
||||
*
|
||||
* Kate
|
||||
*
|
||||
*
|
||||
* nemo% g77 -v -c quick.f
|
||||
* gcc -v -c -xf77 quick.f
|
||||
* Reading specs from /usr/local/lib/gcc-lib/sparc-sun-sunos4.1.3/2.7.2/specs
|
||||
* gcc version 2.7.2
|
||||
* /usr/local/lib/gcc-lib/sparc-sun-sunos4.1.3/2.7.2/f771 quick.f -fset-g77-defaults -quiet -dumpbase quick.f -version -fversion -o /usr/tmp/cca24166.s
|
||||
* GNU F77 version 2.7.2 (sparc) compiled by GNU C version 2.7.1.
|
||||
* GNU Fortran Front End version 0.5.18-960314 compiled: Mar 16 1996 14:28:11
|
||||
* gcc: Internal compiler error: program f771 got fatal signal 11
|
||||
*
|
||||
*
|
||||
* nemo% gdb /usr/local/lib/gcc-lib/*/*/f771 core
|
||||
* GDB is free software and you are welcome to distribute copies of it
|
||||
* under certain conditions; type "show copying" to see the conditions.
|
||||
* There is absolutely no warranty for GDB; type "show warranty" for details.
|
||||
* GDB 4.14 (sparc-sun-sunos4.1.3),
|
||||
* Copyright 1995 Free Software Foundation, Inc...
|
||||
* Core was generated by `f771'.
|
||||
* Program terminated with signal 11, Segmentation fault.
|
||||
* Couldn't read input and local registers from core file
|
||||
* find_solib: Can't read pathname for load map: I/O error
|
||||
*
|
||||
* Couldn't read input and local registers from core file
|
||||
* #0 0x21aa4 in ffecom_sym_transform_assign_ (s=???) at f/com.c:7881
|
||||
* 7881 if ((ffesymbol_save (s) || ffe_is_saveall ())
|
||||
* (gdb) where
|
||||
* #0 0x21aa4 in ffecom_sym_transform_assign_ (s=???) at f/com.c:7881
|
||||
* Error accessing memory address 0xefffefcc: Invalid argument.
|
||||
* (gdb)
|
||||
*
|
||||
*
|
||||
* ahab% g77 -v -c quick.f
|
||||
* gcc -v -c -xf77 quick.f
|
||||
* Reading specs from /usr/local/lib/gcc-lib/sparc-sun-solaris2.5/2.7.2/specs
|
||||
* gcc version 2.7.2
|
||||
* /usr/local/lib/gcc-lib/sparc-sun-solaris2.5/2.7.2/f771 quick.f -quiet -dumpbase quick.f -version -fversion -o /var/tmp/cca003D2.s
|
||||
* GNU F77 version 2.7.2 (sparc) compiled by GNU C version 2.7.2.
|
||||
* GNU Fortran Front End version 0.5.18-960304 compiled: Mar 5 1996 16:12:46
|
||||
* gcc: Internal compiler error: program f771 got fatal signal 11
|
||||
*
|
||||
*
|
||||
* ahab% !gdb
|
||||
* gdb /usr/local/lib/gcc-lib/*/*/f771 core
|
||||
* GDB is free software and you are welcome to distribute copies of it
|
||||
* under certain conditions; type "show copying" to see the conditions.
|
||||
* There is absolutely no warranty for GDB; type "show warranty" for details.
|
||||
* GDB 4.15.1 (sparc-sun-solaris2.4),
|
||||
* Copyright 1995 Free Software Foundation, Inc...
|
||||
* Core was generated by
|
||||
* `/usr/local/lib/gcc-lib/sparc-sun-solaris2.5/2.7.2/f771 quick.f -quiet -dumpbase'.
|
||||
* Program terminated with signal 11, Segmentation fault.
|
||||
* Reading symbols from /usr/lib/libc.so.1...done.
|
||||
* Reading symbols from /usr/lib/libdl.so.1...done.
|
||||
* #0 0x43e04 in ffecom_sym_transform_assign_ (s=0x3a22f8) at f/com.c:7963
|
||||
* Source file is more recent than executable.
|
||||
* 7963 assert (st != NULL);
|
||||
* (gdb) where
|
||||
* #0 0x43e04 in ffecom_sym_transform_assign_ (s=0x3a22f8) at f/com.c:7963
|
||||
* #1 0x38044 in ffecom_expr_ (expr=0x3a23c0, dest_tree=0x0, dest=0x0, dest_used=0x0, assignp=true) at f/com.c:2100
|
||||
* #2 0x489c8 in ffecom_expr_assign_w (expr=0x3a23c0) at f/com.c:10238
|
||||
* #3 0xe9228 in ffeste_R838 (label=0x3a1ba8, target=0x3a23c0) at f/ste.c:2769
|
||||
* #4 0xdae60 in ffestd_stmt_pass_ () at f/std.c:840
|
||||
* #5 0xdc090 in ffestd_exec_end () at f/std.c:1405
|
||||
* #6 0xcb534 in ffestc_shriek_subroutine_ (ok=true) at f/stc.c:4849
|
||||
* #7 0xd8f00 in ffestc_R1225 (name=0x0) at f/stc.c:12307
|
||||
* #8 0xcc808 in ffestc_end () at f/stc.c:5572
|
||||
* #9 0x9fa84 in ffestb_end3_ (t=0x3a19c8) at f/stb.c:3216
|
||||
* #10 0x9f30c in ffestb_end (t=0x3a19c8) at f/stb.c:2995
|
||||
* #11 0x98414 in ffesta_save_ (t=0x3a19c8) at f/sta.c:453
|
||||
* #12 0x997ec in ffesta_second_ (t=0x3a19c8) at f/sta.c:1178
|
||||
* #13 0x8ed84 in ffelex_send_token_ () at f/lex.c:1614
|
||||
* #14 0x8cab8 in ffelex_finish_statement_ () at f/lex.c:946
|
||||
* #15 0x91684 in ffelex_file_fixed (wf=0x397780, f=0x37a560) at f/lex.c:2946
|
||||
* #16 0x107a94 in ffe_file (wf=0x397780, f=0x37a560) at f/top.c:456
|
||||
* #17 0x96218 in yyparse () at f/parse.c:77
|
||||
* #18 0x10beac in compile_file (name=0xdffffaf7 "quick.f") at toplev.c:2239
|
||||
* #19 0x110dc0 in main (argc=9, argv=0xdffff994, envp=0xdffff9bc) at toplev.c:3927
|
||||
21
gcc/testsuite/gfortran.dg/g77/970915-0.f
Normal file
21
gcc/testsuite/gfortran.dg/g77/970915-0.f
Normal file
@ -0,0 +1,21 @@
|
||||
c { dg-do compile }
|
||||
* fixed by patch to safe_from_p to avoid visiting any SAVE_EXPR
|
||||
* node twice in a given top-level call to it.
|
||||
* (JCB com.c patch of 1998-06-04.)
|
||||
|
||||
SUBROUTINE TSTSIG11
|
||||
IMPLICIT COMPLEX (A-Z)
|
||||
EXTERNAL gzi1,gzi2
|
||||
branch3 = sw2 / cw
|
||||
. * ( rdw * (epsh*gzi1(A,B)-gzi2(A,B))
|
||||
. + rdw * (epsh*gzi1(A,B)-gzi2(A,B)) )
|
||||
. + (-1./2. + 2.*sw2/3.) / (sw*cw)
|
||||
. * rdw * (epsh*gzi1(A,B)-gzi2(A,B)
|
||||
. + rdw * (epsh*gzi1(A,B)-gzi2(A,B))
|
||||
. + rdw * (epsh*gzi1(A,B)-gzi2(A,B)) )
|
||||
. * rup * (epsh*gzi1(A,B)-gzi2(A,B)
|
||||
. + rup * (epsh*gzi1(A,B)-gzi2(A,B)) )
|
||||
. * 4.*(3.-tw**2) * gzi2(A,B)
|
||||
. + ((1.+2./tauw)*tw**2-(5.+2./tauw))* gzi1(A,B)
|
||||
RETURN
|
||||
END
|
||||
29
gcc/testsuite/gfortran.dg/g77/980310-1.f
Normal file
29
gcc/testsuite/gfortran.dg/g77/980310-1.f
Normal file
@ -0,0 +1,29 @@
|
||||
c { dg-do compile }
|
||||
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.
|
||||
|
||||
INTEGER N
|
||||
READ(*,*) N
|
||||
SELECT CASE (N)
|
||||
CASE (1:)
|
||||
WRITE(*,*) 'case 1'
|
||||
CASE (0)
|
||||
WRITE(*,*) 'case 0'
|
||||
END SELECT
|
||||
END
|
||||
|
||||
C The relevant change to cure this is:
|
||||
C
|
||||
C Thu Dec 4 06:34:40 1997 Richard Kenner <kenner@vlsi1.ultra.nyu.edu>
|
||||
C
|
||||
C * stmt.c (pushcase_range): Clean up handling of "infinite" values.
|
||||
C
|
||||
|
||||
44
gcc/testsuite/gfortran.dg/g77/980310-2.f
Normal file
44
gcc/testsuite/gfortran.dg/g77/980310-2.f
Normal file
@ -0,0 +1,44 @@
|
||||
c { dg-do compile }
|
||||
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
|
||||
260
gcc/testsuite/gfortran.dg/g77/980310-3.f
Normal file
260
gcc/testsuite/gfortran.dg/g77/980310-3.f
Normal file
@ -0,0 +1,260 @@
|
||||
c { dg-do compile }
|
||||
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/gfortran.dg/g77/980310-4.f
Normal file
348
gcc/testsuite/gfortran.dg/g77/980310-4.f
Normal file
@ -0,0 +1,348 @@
|
||||
c { dg-do compile }
|
||||
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 behavior 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 behavior
|
||||
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
|
||||
22
gcc/testsuite/gfortran.dg/g77/980310-6.f
Normal file
22
gcc/testsuite/gfortran.dg/g77/980310-6.f
Normal file
@ -0,0 +1,22 @@
|
||||
c { dg-do compile }
|
||||
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 '*'.
|
||||
|
||||
51
gcc/testsuite/gfortran.dg/g77/980310-7.f
Normal file
51
gcc/testsuite/gfortran.dg/g77/980310-7.f
Normal file
@ -0,0 +1,51 @@
|
||||
c { dg-do compile }
|
||||
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.
|
||||
40
gcc/testsuite/gfortran.dg/g77/980310-8.f
Normal file
40
gcc/testsuite/gfortran.dg/g77/980310-8.f
Normal file
@ -0,0 +1,40 @@
|
||||
c { dg-do compile }
|
||||
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
|
||||
49
gcc/testsuite/gfortran.dg/g77/980419-2.f
Normal file
49
gcc/testsuite/gfortran.dg/g77/980419-2.f
Normal file
@ -0,0 +1,49 @@
|
||||
c { dg-do compile }
|
||||
c SEGVs in loop.c with -O2.
|
||||
|
||||
character*80 function nxtlin(lun,ierr,itok)
|
||||
character onechr*1,twochr*2,thrchr*3
|
||||
itok=0
|
||||
do while (.true.)
|
||||
read (lun,'(a)',iostat=ierr) nxtlin
|
||||
if (nxtlin(1:1).ne.'#') then
|
||||
ito=0
|
||||
do 10 it=1,79
|
||||
if (nxtlin(it:it).ne.' ' .and. nxtlin(it+1:it+1).eq.' ')
|
||||
$ then
|
||||
itast=0
|
||||
itstrt=0
|
||||
do itt=ito+1,it
|
||||
if (nxtlin(itt:itt).eq.'*') itast=itt
|
||||
enddo
|
||||
itstrt=ito+1
|
||||
do while (nxtlin(itstrt:itstrt).eq.' ')
|
||||
itstrt=itstrt+1
|
||||
enddo
|
||||
if (itast.gt.0) then
|
||||
nchrs=itast-itstrt
|
||||
if (nchrs.eq.1) then
|
||||
onechr=nxtlin(itstrt:itstrt)
|
||||
read (onechr,*) itokn
|
||||
elseif (nchrs.eq.2) then
|
||||
twochr=nxtlin(itstrt:itstrt+1)
|
||||
read (twochr,*) itokn
|
||||
elseif (nchrs.eq.3) then
|
||||
thrchr=nxtlin(itstrt:itstrt+2)
|
||||
read (thrchr,*) itokn
|
||||
elseif (nchrs.eq.4) then
|
||||
thrchr=nxtlin(itstrt:itstrt+3)
|
||||
read (thrchr,*) itokn
|
||||
endif
|
||||
itok=itok+itokn
|
||||
else
|
||||
itok=itok+1
|
||||
endif
|
||||
ito=it+1
|
||||
endif
|
||||
10 continue
|
||||
return
|
||||
endif
|
||||
enddo
|
||||
return
|
||||
end
|
||||
7
gcc/testsuite/gfortran.dg/g77/980424-0.f
Normal file
7
gcc/testsuite/gfortran.dg/g77/980424-0.f
Normal file
@ -0,0 +1,7 @@
|
||||
c { dg-do compile }
|
||||
C crashes in subst_stack_regs_pat on x86-linux, in the "abort();"
|
||||
C within the switch statement.
|
||||
SUBROUTINE C(A)
|
||||
COMPLEX A
|
||||
WRITE(*,*) A.NE.CMPLX(0.0D0)
|
||||
END
|
||||
9
gcc/testsuite/gfortran.dg/g77/980427-0.f
Normal file
9
gcc/testsuite/gfortran.dg/g77/980427-0.f
Normal file
@ -0,0 +1,9 @@
|
||||
c { dg-do compile }
|
||||
c ../../egcs/gcc/f/com.c:938: failed assertion `TREE_CODE (TREE_TYPE (e)) == REAL_TYPE'
|
||||
c Fixed by 28-04-1998 global.c (ffeglobal_ref_progunit_) change.
|
||||
external b
|
||||
call y(b)
|
||||
end
|
||||
subroutine x
|
||||
a = b()
|
||||
end
|
||||
6
gcc/testsuite/gfortran.dg/g77/980729-0.f
Normal file
6
gcc/testsuite/gfortran.dg/g77/980729-0.f
Normal file
@ -0,0 +1,6 @@
|
||||
c { dg-do compile }
|
||||
c Got ICE on Alpha only with -mieee (currently not tested).
|
||||
c Fixed by rth 1998-07-30 alpha.md change.
|
||||
subroutine a(b,c)
|
||||
b = max(b,c)
|
||||
end
|
||||
24
gcc/testsuite/gfortran.dg/g77/981117-1.f
Normal file
24
gcc/testsuite/gfortran.dg/g77/981117-1.f
Normal file
@ -0,0 +1,24 @@
|
||||
c { dg-do compile }
|
||||
* egcs-bugs:
|
||||
* From: Martin Kahlert <martin.kahlert@mchp.siemens.de>
|
||||
* Subject: ICE in g77 from egcs-19981109
|
||||
* Message-Id: <199811101134.MAA29838@keksy.mchp.siemens.de>
|
||||
|
||||
* As of 1998-11-17, fails -O2 -fomit-frame-pointer with
|
||||
* egcs/gcc/testsuite/g77.f-torture/compile/981117-1.f:8: internal error--insn does not satisfy its constraints:
|
||||
* (insn 31 83 32 (set (reg:SF 8 %st(0))
|
||||
* (mult:SF (reg:SF 8 %st(0))
|
||||
* (const_double:SF (mem/u:SF (symbol_ref/u:SI ("*.LC1")) 0) 0 0 1073643520))) 350 {strlensi-3} (nil)
|
||||
* (nil))
|
||||
* ../../egcs/gcc/toplev.c:1390: Internal compiler error in function fatal_insn
|
||||
|
||||
* Fixed sometime before 1998-11-21 -- don't know by which change.
|
||||
|
||||
SUBROUTINE SSPTRD
|
||||
PARAMETER (HALF = 0.5 )
|
||||
DO I = 1, N
|
||||
CALL SSPMV(TAUI)
|
||||
ALPHA = -HALF*TAUI
|
||||
CALL SAXPY(ALPHA)
|
||||
ENDDO
|
||||
END
|
||||
4
gcc/testsuite/gfortran.dg/g77/toon_1.f
Normal file
4
gcc/testsuite/gfortran.dg/g77/toon_1.f
Normal file
@ -0,0 +1,4 @@
|
||||
c { dg-do compile }
|
||||
SUBROUTINE AAP(NOOT)
|
||||
DIMENSION NOOT(*)
|
||||
END
|
||||
Loading…
x
Reference in New Issue
Block a user