diff options
| author | David Billinghurst <David.Billinghurst@riotinto.com> | 2004-07-12 12:49:11 +0000 |
|---|---|---|
| committer | David Billinghurst <billingd@gcc.gnu.org> | 2004-07-12 12:49:11 +0000 |
| commit | 62e39334a08066c17ead2da37ccb9209b2cc8e14 (patch) | |
| tree | 5d54cf67d22510888477cff45d8b50ca97ef734b /gcc | |
| parent | 7fb213d8e955ed3f21defe0d28ab63fe576574bd (diff) | |
| download | gcc-62e39334a08066c17ead2da37ccb9209b2cc8e14.zip gcc-62e39334a08066c17ead2da37ccb9209b2cc8e14.tar.gz gcc-62e39334a08066c17ead2da37ccb9209b2cc8e14.tar.bz2 | |
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
Diffstat (limited to 'gcc')
40 files changed, 2158 insertions, 0 deletions
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index e9d788d..08a38d89 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -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 diff --git a/gcc/testsuite/gfortran.dg/g77/12002.f b/gcc/testsuite/gfortran.dg/g77/12002.f new file mode 100644 index 0000000..609573f --- /dev/null +++ b/gcc/testsuite/gfortran.dg/g77/12002.f @@ -0,0 +1,6 @@ +C PR middle-end/12002 +C {dg-do compile } + COMPLEX TE1 + TE1=-2. + TE1=TE1+TE1 + END diff --git a/gcc/testsuite/gfortran.dg/g77/13060.f b/gcc/testsuite/gfortran.dg/g77/13060.f new file mode 100644 index 0000000..4c1b3e7 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/g77/13060.f @@ -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 diff --git a/gcc/testsuite/gfortran.dg/g77/19990218-0.f b/gcc/testsuite/gfortran.dg/g77/19990218-0.f new file mode 100644 index 0000000..631e741 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/g77/19990218-0.f @@ -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 diff --git a/gcc/testsuite/gfortran.dg/g77/19990305-0.f b/gcc/testsuite/gfortran.dg/g77/19990305-0.f new file mode 100644 index 0000000..9895c7b --- /dev/null +++ b/gcc/testsuite/gfortran.dg/g77/19990305-0.f @@ -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 +* +* %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% diff --git a/gcc/testsuite/gfortran.dg/g77/19990419-0.f b/gcc/testsuite/gfortran.dg/g77/19990419-0.f new file mode 100644 index 0000000..68f4dda --- /dev/null +++ b/gcc/testsuite/gfortran.dg/g77/19990419-0.f @@ -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 diff --git a/gcc/testsuite/gfortran.dg/g77/19990502-0.f b/gcc/testsuite/gfortran.dg/g77/19990502-0.f new file mode 100644 index 0000000..a82f883 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/g77/19990502-0.f @@ -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 diff --git a/gcc/testsuite/gfortran.dg/g77/19990502-1.f b/gcc/testsuite/gfortran.dg/g77/19990502-1.f new file mode 100644 index 0000000..ce5343d --- /dev/null +++ b/gcc/testsuite/gfortran.dg/g77/19990502-1.f @@ -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 diff --git a/gcc/testsuite/gfortran.dg/g77/19990525-0.f b/gcc/testsuite/gfortran.dg/g77/19990525-0.f new file mode 100644 index 0000000..0baa802 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/g77/19990525-0.f @@ -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 diff --git a/gcc/testsuite/gfortran.dg/g77/19990826-1.f b/gcc/testsuite/gfortran.dg/g77/19990826-1.f new file mode 100644 index 0000000..d9dd70b --- /dev/null +++ b/gcc/testsuite/gfortran.dg/g77/19990826-1.f @@ -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 diff --git a/gcc/testsuite/gfortran.dg/g77/19990826-3.f b/gcc/testsuite/gfortran.dg/g77/19990826-3.f new file mode 100644 index 0000000..aeaf443 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/g77/19990826-3.f @@ -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 diff --git a/gcc/testsuite/gfortran.dg/g77/19990905-2.f b/gcc/testsuite/gfortran.dg/g77/19990905-2.f new file mode 100644 index 0000000..7acfb09 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/g77/19990905-2.f @@ -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 diff --git a/gcc/testsuite/gfortran.dg/g77/20000412-1.f b/gcc/testsuite/gfortran.dg/g77/20000412-1.f new file mode 100644 index 0000000..af403ef --- /dev/null +++ b/gcc/testsuite/gfortran.dg/g77/20000412-1.f @@ -0,0 +1,6 @@ +c { dg-do compile } + subroutine aap(k) + equivalence (i,r) + i = k + print*,r + end diff --git a/gcc/testsuite/gfortran.dg/g77/20000511-1.f b/gcc/testsuite/gfortran.dg/g77/20000511-1.f new file mode 100644 index 0000000..fca4bf9 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/g77/20000511-1.f @@ -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 diff --git a/gcc/testsuite/gfortran.dg/g77/20000511-2.f b/gcc/testsuite/gfortran.dg/g77/20000511-2.f new file mode 100644 index 0000000..b3a3ca3 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/g77/20000511-2.f @@ -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 diff --git a/gcc/testsuite/gfortran.dg/g77/20000518.f b/gcc/testsuite/gfortran.dg/g77/20000518.f new file mode 100644 index 0000000..ac25f25 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/g77/20000518.f @@ -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 diff --git a/gcc/testsuite/gfortran.dg/g77/20000601-1.f b/gcc/testsuite/gfortran.dg/g77/20000601-1.f new file mode 100644 index 0000000..d0c05ec --- /dev/null +++ b/gcc/testsuite/gfortran.dg/g77/20000601-1.f @@ -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 diff --git a/gcc/testsuite/gfortran.dg/g77/20000601-2.f b/gcc/testsuite/gfortran.dg/g77/20000601-2.f new file mode 100644 index 0000000..e5b9db7 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/g77/20000601-2.f @@ -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 diff --git a/gcc/testsuite/gfortran.dg/g77/20000629-1.f b/gcc/testsuite/gfortran.dg/g77/20000629-1.f new file mode 100644 index 0000000..dc64144 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/g77/20000629-1.f @@ -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 diff --git a/gcc/testsuite/gfortran.dg/g77/20000630-2.f b/gcc/testsuite/gfortran.dg/g77/20000630-2.f new file mode 100644 index 0000000..b2776bf --- /dev/null +++ b/gcc/testsuite/gfortran.dg/g77/20000630-2.f @@ -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 diff --git a/gcc/testsuite/gfortran.dg/g77/20010115.f b/gcc/testsuite/gfortran.dg/g77/20010115.f new file mode 100644 index 0000000..cce8dbc --- /dev/null +++ b/gcc/testsuite/gfortran.dg/g77/20010115.f @@ -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 diff --git a/gcc/testsuite/gfortran.dg/g77/20010321-1.f b/gcc/testsuite/gfortran.dg/g77/20010321-1.f new file mode 100644 index 0000000..df00319 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/g77/20010321-1.f @@ -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 diff --git a/gcc/testsuite/gfortran.dg/g77/20010426.f b/gcc/testsuite/gfortran.dg/g77/20010426.f new file mode 100644 index 0000000..e4a160c --- /dev/null +++ b/gcc/testsuite/gfortran.dg/g77/20010426.f @@ -0,0 +1,7 @@ +c { dg-do compile } + function f(c) + implicit none + real*8 c, f + f = sqrt(c) + return + end diff --git a/gcc/testsuite/gfortran.dg/g77/20020307-1.f b/gcc/testsuite/gfortran.dg/g77/20020307-1.f new file mode 100644 index 0000000..e675f2c --- /dev/null +++ b/gcc/testsuite/gfortran.dg/g77/20020307-1.f @@ -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 diff --git a/gcc/testsuite/gfortran.dg/g77/8485.f b/gcc/testsuite/gfortran.dg/g77/8485.f new file mode 100644 index 0000000..205f164 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/g77/8485.f @@ -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 diff --git a/gcc/testsuite/gfortran.dg/g77/960317-1.f b/gcc/testsuite/gfortran.dg/g77/960317-1.f new file mode 100644 index 0000000..f9a3ef2 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/g77/960317-1.f @@ -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 diff --git a/gcc/testsuite/gfortran.dg/g77/970915-0.f b/gcc/testsuite/gfortran.dg/g77/970915-0.f new file mode 100644 index 0000000..228248e --- /dev/null +++ b/gcc/testsuite/gfortran.dg/g77/970915-0.f @@ -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 diff --git a/gcc/testsuite/gfortran.dg/g77/980310-1.f b/gcc/testsuite/gfortran.dg/g77/980310-1.f new file mode 100644 index 0000000..3030133 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/g77/980310-1.f @@ -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 + diff --git a/gcc/testsuite/gfortran.dg/g77/980310-2.f b/gcc/testsuite/gfortran.dg/g77/980310-2.f new file mode 100644 index 0000000..829706a --- /dev/null +++ b/gcc/testsuite/gfortran.dg/g77/980310-2.f @@ -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 diff --git a/gcc/testsuite/gfortran.dg/g77/980310-3.f b/gcc/testsuite/gfortran.dg/g77/980310-3.f new file mode 100644 index 0000000..e7e9523 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/g77/980310-3.f @@ -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 diff --git a/gcc/testsuite/gfortran.dg/g77/980310-4.f b/gcc/testsuite/gfortran.dg/g77/980310-4.f new file mode 100644 index 0000000..ee50bc6 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/g77/980310-4.f @@ -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 diff --git a/gcc/testsuite/gfortran.dg/g77/980310-6.f b/gcc/testsuite/gfortran.dg/g77/980310-6.f new file mode 100644 index 0000000..b4b2f1d --- /dev/null +++ b/gcc/testsuite/gfortran.dg/g77/980310-6.f @@ -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 '*'. + diff --git a/gcc/testsuite/gfortran.dg/g77/980310-7.f b/gcc/testsuite/gfortran.dg/g77/980310-7.f new file mode 100644 index 0000000..3cbcbe9 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/g77/980310-7.f @@ -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. diff --git a/gcc/testsuite/gfortran.dg/g77/980310-8.f b/gcc/testsuite/gfortran.dg/g77/980310-8.f new file mode 100644 index 0000000..bafb470 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/g77/980310-8.f @@ -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 diff --git a/gcc/testsuite/gfortran.dg/g77/980419-2.f b/gcc/testsuite/gfortran.dg/g77/980419-2.f new file mode 100644 index 0000000..defda41 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/g77/980419-2.f @@ -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 diff --git a/gcc/testsuite/gfortran.dg/g77/980424-0.f b/gcc/testsuite/gfortran.dg/g77/980424-0.f new file mode 100644 index 0000000..dd6e7a8 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/g77/980424-0.f @@ -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 diff --git a/gcc/testsuite/gfortran.dg/g77/980427-0.f b/gcc/testsuite/gfortran.dg/g77/980427-0.f new file mode 100644 index 0000000..c5c3ade --- /dev/null +++ b/gcc/testsuite/gfortran.dg/g77/980427-0.f @@ -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 diff --git a/gcc/testsuite/gfortran.dg/g77/980729-0.f b/gcc/testsuite/gfortran.dg/g77/980729-0.f new file mode 100644 index 0000000..f0ca9da --- /dev/null +++ b/gcc/testsuite/gfortran.dg/g77/980729-0.f @@ -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 diff --git a/gcc/testsuite/gfortran.dg/g77/981117-1.f b/gcc/testsuite/gfortran.dg/g77/981117-1.f new file mode 100644 index 0000000..705a5da --- /dev/null +++ b/gcc/testsuite/gfortran.dg/g77/981117-1.f @@ -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 diff --git a/gcc/testsuite/gfortran.dg/g77/toon_1.f b/gcc/testsuite/gfortran.dg/g77/toon_1.f new file mode 100644 index 0000000..fcdeb42 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/g77/toon_1.f @@ -0,0 +1,4 @@ +c { dg-do compile } + SUBROUTINE AAP(NOOT) + DIMENSION NOOT(*) + END |