OSDN Git Service

2004-07-21 David Billinghurst (David.Billinghurst@riotinto.com)
authorbillingd <billingd@138bc75d-0d04-0410-961f-82ee72b054a4>
Wed, 21 Jul 2004 00:00:24 +0000 (00:00 +0000)
committerbillingd <billingd@138bc75d-0d04-0410-961f-82ee72b054a4>
Wed, 21 Jul 2004 00:00:24 +0000 (00:00 +0000)
Copy cases from g77.f-torture/execute and add dg-run
directive.  Other changes as noted.
* gfortran.dg/g77/13037.f
* gfortran.dg/g77/1832.f
* gfortran.dg/g77/19981119-0.f
* gfortran.dg/g77/19990313-0.f
* gfortran.dg/g77/19990313-1.f
* gfortran.dg/g77/19990313-2.f
* gfortran.dg/g77/19990313-3.f
* gfortran.dg/g77/19990419-1.f
* gfortran.dg/g77/19990826-0.f
* gfortran.dg/g77/19990826-2.f
* gfortran.dg/g77/20000503-1.f
* gfortran.dg/g77/20001111.f
* gfortran.dg/g77/20010116.f
* gfortran.dg/g77/20010426-1.f: Renamed from 20010426-1.f
* gfortran.dg/g77/20010430.f
* gfortran.dg/g77/6177.f
* gfortran.dg/g77/947.f
* gfortran.dg/g77/970816-3.f
* gfortran.dg/g77/971102-1.f
* gfortran.dg/g77/980520-1.f
* gfortran.dg/g77/980628-0.f
* gfortran.dg/g77/980628-1.f
* gfortran.dg/g77/980628-10.f
* gfortran.dg/g77/980628-2.f
* gfortran.dg/g77/980628-3.f
* gfortran.dg/g77/980628-7.f
* gfortran.dg/g77/980628-8.f
* gfortran.dg/g77/980628-9.f
* gfortran.dg/g77/980701-0.f
* gfortran.dg/g77/980701-1.f
* gfortran.dg/g77/cabs.f
* gfortran.dg/g77/claus.f
* gfortran.dg/g77/complex_1.f
* gfortran.dg/g77/cpp3.F: Renamed from cpp3.F
* gfortran.dg/g77/dcomplex.f
* gfortran.dg/g77/dnrm2.f: Add dg-warnings as required.
* gfortran.dg/g77/f90-intrinsic-mathematical.f
* gfortran.dg/g77/f90-intrinsic-numeric.f
* gfortran.dg/g77/int8421.f
* gfortran.dg/g77/labug1.f
* gfortran.dg/g77/large_vec.f
* gfortran.dg/g77/le.f
* gfortran.dg/g77/short.f
* gfortran.dg/g77/README: Update

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

44 files changed:
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/g77/13037.f [new file with mode: 0644]
gcc/testsuite/gfortran.dg/g77/1832.f [new file with mode: 0644]
gcc/testsuite/gfortran.dg/g77/19981119-0.f [new file with mode: 0644]
gcc/testsuite/gfortran.dg/g77/19990313-0.f [new file with mode: 0644]
gcc/testsuite/gfortran.dg/g77/19990313-1.f [new file with mode: 0644]
gcc/testsuite/gfortran.dg/g77/19990313-2.f [new file with mode: 0644]
gcc/testsuite/gfortran.dg/g77/19990313-3.f [new file with mode: 0644]
gcc/testsuite/gfortran.dg/g77/19990419-1.f [new file with mode: 0644]
gcc/testsuite/gfortran.dg/g77/19990826-0.f [new file with mode: 0644]
gcc/testsuite/gfortran.dg/g77/19990826-2.f [new file with mode: 0644]
gcc/testsuite/gfortran.dg/g77/20000503-1.f [new file with mode: 0644]
gcc/testsuite/gfortran.dg/g77/20001111.f [new file with mode: 0644]
gcc/testsuite/gfortran.dg/g77/20010116.f [new file with mode: 0644]
gcc/testsuite/gfortran.dg/g77/20010426-1.f [new file with mode: 0644]
gcc/testsuite/gfortran.dg/g77/20010430.f [new file with mode: 0644]
gcc/testsuite/gfortran.dg/g77/6177.f [new file with mode: 0644]
gcc/testsuite/gfortran.dg/g77/947.f [new file with mode: 0644]
gcc/testsuite/gfortran.dg/g77/970816-3.f [new file with mode: 0644]
gcc/testsuite/gfortran.dg/g77/971102-1.f [new file with mode: 0644]
gcc/testsuite/gfortran.dg/g77/980520-1.f [new file with mode: 0644]
gcc/testsuite/gfortran.dg/g77/980628-0.f [new file with mode: 0644]
gcc/testsuite/gfortran.dg/g77/980628-1.f [new file with mode: 0644]
gcc/testsuite/gfortran.dg/g77/980628-10.f [new file with mode: 0644]
gcc/testsuite/gfortran.dg/g77/980628-2.f [new file with mode: 0644]
gcc/testsuite/gfortran.dg/g77/980628-3.f [new file with mode: 0644]
gcc/testsuite/gfortran.dg/g77/980628-7.f [new file with mode: 0644]
gcc/testsuite/gfortran.dg/g77/980628-8.f [new file with mode: 0644]
gcc/testsuite/gfortran.dg/g77/980628-9.f [new file with mode: 0644]
gcc/testsuite/gfortran.dg/g77/980701-0.f [new file with mode: 0644]
gcc/testsuite/gfortran.dg/g77/980701-1.f [new file with mode: 0644]
gcc/testsuite/gfortran.dg/g77/cabs.f [new file with mode: 0644]
gcc/testsuite/gfortran.dg/g77/claus.f [new file with mode: 0644]
gcc/testsuite/gfortran.dg/g77/complex_1.f [new file with mode: 0644]
gcc/testsuite/gfortran.dg/g77/cpp3.F [new file with mode: 0755]
gcc/testsuite/gfortran.dg/g77/dcomplex.f [new file with mode: 0644]
gcc/testsuite/gfortran.dg/g77/dnrm2.f [new file with mode: 0644]
gcc/testsuite/gfortran.dg/g77/f90-intrinsic-mathematical.f [new file with mode: 0644]
gcc/testsuite/gfortran.dg/g77/f90-intrinsic-numeric.f [new file with mode: 0644]
gcc/testsuite/gfortran.dg/g77/int8421.f [new file with mode: 0644]
gcc/testsuite/gfortran.dg/g77/labug1.f [new file with mode: 0644]
gcc/testsuite/gfortran.dg/g77/large_vec.f [new file with mode: 0644]
gcc/testsuite/gfortran.dg/g77/le.f [new file with mode: 0644]
gcc/testsuite/gfortran.dg/g77/short.f [new file with mode: 0644]

index c47e7b7..39601de 100644 (file)
@@ -1,3 +1,52 @@
+2004-07-21  David Billinghurst (David.Billinghurst@riotinto.com)
+
+       Copy cases from g77.f-torture/execute and add dg-run
+       directive.  Other changes as noted.    
+       * gfortran.dg/g77/13037.f
+       * gfortran.dg/g77/1832.f
+       * gfortran.dg/g77/19981119-0.f
+       * gfortran.dg/g77/19990313-0.f
+       * gfortran.dg/g77/19990313-1.f
+       * gfortran.dg/g77/19990313-2.f
+       * gfortran.dg/g77/19990313-3.f
+       * gfortran.dg/g77/19990419-1.f
+       * gfortran.dg/g77/19990826-0.f
+       * gfortran.dg/g77/19990826-2.f
+       * gfortran.dg/g77/20000503-1.f
+       * gfortran.dg/g77/20001111.f
+       * gfortran.dg/g77/20010116.f
+       * gfortran.dg/g77/20010426-1.f: Renamed from 20010426-1.f
+       * gfortran.dg/g77/20010430.f
+       * gfortran.dg/g77/6177.f
+       * gfortran.dg/g77/947.f
+       * gfortran.dg/g77/970816-3.f
+       * gfortran.dg/g77/971102-1.f
+       * gfortran.dg/g77/980520-1.f
+       * gfortran.dg/g77/980628-0.f
+       * gfortran.dg/g77/980628-1.f
+       * gfortran.dg/g77/980628-10.f
+       * gfortran.dg/g77/980628-2.f
+       * gfortran.dg/g77/980628-3.f
+       * gfortran.dg/g77/980628-7.f
+       * gfortran.dg/g77/980628-8.f
+       * gfortran.dg/g77/980628-9.f
+       * gfortran.dg/g77/980701-0.f
+       * gfortran.dg/g77/980701-1.f
+       * gfortran.dg/g77/cabs.f
+       * gfortran.dg/g77/claus.f
+       * gfortran.dg/g77/complex_1.f
+       * gfortran.dg/g77/cpp3.F: Renamed from cpp3.F
+       * gfortran.dg/g77/dcomplex.f
+       * gfortran.dg/g77/dnrm2.f: Add dg-warnings as required.
+       * gfortran.dg/g77/f90-intrinsic-mathematical.f
+       * gfortran.dg/g77/f90-intrinsic-numeric.f
+       * gfortran.dg/g77/int8421.f
+       * gfortran.dg/g77/labug1.f
+       * gfortran.dg/g77/large_vec.f
+       * gfortran.dg/g77/le.f
+       * gfortran.dg/g77/short.f
+       * gfortran.dg/g77/README: Update
+
 2004-07-20  Mark Mitchell  <mark@codesourcery.com>
 
        PR c++/16637
diff --git a/gcc/testsuite/gfortran.dg/g77/13037.f b/gcc/testsuite/gfortran.dg/g77/13037.f
new file mode 100644 (file)
index 0000000..01c2bab
--- /dev/null
@@ -0,0 +1,59 @@
+c { dg-do run }
+c      PR optimization/13037
+c      Contributed by Kirill Smelkov
+c      bug symptom: zeta(kkzc) seems to reference to zeta(kkzc-1) instead
+c      with gcc-3.2.2 it is OK, so it is a regression.
+c
+      subroutine bug1(expnt)
+      implicit none
+
+      double precision zeta
+      common /bug1_area/zeta(3)
+
+      double precision expnt(3)
+
+
+      integer k, kkzc
+
+      kkzc=0
+      do k=1,3
+         kkzc = kkzc + 1
+         zeta(kkzc) = expnt(k)
+      enddo
+
+c     the following line activates the bug
+      call bug1_activator(kkzc)
+      end
+
+
+c     dummy subroutine
+      subroutine bug1_activator(inum)
+      implicit none
+      integer inum
+      end
+
+
+c     test driver
+      program test_bug1
+      implicit none
+
+      double precision zeta
+      common /bug1_area/zeta(3)
+
+      double precision expnt(3)
+
+      zeta(1) = 0.0d0
+      zeta(2) = 0.0d0
+      zeta(3) = 0.0d0
+
+      expnt(1) = 1.0d0
+      expnt(2) = 2.0d0
+      expnt(3) = 3.0d0
+
+      call bug1(expnt)
+      if ((zeta(1).ne.1) .or. (zeta(2).ne.2) .or. (zeta(3).ne.3)) then
+        call abort
+      endif
+
+      end
+
diff --git a/gcc/testsuite/gfortran.dg/g77/1832.f b/gcc/testsuite/gfortran.dg/g77/1832.f
new file mode 100644 (file)
index 0000000..9f611b5
--- /dev/null
@@ -0,0 +1,9 @@
+c { dg-do run }
+      character*120 file
+      character*5   string
+      file = "c:/dos/adir/bdir/cdir/text.doc"
+      write(string, *) "a ", file
+      if (string .ne. ' a') call abort
+C-- The leading space is normal for list-directed output
+C-- "file" is not printed because it would overflow "string".
+      end
diff --git a/gcc/testsuite/gfortran.dg/g77/19981119-0.f b/gcc/testsuite/gfortran.dg/g77/19981119-0.f
new file mode 100644 (file)
index 0000000..17c6e06
--- /dev/null
@@ -0,0 +1,41 @@
+c { dg-do run }
+* X-Delivered: at request of burley on mescaline.gnu.org
+* Date: Sat, 31 Oct 1998 18:26:29 +0200 (EET)
+* From: "B. Yanchitsky" <yan@im.imag.kiev.ua>
+* To: fortran@gnu.org
+* Subject: Bug report
+* MIME-Version: 1.0
+* Content-Type: TEXT/PLAIN; charset=US-ASCII
+* 
+* There is a trouble with g77 on Alpha.
+* My configuration: 
+* Digital Personal Workstation 433au,
+* Digital Unix 4.0D,
+* GNU Fortran 0.5.23 and GNU C 2.8.1.
+* 
+* The following program treated successfully but crashed when running. 
+* 
+* C --- PROGRAM BEGIN -------
+* 
+      subroutine sub(N,u)
+      integer N
+      double precision u(-N:N,-N:N)
+
+C vvvv    CRASH HERE   vvvvv   
+      u(-N,N)=0d0
+      return
+      end
+
+
+      program bug
+      integer N
+      double precision a(-10:10,-10:10)
+      data a/441*1d0/
+      N=10
+      call sub(N,a)
+      if (a(-N,N) .ne. 0d0) call abort
+      end
+* 
+* C --- PROGRAM END -------
+* 
+* Good luck!
diff --git a/gcc/testsuite/gfortran.dg/g77/19990313-0.f b/gcc/testsuite/gfortran.dg/g77/19990313-0.f
new file mode 100644 (file)
index 0000000..ae2a72b
--- /dev/null
@@ -0,0 +1,34 @@
+c { dg-do run }
+* To: craig@jcb-sc.com
+* Subject: Re: G77 and KIND=2
+* Content-Type: text/plain; charset=us-ascii
+* From: Dave Love <d.love@dl.ac.uk>
+* Date: 03 Mar 1999 18:20:11 +0000
+* In-Reply-To: craig@jcb-sc.com's message of "1 Mar 1999 21:04:38 -0000"
+* User-Agent: Gnus/5.07007 (Pterodactyl Gnus v0.70) Emacs/20.3
+* X-UIDL: d442bafe961c2a6ec6904f492e05d7b0
+* 
+* ISTM that there is a real problem printing integer*8 (on x86):
+* 
+* $ cat x.f
+*[modified for test suite]
+        integer *8 foo, bar
+        data r/4e10/
+        foo = 4e10
+        bar = r
+        if (foo .ne. bar) call abort
+        end
+* $ g77 x.f && ./a.out
+*  1345294336
+*  123
+* $ f2c x.f && g77 x.c && ./a.out
+* x.f:
+*    MAIN:
+*  40000000000
+*  123
+* $
+* 
+* Gdb shows the upper half of the buffer passed to do_lio is zeroed in
+* the g77 case.
+* 
+* I've forgotten how the code generation happens.
diff --git a/gcc/testsuite/gfortran.dg/g77/19990313-1.f b/gcc/testsuite/gfortran.dg/g77/19990313-1.f
new file mode 100644 (file)
index 0000000..b229bb4
--- /dev/null
@@ -0,0 +1,8 @@
+c { dg-do run }
+        integer *8 foo, bar
+       double precision r
+        data r/4d10/
+        foo = 4d10
+        bar = r
+        if (foo .ne. bar) call abort
+        end
diff --git a/gcc/testsuite/gfortran.dg/g77/19990313-2.f b/gcc/testsuite/gfortran.dg/g77/19990313-2.f
new file mode 100644 (file)
index 0000000..5dac2d0
--- /dev/null
@@ -0,0 +1,8 @@
+c { dg-do run }
+       integer *8 foo, bar
+       complex c
+        data c/(4e10,0)/
+        foo = 4e10
+        bar = c
+        if (foo .ne. bar) call abort
+        end
diff --git a/gcc/testsuite/gfortran.dg/g77/19990313-3.f b/gcc/testsuite/gfortran.dg/g77/19990313-3.f
new file mode 100644 (file)
index 0000000..c7489f6
--- /dev/null
@@ -0,0 +1,8 @@
+c { dg-do run }
+        integer *8 foo, bar
+       double complex c
+        data c/(4d10,0)/
+        foo = 4d10
+        bar = c
+        if (foo .ne. bar) call abort
+        end
diff --git a/gcc/testsuite/gfortran.dg/g77/19990419-1.f b/gcc/testsuite/gfortran.dg/g77/19990419-1.f
new file mode 100644 (file)
index 0000000..e6a4a9b
--- /dev/null
@@ -0,0 +1,22 @@
+c { dg-do run }
+* Test DO WHILE, to make sure it fully reevaluates its expression.
+* Belongs in execute/.
+      common /x/ ival
+      j = 0
+      do while (i() .eq. 1)
+         j = j + 1
+         if (j .gt. 5) call abort
+      end do
+      if (j .ne. 4) call abort
+      if (ival .ne. 5) call abort
+      end
+      function i()
+      common /x/ ival
+      ival = ival + 1
+      i = 10
+      if (ival .lt. 5) i = 1
+      end
+      block data
+      common /x/ ival
+      data ival/0/
+      end
diff --git a/gcc/testsuite/gfortran.dg/g77/19990826-0.f b/gcc/testsuite/gfortran.dg/g77/19990826-0.f
new file mode 100644 (file)
index 0000000..054f9ab
--- /dev/null
@@ -0,0 +1,20 @@
+c { dg-do run }
+* From: niles@fan745.gsfc.nasa.gov
+* To: fortran@gnu.org
+* Cc: niles@fan745.gsfc.nasa.gov
+* Subject: problem with DNINT() on Linux/Alpha.
+* Date: Sun, 06 Jun 1999 16:39:35 -0400
+* X-UIDL: 6aa9208d7bda8b6182a095dfd37016b7
+
+      IF (DNINT(0.0D0) .NE. 0.) CALL ABORT
+      STOP
+      END
+
+* Result on Linux/i386: " 0."  (and every other computer!)
+* Result on Linux/alpha: " 3.6028797E+16"
+
+* It seems to work fine if I change it to the generic NINT().  Probably
+* a name pollution problem in the new C library, but it seems bad. no?
+
+*      Thanks,
+*      Rick Niles.
diff --git a/gcc/testsuite/gfortran.dg/g77/19990826-2.f b/gcc/testsuite/gfortran.dg/g77/19990826-2.f
new file mode 100644 (file)
index 0000000..8f0f0c1
--- /dev/null
@@ -0,0 +1,34 @@
+c { dg-do run }
+* From: "Billinghurst, David (RTD)" <David.Billinghurst@riotinto.com.au>
+* Subject: RE: single precision complex bug in g77 - was Testing g77 with LA
+*      PACK 3.0
+* Date: Thu, 8 Jul 1999 00:55:11 +0100 
+* X-UIDL: b00d9d8081a36fef561b827d255dd4a5
+
+* Here is a slightly simpler and neater test case
+
+      program labug3
+      implicit none
+
+*  This program gives the wrong answer on mips-sgi-irix6.5
+*  when compiled with g77 from egcs-19990629 (gcc 2.95 prerelease)
+*  Get a = 0.0 when it should be 1.0 
+*
+*  Works with:  -femulate-complex
+*               egcs-1.1.2 
+*
+*  Originally derived from LAPACK 3.0 test suite.
+*
+*  David Billinghurst, (David.Billinghurst@riotinto.com.au)
+*  8 July 1999
+* 
+      complex one, z
+      real    a, f1
+      f1(z) = real(z)
+      one = (1.,0.)
+      a = f1(one) 
+      if ( abs(a-1.0) .gt. 1.0e-5 ) then
+         write(6,*) 'A should be 1.0 but it is',a
+         call abort()
+      end if
+      end
diff --git a/gcc/testsuite/gfortran.dg/g77/20000503-1.f b/gcc/testsuite/gfortran.dg/g77/20000503-1.f
new file mode 100644 (file)
index 0000000..2a48a35
--- /dev/null
@@ -0,0 +1,25 @@
+c { dg-do run }
+*
+*  Originally derived from LAPACK 3.0 test suite failure.
+*
+*  David Billinghurst, (David.Billinghurst@riotinto.com.au)
+*  23 February 2000
+* 
+      INTEGER N, I, SLASQX
+      N = 20
+      I = SLASQX( N ) 
+      IF ( I .NE. 2*N ) THEN
+         WRITE(6,*) 'I = ', I, ' but should be ', 2*N
+         CALL ABORT()
+      END IF
+      END
+
+      INTEGER FUNCTION SLASQX( N )
+      INTEGER  N, I0, I, K
+      I0 = 1
+      DO I = 4*I0, 2*( I0+N-1 ), 4
+         K = I
+      END DO
+      SLASQX = K
+      RETURN
+      END
diff --git a/gcc/testsuite/gfortran.dg/g77/20001111.f b/gcc/testsuite/gfortran.dg/g77/20001111.f
new file mode 100644 (file)
index 0000000..366956a
--- /dev/null
@@ -0,0 +1,13 @@
+c { dg-do run }
+      DOUBLE PRECISION VALUE(2), TOLD, BK
+      DATA VALUE /0D0, 1D0/
+      DATA TOLD /0D0/
+      DO I=1, 2
+         BK = VALUE(I)
+         IF(BK .GT. TOLD) GOTO 10
+      ENDDO
+      WRITE(*,*)'Error: BK = ', BK
+      CALL ABORT
+ 10   CONTINUE
+      WRITE(*,*)'No Error: BK = ', BK
+      END
diff --git a/gcc/testsuite/gfortran.dg/g77/20010116.f b/gcc/testsuite/gfortran.dg/g77/20010116.f
new file mode 100644 (file)
index 0000000..dd8ee93
--- /dev/null
@@ -0,0 +1,39 @@
+c { dg-do run }
+*
+*  Derived from LAPACK 3.0 routine CHGEQZ
+*  Fails on i686-pc-cygwin with gcc-2.97 snapshots at -O2 and higher
+*  PR fortran/1645
+*
+*  David Billinghurst, (David.Billinghurst@riotinto.com)
+*  14 January 2001
+*  Rewritten by Toon Moene (toon@moene.indiv.nluug.nl)
+*  15 January 2001
+* 
+      COMPLEX A(5,5)
+      DATA A/25*(0.0,0.0)/
+      A(4,3) = (0.05,0.2)/3.0E-7
+      A(4,4) = (-0.03,-0.4)
+      A(5,4) = (-2.0E-07,2.0E-07)
+      CALL CHGEQZ( 5, A )
+      END
+      SUBROUTINE CHGEQZ( N, A )
+      COMPLEX   A(N,N), X
+      ABS1( X ) = ABS( REAL( X ) ) + ABS( AIMAG( X ) )
+      DO J = 4, 2, -1
+         I = J
+         TEMP  = ABS1( A(J,J) )
+         TEMP2 = ABS1( A( J+1, J ) )
+         TEMPR = MAX( TEMP, TEMP2 )
+         IF( TEMPR .LT. 1.0 .AND. TEMPR .NE. 0.0 ) THEN
+            TEMP  = TEMP / TEMPR
+            TEMP2 = TEMP2 / TEMPR
+         END IF
+         IF ( ABS1(A(J,J-1))*TEMP2 .LE. TEMP ) GO TO 90
+      END DO
+c     Should not reach here, but need a statement
+      PRINT*
+  90  IF ( I .NE. 4 ) THEN
+         PRINT*,'I =', I, ' but should be 4'
+         CALL ABORT()
+      END IF
+      END
diff --git a/gcc/testsuite/gfortran.dg/g77/20010426-1.f b/gcc/testsuite/gfortran.dg/g77/20010426-1.f
new file mode 100644 (file)
index 0000000..ce8cc4d
--- /dev/null
@@ -0,0 +1,3 @@
+c { dg-do run }
+      print*,cos(1.0)
+      end
diff --git a/gcc/testsuite/gfortran.dg/g77/20010430.f b/gcc/testsuite/gfortran.dg/g77/20010430.f
new file mode 100644 (file)
index 0000000..c6af496
--- /dev/null
@@ -0,0 +1,21 @@
+c { dg-do run }
+      REAL DAT(2,5)
+      DO I = 1, 5
+         DAT(1,I) = I*1.6356-NINT(I*1.6356)
+         DAT(2,I) = I
+      ENDDO
+      DO I = 1, 4
+         DO J = I+1, 5
+            IF (DAT(1,J) - DAT(1,I) .LT. 0.0) THEN
+               DO K = 1, 2
+                  TMP = DAT(K,I)
+                  DAT(K,I) = DAT(K,J)
+                  DAT(K,J) = TMP
+               ENDDO
+            ENDIF
+         ENDDO
+      ENDDO
+      DO I = 1, 4
+         IF (DAT(1,I) .GT. DAT(1,I+1)) CALL ABORT
+      ENDDO
+      END
diff --git a/gcc/testsuite/gfortran.dg/g77/6177.f b/gcc/testsuite/gfortran.dg/g77/6177.f
new file mode 100644 (file)
index 0000000..d708652
--- /dev/null
@@ -0,0 +1,15 @@
+c { dg-do run }
+      program pr6177
+C
+C Test case for PR optimization/6177.
+C This bug (an ICE) originally showed up in file cblat2.f from LAPACK.
+C
+      complex x
+      complex w(1)
+      intrinsic conjg
+      x = (2.0d0, 1.0d0)
+      w(1) = x
+      x = conjg(x)
+      w(1) = conjg(w(1))
+      if (abs(x-w(1)) .gt. 1.0e-5) call abort
+      end
diff --git a/gcc/testsuite/gfortran.dg/g77/947.f b/gcc/testsuite/gfortran.dg/g77/947.f
new file mode 100644 (file)
index 0000000..8d8d71a
--- /dev/null
@@ -0,0 +1,13 @@
+c { dg-do run }
+      DIMENSION A(-5:5)
+      INTEGER*1 IM5, IZ, IP5
+      INTEGER*2 IM1, IP1
+      PARAMETER (IM5=-5, IM1=-1, IZ=0, IP1=1, IP5=5)
+      DATA A(IM5) /-5./, A(IM1) /-1./
+      DATA A(IZ)  /0./
+      DATA A(IP5) /+5./, A(IP1) /+1./
+      IF (A(IM5) .NE. -5. .OR. A(IM1) .NE. -1. .OR.
+     ,    A(IZ)  .NE.  0. .OR.
+     ,    A(IP5) .NE. +5. .OR. A(IP1) .NE. +1. )
+     ,  CALL ABORT
+      END
diff --git a/gcc/testsuite/gfortran.dg/g77/970816-3.f b/gcc/testsuite/gfortran.dg/g77/970816-3.f
new file mode 100644 (file)
index 0000000..6904386
--- /dev/null
@@ -0,0 +1,21 @@
+c { dg-do run }
+* Date: Wed, 13 Aug 1997 15:34:23 +0200 (METDST)
+* From: Claus Denk <denk@cica.es>
+* To: g77-alpha@gnu.ai.mit.edu
+* Subject: 970811 report - segfault bug on alpha still there
+*[...]
+* Now, the bug that I reported some weeks ago is still there, I'll post
+* the test program again:
+*
+        PROGRAM TEST
+C       a bug in g77-0.5.21 - alpha. Works with NSTART=0 and segfaults with
+C       NSTART=1 on the second write.
+        PARAMETER (NSTART=1,NADD=NSTART+1)
+        REAL AB(NSTART:NSTART)
+        AB(NSTART)=1.0
+        I=1
+        J=2
+        IND=I-J+NADD
+        write(*,*) AB(IND)
+        write(*,*) AB(I-J+NADD)
+        END
diff --git a/gcc/testsuite/gfortran.dg/g77/971102-1.f b/gcc/testsuite/gfortran.dg/g77/971102-1.f
new file mode 100644 (file)
index 0000000..6181a17
--- /dev/null
@@ -0,0 +1,12 @@
+c { dg-do run }
+       i=3
+       j=0
+       do i=i,5
+         j = j+i
+       end do
+       do i=3,i
+         j = j+i
+       end do
+       if (i.ne.7) call abort()
+       print *, i,j
+       end
diff --git a/gcc/testsuite/gfortran.dg/g77/980520-1.f b/gcc/testsuite/gfortran.dg/g77/980520-1.f
new file mode 100644 (file)
index 0000000..edf7241
--- /dev/null
@@ -0,0 +1,7 @@
+c { dg-do run }
+c     Produced a link error through not eliminating the unused statement
+c     function after 1998-05-15 change to gcc/toplev.c.  It's in
+c     `execute' since it needs to link.
+c     Fixed by 1998-05-23 change to f/com.c.
+      values(i,j) = val((i-1)*n+j)
+      end
diff --git a/gcc/testsuite/gfortran.dg/g77/980628-0.f b/gcc/testsuite/gfortran.dg/g77/980628-0.f
new file mode 100644 (file)
index 0000000..9943e3c
--- /dev/null
@@ -0,0 +1,62 @@
+c { dg-do run }
+* g77 0.5.23 and previous had bugs involving too little space
+* allocated for EQUIVALENCE and COMMON areas needing initial
+* padding to meet alignment requirements of the system.
+
+      call subr
+      end
+
+      subroutine subr
+      implicit none
+
+      real r1(5), r2(5), r3(5)
+      double precision d1, d2, d3
+      integer i1, i2, i3
+      equivalence (r1(2), d1)
+      equivalence (r2(2), d2)
+      equivalence (r3(2), d3)
+
+      r1(1) = 1.
+      d1 = 10.
+      r1(4) = 1.
+      r1(5) = 1.
+      i1 = 1
+      r2(1) = 2.
+      d2 = 20.
+      r2(4) = 2.
+      r2(5) = 2.
+      i2 = 2
+      r3(1) = 3.
+      d3 = 30.
+      r3(4) = 3.
+      r3(5) = 3.
+      i3 = 3
+
+      call x (r1, d1, i1, r2, d2, i2, r3, d3, i3)
+
+      end
+
+      subroutine x (r1, d1, i1, r2, d2, i2, r3, d3, i3)
+      implicit none
+
+      real r1(5), r2(5), r3(5)
+      double precision d1, d2, d3
+      integer i1, i2, i3
+
+      if (r1(1) .ne. 1.) call abort
+      if (d1 .ne. 10.) call abort
+      if (r1(4) .ne. 1.) call abort
+      if (r1(5) .ne. 1.) call abort
+      if (i1 .ne. 1) call abort
+      if (r2(1) .ne. 2.) call abort
+      if (d2 .ne. 20.) call abort
+      if (r2(4) .ne. 2.) call abort
+      if (r2(5) .ne. 2.) call abort
+      if (i2 .ne. 2) call abort
+      if (r3(1) .ne. 3.) call abort
+      if (d3 .ne. 30.) call abort
+      if (r3(4) .ne. 3.) call abort
+      if (r3(5) .ne. 3.) call abort
+      if (i3 .ne. 3) call abort
+
+      end
diff --git a/gcc/testsuite/gfortran.dg/g77/980628-1.f b/gcc/testsuite/gfortran.dg/g77/980628-1.f
new file mode 100644 (file)
index 0000000..7524a3f
--- /dev/null
@@ -0,0 +1,63 @@
+c { dg-do run }
+* g77 0.5.23 and previous had bugs involving too little space
+* allocated for EQUIVALENCE and COMMON areas needing initial
+* padding to meet alignment requirements of the system.
+
+      call subr
+      end
+
+      subroutine subr
+      implicit none
+      save
+
+      real r1(5), r2(5), r3(5)
+      double precision d1, d2, d3
+      integer i1, i2, i3
+      equivalence (r1(2), d1)
+      equivalence (r2(2), d2)
+      equivalence (r3(2), d3)
+
+      r1(1) = 1.
+      d1 = 10.
+      r1(4) = 1.
+      r1(5) = 1.
+      i1 = 1
+      r2(1) = 2.
+      d2 = 20.
+      r2(4) = 2.
+      r2(5) = 2.
+      i2 = 2
+      r3(1) = 3.
+      d3 = 30.
+      r3(4) = 3.
+      r3(5) = 3.
+      i3 = 3
+
+      call x (r1, d1, i1, r2, d2, i2, r3, d3, i3)
+
+      end
+
+      subroutine x (r1, d1, i1, r2, d2, i2, r3, d3, i3)
+      implicit none
+
+      real r1(5), r2(5), r3(5)
+      double precision d1, d2, d3
+      integer i1, i2, i3
+
+      if (r1(1) .ne. 1.) call abort
+      if (d1 .ne. 10.) call abort
+      if (r1(4) .ne. 1.) call abort
+      if (r1(5) .ne. 1.) call abort
+      if (i1 .ne. 1) call abort
+      if (r2(1) .ne. 2.) call abort
+      if (d2 .ne. 20.) call abort
+      if (r2(4) .ne. 2.) call abort
+      if (r2(5) .ne. 2.) call abort
+      if (i2 .ne. 2) call abort
+      if (r3(1) .ne. 3.) call abort
+      if (d3 .ne. 30.) call abort
+      if (r3(4) .ne. 3.) call abort
+      if (r3(5) .ne. 3.) call abort
+      if (i3 .ne. 3) call abort
+
+      end
diff --git a/gcc/testsuite/gfortran.dg/g77/980628-10.f b/gcc/testsuite/gfortran.dg/g77/980628-10.f
new file mode 100644 (file)
index 0000000..4a0eb23
--- /dev/null
@@ -0,0 +1,58 @@
+c { dg-do run }
+* g77 0.5.23 and previous had bugs involving too little space
+* allocated for EQUIVALENCE and COMMON areas needing initial
+* padding to meet alignment requirements of the system.
+
+      call subr
+      end
+
+      subroutine subr
+      implicit none
+      save
+
+      character c1(11), c2(11), c3(11)
+      real r1, r2, r3
+      character c4, c5, c6
+      equivalence (r1, c1(2))
+      equivalence (r2, c2(2))
+      equivalence (r3, c3(2))
+
+      c1(1) = '1'
+      r1 = 1.
+      c1(11) = '1'
+      c4 = '4'
+      c2(1) = '2'
+      r2 = 2.
+      c2(11) = '2'
+      c5 = '5'
+      c3(1) = '3'
+      r3 = 3.
+      c3(11) = '3'
+      c6 = '6'
+
+      call x (c1, r1, c2, r2, c3, r3, c4, c5, c6)
+
+      end
+
+      subroutine x (c1, r1, c2, r2, c3, r3, c4, c5, c6)
+      implicit none
+
+      character c1(11), c2(11), c3(11)
+      real r1, r2, r3
+      character c4, c5, c6
+
+      if (c1(1) .ne. '1') call abort
+      if (r1 .ne. 1.) call abort
+      if (c1(11) .ne. '1') call abort
+      if (c4 .ne. '4') call abort
+      if (c2(1) .ne. '2') call abort
+      if (r2 .ne. 2.) call abort
+      if (c2(11) .ne. '2') call abort
+      if (c5 .ne. '5') call abort
+      if (c3(1) .ne. '3') call abort
+      if (r3 .ne. 3.) call abort
+      if (c3(11) .ne. '3') call abort
+      if (c6 .ne. '6') call abort
+
+      end
+
diff --git a/gcc/testsuite/gfortran.dg/g77/980628-2.f b/gcc/testsuite/gfortran.dg/g77/980628-2.f
new file mode 100644 (file)
index 0000000..6324876
--- /dev/null
@@ -0,0 +1,56 @@
+c { dg-do run }
+* g77 0.5.23 and previous had bugs involving too little space
+* allocated for EQUIVALENCE and COMMON areas needing initial
+* padding to meet alignment requirements of the system.
+
+      call subr
+      end
+
+      subroutine subr
+      implicit none
+
+      character c1(11), c2(11), c3(11)
+      real r1, r2, r3
+      character c4, c5, c6
+      equivalence (c1(2), r1)
+      equivalence (c2(2), r2)
+      equivalence (c3(2), r3)
+
+      c1(1) = '1'
+      r1 = 1.
+      c1(11) = '1'
+      c4 = '4'
+      c2(1) = '2'
+      r2 = 2.
+      c2(11) = '2'
+      c5 = '5'
+      c3(1) = '3'
+      r3 = 3.
+      c3(11) = '3'
+      c6 = '6'
+
+      call x (c1, r1, c2, r2, c3, r3, c4, c5, c6)
+
+      end
+
+      subroutine x (c1, r1, c2, r2, c3, r3, c4, c5, c6)
+      implicit none
+
+      character c1(11), c2(11), c3(11)
+      real r1, r2, r3
+      character c4, c5, c6
+
+      if (c1(1) .ne. '1') call abort
+      if (r1 .ne. 1.) call abort
+      if (c1(11) .ne. '1') call abort
+      if (c4 .ne. '4') call abort
+      if (c2(1) .ne. '2') call abort
+      if (r2 .ne. 2.) call abort
+      if (c2(11) .ne. '2') call abort
+      if (c5 .ne. '5') call abort
+      if (c3(1) .ne. '3') call abort
+      if (r3 .ne. 3.) call abort
+      if (c3(11) .ne. '3') call abort
+      if (c6 .ne. '6') call abort
+
+      end
diff --git a/gcc/testsuite/gfortran.dg/g77/980628-3.f b/gcc/testsuite/gfortran.dg/g77/980628-3.f
new file mode 100644 (file)
index 0000000..ca10f18
--- /dev/null
@@ -0,0 +1,57 @@
+c { dg-do run }
+* g77 0.5.23 and previous had bugs involving too little space
+* allocated for EQUIVALENCE and COMMON areas needing initial
+* padding to meet alignment requirements of the system.
+
+      call subr
+      end
+
+      subroutine subr
+      implicit none
+      save
+
+      character c1(11), c2(11), c3(11)
+      real r1, r2, r3
+      character c4, c5, c6
+      equivalence (c1(2), r1)
+      equivalence (c2(2), r2)
+      equivalence (c3(2), r3)
+
+      c1(1) = '1'
+      r1 = 1.
+      c1(11) = '1'
+      c4 = '4'
+      c2(1) = '2'
+      r2 = 2.
+      c2(11) = '2'
+      c5 = '5'
+      c3(1) = '3'
+      r3 = 3.
+      c3(11) = '3'
+      c6 = '6'
+
+      call x (c1, r1, c2, r2, c3, r3, c4, c5, c6)
+
+      end
+
+      subroutine x (c1, r1, c2, r2, c3, r3, c4, c5, c6)
+      implicit none
+
+      character c1(11), c2(11), c3(11)
+      real r1, r2, r3
+      character c4, c5, c6
+
+      if (c1(1) .ne. '1') call abort
+      if (r1 .ne. 1.) call abort
+      if (c1(11) .ne. '1') call abort
+      if (c4 .ne. '4') call abort
+      if (c2(1) .ne. '2') call abort
+      if (r2 .ne. 2.) call abort
+      if (c2(11) .ne. '2') call abort
+      if (c5 .ne. '5') call abort
+      if (c3(1) .ne. '3') call abort
+      if (r3 .ne. 3.) call abort
+      if (c3(11) .ne. '3') call abort
+      if (c6 .ne. '6') call abort
+
+      end
diff --git a/gcc/testsuite/gfortran.dg/g77/980628-7.f b/gcc/testsuite/gfortran.dg/g77/980628-7.f
new file mode 100644 (file)
index 0000000..22ef08a
--- /dev/null
@@ -0,0 +1,63 @@
+c { dg-do run }
+* g77 0.5.23 and previous had bugs involving too little space
+* allocated for EQUIVALENCE and COMMON areas needing initial
+* padding to meet alignment requirements of the system.
+
+      call subr
+      end
+
+      subroutine subr
+      implicit none
+
+      real r1(5), r2(5), r3(5)
+      double precision d1, d2, d3
+      integer i1, i2, i3
+      equivalence (d1, r1(2))
+      equivalence (d2, r2(2))
+      equivalence (d3, r3(2))
+
+      r1(1) = 1.
+      d1 = 10.
+      r1(4) = 1.
+      r1(5) = 1.
+      i1 = 1
+      r2(1) = 2.
+      d2 = 20.
+      r2(4) = 2.
+      r2(5) = 2.
+      i2 = 2
+      r3(1) = 3.
+      d3 = 30.
+      r3(4) = 3.
+      r3(5) = 3.
+      i3 = 3
+
+      call x (r1, d1, i1, r2, d2, i2, r3, d3, i3)
+
+      end
+
+      subroutine x (r1, d1, i1, r2, d2, i2, r3, d3, i3)
+      implicit none
+
+      real r1(5), r2(5), r3(5)
+      double precision d1, d2, d3
+      integer i1, i2, i3
+
+      if (r1(1) .ne. 1.) call abort
+      if (d1 .ne. 10.) call abort
+      if (r1(4) .ne. 1.) call abort
+      if (r1(5) .ne. 1.) call abort
+      if (i1 .ne. 1) call abort
+      if (r2(1) .ne. 2.) call abort
+      if (d2 .ne. 20.) call abort
+      if (r2(4) .ne. 2.) call abort
+      if (r2(5) .ne. 2.) call abort
+      if (i2 .ne. 2) call abort
+      if (r3(1) .ne. 3.) call abort
+      if (d3 .ne. 30.) call abort
+      if (r3(4) .ne. 3.) call abort
+      if (r3(5) .ne. 3.) call abort
+      if (i3 .ne. 3) call abort
+
+      end
+
diff --git a/gcc/testsuite/gfortran.dg/g77/980628-8.f b/gcc/testsuite/gfortran.dg/g77/980628-8.f
new file mode 100644 (file)
index 0000000..3b4a4a3
--- /dev/null
@@ -0,0 +1,64 @@
+c { dg-do run }
+* g77 0.5.23 and previous had bugs involving too little space
+* allocated for EQUIVALENCE and COMMON areas needing initial
+* padding to meet alignment requirements of the system.
+
+      call subr
+      end
+
+      subroutine subr
+      implicit none
+      save
+
+      real r1(5), r2(5), r3(5)
+      double precision d1, d2, d3
+      integer i1, i2, i3
+      equivalence (d1, r1(2))
+      equivalence (d2, r2(2))
+      equivalence (d3, r3(2))
+
+      r1(1) = 1.
+      d1 = 10.
+      r1(4) = 1.
+      r1(5) = 1.
+      i1 = 1
+      r2(1) = 2.
+      d2 = 20.
+      r2(4) = 2.
+      r2(5) = 2.
+      i2 = 2
+      r3(1) = 3.
+      d3 = 30.
+      r3(4) = 3.
+      r3(5) = 3.
+      i3 = 3
+
+      call x (r1, d1, i1, r2, d2, i2, r3, d3, i3)
+
+      end
+
+      subroutine x (r1, d1, i1, r2, d2, i2, r3, d3, i3)
+      implicit none
+
+      real r1(5), r2(5), r3(5)
+      double precision d1, d2, d3
+      integer i1, i2, i3
+
+      if (r1(1) .ne. 1.) call abort
+      if (d1 .ne. 10.) call abort
+      if (r1(4) .ne. 1.) call abort
+      if (r1(5) .ne. 1.) call abort
+      if (i1 .ne. 1) call abort
+      if (r2(1) .ne. 2.) call abort
+      if (d2 .ne. 20.) call abort
+      if (r2(4) .ne. 2.) call abort
+      if (r2(5) .ne. 2.) call abort
+      if (i2 .ne. 2) call abort
+      if (r3(1) .ne. 3.) call abort
+      if (d3 .ne. 30.) call abort
+      if (r3(4) .ne. 3.) call abort
+      if (r3(5) .ne. 3.) call abort
+      if (i3 .ne. 3) call abort
+
+      end
+
diff --git a/gcc/testsuite/gfortran.dg/g77/980628-9.f b/gcc/testsuite/gfortran.dg/g77/980628-9.f
new file mode 100644 (file)
index 0000000..ea2dd54
--- /dev/null
@@ -0,0 +1,57 @@
+c { dg-do run }
+* g77 0.5.23 and previous had bugs involving too little space
+* allocated for EQUIVALENCE and COMMON areas needing initial
+* padding to meet alignment requirements of the system.
+
+      call subr
+      end
+
+      subroutine subr
+      implicit none
+
+      character c1(11), c2(11), c3(11)
+      real r1, r2, r3
+      character c4, c5, c6
+      equivalence (r1, c1(2))
+      equivalence (r2, c2(2))
+      equivalence (r3, c3(2))
+
+      c1(1) = '1'
+      r1 = 1.
+      c1(11) = '1'
+      c4 = '4'
+      c2(1) = '2'
+      r2 = 2.
+      c2(11) = '2'
+      c5 = '5'
+      c3(1) = '3'
+      r3 = 3.
+      c3(11) = '3'
+      c6 = '6'
+
+      call x (c1, r1, c2, r2, c3, r3, c4, c5, c6)
+
+      end
+
+      subroutine x (c1, r1, c2, r2, c3, r3, c4, c5, c6)
+      implicit none
+
+      character c1(11), c2(11), c3(11)
+      real r1, r2, r3
+      character c4, c5, c6
+
+      if (c1(1) .ne. '1') call abort
+      if (r1 .ne. 1.) call abort
+      if (c1(11) .ne. '1') call abort
+      if (c4 .ne. '4') call abort
+      if (c2(1) .ne. '2') call abort
+      if (r2 .ne. 2.) call abort
+      if (c2(11) .ne. '2') call abort
+      if (c5 .ne. '5') call abort
+      if (c3(1) .ne. '3') call abort
+      if (r3 .ne. 3.) call abort
+      if (c3(11) .ne. '3') call abort
+      if (c6 .ne. '6') call abort
+
+      end
+
diff --git a/gcc/testsuite/gfortran.dg/g77/980701-0.f b/gcc/testsuite/gfortran.dg/g77/980701-0.f
new file mode 100644 (file)
index 0000000..2820d2e
--- /dev/null
@@ -0,0 +1,73 @@
+c { dg-do run }
+* g77 0.5.23 and previous had bugs involving too little space
+* allocated for EQUIVALENCE and COMMON areas needing initial
+* padding to meet alignment requirements of the system.
+
+      call subr
+      end
+
+      subroutine subr
+      implicit none
+
+      real r1(5), r2(5), r3(5)
+      real s1(2), s2(2), s3(2)
+      double precision d1, d2, d3
+      integer i1, i2, i3
+      equivalence (r1, s1(2))
+      equivalence (d1, r1(2))
+      equivalence (r2, s2(2))
+      equivalence (d2, r2(2))
+      equivalence (r3, s3(2))
+      equivalence (d3, r3(2))
+
+      s1(1) = 1.
+      r1(1) = 1.
+      d1 = 10.
+      r1(4) = 1.
+      r1(5) = 1.
+      i1 = 1
+      s2(1) = 2.
+      r2(1) = 2.
+      d2 = 20.
+      r2(4) = 2.
+      r2(5) = 2.
+      i2 = 2
+      s3(1) = 3.
+      r3(1) = 3.
+      d3 = 30.
+      r3(4) = 3.
+      r3(5) = 3.
+      i3 = 3
+
+      call x (s1, r1, d1, i1, s2, r2, d2, i2, s3, r3, d3, i3)
+
+      end
+
+      subroutine x (s1, r1, d1, i1, s2, r2, d2, i2, s3, r3, d3, i3)
+      implicit none
+
+      real r1(5), r2(5), r3(5)
+      real s1(2), s2(2), s3(2)
+      double precision d1, d2, d3
+      integer i1, i2, i3
+
+      if (s1(1) .ne. 1.) call abort
+      if (r1(1) .ne. 1.) call abort
+      if (d1 .ne. 10.) call abort
+      if (r1(4) .ne. 1.) call abort
+      if (r1(5) .ne. 1.) call abort
+      if (i1 .ne. 1) call abort
+      if (s2(1) .ne. 2.) call abort
+      if (r2(1) .ne. 2.) call abort
+      if (d2 .ne. 20.) call abort
+      if (r2(4) .ne. 2.) call abort
+      if (r2(5) .ne. 2.) call abort
+      if (i2 .ne. 2) call abort
+      if (s3(1) .ne. 3.) call abort
+      if (r3(1) .ne. 3.) call abort
+      if (d3 .ne. 30.) call abort
+      if (r3(4) .ne. 3.) call abort
+      if (r3(5) .ne. 3.) call abort
+      if (i3 .ne. 3) call abort
+
+      end
diff --git a/gcc/testsuite/gfortran.dg/g77/980701-1.f b/gcc/testsuite/gfortran.dg/g77/980701-1.f
new file mode 100644 (file)
index 0000000..0f07de3
--- /dev/null
@@ -0,0 +1,73 @@
+c { dg-do run }
+* g77 0.5.23 and previous had bugs involving too little space
+* allocated for EQUIVALENCE and COMMON areas needing initial
+* padding to meet alignment requirements of the system.
+
+      call subr
+      end
+
+      subroutine subr
+      implicit none
+
+      real r1(5), r2(5), r3(5)
+      real s1(2), s2(2), s3(2)
+      double precision d1, d2, d3
+      integer i1, i2, i3
+      equivalence (d1, r1(2))
+      equivalence (r1, s1(2))
+      equivalence (d2, r2(2))
+      equivalence (r2, s2(2))
+      equivalence (d3, r3(2))
+      equivalence (r3, s3(2))
+
+      s1(1) = 1.
+      r1(1) = 1.
+      d1 = 10.
+      r1(4) = 1.
+      r1(5) = 1.
+      i1 = 1
+      s2(1) = 2.
+      r2(1) = 2.
+      d2 = 20.
+      r2(4) = 2.
+      r2(5) = 2.
+      i2 = 2
+      s3(1) = 3.
+      r3(1) = 3.
+      d3 = 30.
+      r3(4) = 3.
+      r3(5) = 3.
+      i3 = 3
+
+      call x (s1, r1, d1, i1, s2, r2, d2, i2, s3, r3, d3, i3)
+
+      end
+
+      subroutine x (s1, r1, d1, i1, s2, r2, d2, i2, s3, r3, d3, i3)
+      implicit none
+
+      real r1(5), r2(5), r3(5)
+      real s1(2), s2(2), s3(2)
+      double precision d1, d2, d3
+      integer i1, i2, i3
+
+      if (s1(1) .ne. 1.) call abort
+      if (r1(1) .ne. 1.) call abort
+      if (d1 .ne. 10.) call abort
+      if (r1(4) .ne. 1.) call abort
+      if (r1(5) .ne. 1.) call abort
+      if (i1 .ne. 1) call abort
+      if (s2(1) .ne. 2.) call abort
+      if (r2(1) .ne. 2.) call abort
+      if (d2 .ne. 20.) call abort
+      if (r2(4) .ne. 2.) call abort
+      if (r2(5) .ne. 2.) call abort
+      if (i2 .ne. 2) call abort
+      if (s3(1) .ne. 3.) call abort
+      if (r3(1) .ne. 3.) call abort
+      if (d3 .ne. 30.) call abort
+      if (r3(4) .ne. 3.) call abort
+      if (r3(5) .ne. 3.) call abort
+      if (i3 .ne. 3) call abort
+
+      end
diff --git a/gcc/testsuite/gfortran.dg/g77/cabs.f b/gcc/testsuite/gfortran.dg/g77/cabs.f
new file mode 100644 (file)
index 0000000..91e94da
--- /dev/null
@@ -0,0 +1,15 @@
+c { dg-do run }
+      program cabs_1
+      complex      z0
+      real         r0
+      complex*16   z1
+      real*8       r1
+
+      z0 = cmplx(3.,4.)
+      r0 = cabs(z0)
+      if (r0 .ne. 5.) call abort
+
+      z1 = dcmplx(3.d0,4.d0)
+      r1 = zabs(z1)
+      if (r1 .ne. 5.d0) call abort
+      end
diff --git a/gcc/testsuite/gfortran.dg/g77/claus.f b/gcc/testsuite/gfortran.dg/g77/claus.f
new file mode 100644 (file)
index 0000000..63b9be2
--- /dev/null
@@ -0,0 +1,14 @@
+c { dg-do run }
+        PROGRAM TEST
+        REAL AB(3)
+        do i=1,3
+         AB(i)=i
+        enddo
+        k=1
+        n=2
+        ind=k-n+2
+       if (ind /= 1) call abort
+       if (ab(ind) /= 1) call abort
+       if (k-n+2 /= 1) call abort
+       if (ab(k-n+2) /= 1) call abort
+        END
diff --git a/gcc/testsuite/gfortran.dg/g77/complex_1.f b/gcc/testsuite/gfortran.dg/g77/complex_1.f
new file mode 100644 (file)
index 0000000..ddfbeff
--- /dev/null
@@ -0,0 +1,19 @@
+c { dg-do run }
+      program complex_1
+      complex      z0, z1, z2
+
+      z0 = cmplx(0.,.5)
+      z1 = 1./z0
+      if (z1 .ne. cmplx(0.,-2)) call abort
+
+      z0 = 10.*z0
+      if (z0 .ne. cmplx(0.,5.)) call abort
+
+      z2 = cmplx(1.,2.)
+      z1 = z0/z2
+      if (z1 .ne. cmplx(2.,1.)) call abort
+
+      z1 = z0*z2
+      if (z1 .ne. cmplx(-10.,5.)) call abort
+      end
+
diff --git a/gcc/testsuite/gfortran.dg/g77/cpp3.F b/gcc/testsuite/gfortran.dg/g77/cpp3.F
new file mode 100755 (executable)
index 0000000..3838773
--- /dev/null
@@ -0,0 +1,6 @@
+c { dg-do run }
+!  Some versions of cpp will delete "//'World' as a C++ comment.
+      character*40    title
+      title = 'Hello '//'World'
+      if (title .ne. 'Hello World') call abort
+      end
diff --git a/gcc/testsuite/gfortran.dg/g77/dcomplex.f b/gcc/testsuite/gfortran.dg/g77/dcomplex.f
new file mode 100644 (file)
index 0000000..8ac0052
--- /dev/null
@@ -0,0 +1,19 @@
+c { dg-do run }
+      program foo
+      complex*16      z0, z1, z2
+
+      z0 = dcmplx(0.,.5)
+      z1 = 1./z0
+      if (z1 .ne. dcmplx(0.,-2)) call abort
+
+      z0 = 10.*z0
+      if (z0 .ne. dcmplx(0.,5.)) call abort
+
+      z2 = cmplx(1.,2.)
+      z1 = z0/z2
+      if (z1 .ne. dcmplx(2.,1.)) call abort
+
+      z1 = z0*z2
+      if (z1 .ne. dcmplx(-10.,5.)) call abort
+      end
+
diff --git a/gcc/testsuite/gfortran.dg/g77/dnrm2.f b/gcc/testsuite/gfortran.dg/g77/dnrm2.f
new file mode 100644 (file)
index 0000000..7d94027
--- /dev/null
@@ -0,0 +1,75 @@
+c { dg-do run }
+CCC g77 0.5.21 `Actual Bugs':
+CCC   * A code-generation bug afflicts Intel x86 targets when `-O2' is
+CCC     specified compiling, for example, an old version of the `DNRM2'
+CCC     routine.  The x87 coprocessor stack is being somewhat mismanaged
+CCC     in cases where assigned `GOTO' and `ASSIGN' are involved.
+CCC
+CCC     Version 0.5.21 of `g77' contains an initial effort to fix the
+CCC     problem, but this effort is incomplete, and a more complete fix is
+CCC     planned for the next release.
+
+C     Currently this test fails with (at least) `-O2 -funroll-loops' on
+C     i586-unknown-linux-gnulibc1.
+
+C     (This is actually an obsolete version of dnrm2 -- consult the
+c     current Netlib BLAS.)
+
+      integer i
+      double precision a(1:100), dnrm2
+      do i=1,100
+         a(i)=0.D0
+      enddo
+      if (dnrm2(100,a,1) .ne. 0.0) call abort
+      end
+
+      double precision function dnrm2 ( n, dx, incx)
+      integer i, incx, ix, j, n, next
+      double precision   dx(1), cutlo, cuthi, hitest, sum, xmax,zero,one
+      data   zero, one /0.0d0, 1.0d0/
+      data cutlo, cuthi / 8.232d-11,  1.304d19 /
+      j = 0
+      if(n .gt. 0 .and. incx.gt.0) go to 10
+         dnrm2  = zero
+         go to 300
+   10 assign 30 to next ! { dg-warning "ASSIGN" "" }
+      sum = zero
+      i = 1
+      ix = 1
+   20    go to next,(30, 50, 70, 110) ! { dg-warning "Assigned GOTO" "" }
+   30 if( dabs(dx(i)) .gt. cutlo) go to 85
+      assign 50 to next ! { dg-warning "ASSIGN" "" }
+      xmax = zero
+   50 if( dx(i) .eq. zero) go to 200
+      if( dabs(dx(i)) .gt. cutlo) go to 85
+      assign 70 to next ! { dg-warning "ASSIGN" "" }
+      go to 105
+  100 continue
+      ix = j
+      assign 110 to next ! { dg-warning "ASSIGN" "" }
+      sum = (sum / dx(i)) / dx(i)
+  105 xmax = dabs(dx(i))
+      go to 115
+   70 if( dabs(dx(i)) .gt. cutlo ) go to 75
+  110 if( dabs(dx(i)) .le. xmax ) go to 115
+         sum = one + sum * (xmax / dx(i))**2
+         xmax = dabs(dx(i))
+         go to 200
+  115 sum = sum + (dx(i)/xmax)**2
+      go to 200
+   75 sum = (sum * xmax) * xmax
+   85 hitest = cuthi/float( n )
+      do 95 j = ix,n
+      if(dabs(dx(i)) .ge. hitest) go to 100
+         sum = sum + dx(i)**2
+         i = i + incx
+   95 continue
+      dnrm2 = dsqrt( sum )
+      go to 300
+  200 continue
+      ix = ix + 1
+      i = i + incx
+      if( ix .le. n ) go to 20
+      dnrm2 = xmax * dsqrt(sum)
+  300 continue
+      end
diff --git a/gcc/testsuite/gfortran.dg/g77/f90-intrinsic-mathematical.f b/gcc/testsuite/gfortran.dg/g77/f90-intrinsic-mathematical.f
new file mode 100644 (file)
index 0000000..12ef892
--- /dev/null
@@ -0,0 +1,138 @@
+c { dg-do run }
+c  f90-intrinsic-mathematical.f
+c
+c Test Fortran 90 intrinsic mathematical functions - Section 13.10.3 and
+c 13.13 
+c     David Billinghurst <David.Billinghurst@riotinto.com>
+c
+c Notes:
+c  * g77 does not fully comply with F90.  Noncompliances noted in comments.
+c  * Section 13.12: Specific names for intrinsic functions tested in
+c intrinsic77.f
+
+      logical fail
+      common /flags/ fail
+      fail = .false.
+
+c     ACOS - Section 13.13.3
+      call c_r(ACOS(0.54030231),1.0,'ACOS(real)')
+      call c_d(ACOS(0.54030231d0),1.d0,'ACOS(double)')
+
+c     ASIN - Section 13.13.12
+      call c_r(ASIN(0.84147098),1.0,'ASIN(real)')
+      call c_d(ASIN(0.84147098d0),1.d0,'ASIN(double)')
+
+c     ATAN - Section 13.13.14
+      call c_r(ATAN(1.5574077),1.0,'ATAN(real)')
+      call c_d(ATAN(1.5574077d0),1.d0,'ATAN(double)')
+      
+c     ATAN2 - Section 13.13.15
+      call c_r(ATAN2(1.5574077,1.),1.0,'ATAN2(real)')
+      call c_d(ATAN2(1.5574077d0,1.d0),1.d0,'ATAN2(double)')
+
+c     COS - Section 13.13.22
+      call c_r(COS(1.0),0.54030231,'COS(real)')
+      call c_d(COS(1.d0),0.54030231d0,'COS(double)')
+      call c_c(COS((1.,0.)),(0.54030231,0.),'COS(complex)')
+      call c_z(COS((1.d0,0.d0)),(0.54030231d0,0.d0),
+     $     'COS(double complex)')
+
+c     COSH - Section 13.13.23
+      call c_r(COSH(1.0),1.5430806,'COSH(real)')
+      call c_d(COSH(1.d0),1.5430806d0,'COSH(double)')
+
+c     EXP - Section 13.13.34
+      call c_r(EXP(1.0),2.7182818,'EXP(real)')
+      call c_d(EXP(1.d0),2.7182818d0,'EXP(double)')
+      call c_c(EXP((1.,0.)),(2.7182818,0.),'EXP(complex)')
+      call c_z(EXP((1.d0,0.d0)),(2.7182818d0,0.d0),
+     $     'EXP(double complex)')
+
+c     LOG - Section 13.13.59
+      call c_r(LOG(10.0),2.3025851,'LOG(real)')
+      call c_d(LOG(10.d0),2.3025851d0,'LOG(double)')
+      call c_c(LOG((10.,0.)),(2.3025851,0.),'LOG(complex)')
+      call c_z(LOG((10.d0,0.)),(2.3025851d0,0.d0),
+     $     'LOG(double complex)')
+
+c     LOG10 - Section 13.13.60
+      call c_r(LOG10(10.0),1.0,'LOG10(real)')
+      call c_d(LOG10(10.d0),1.d0,'LOG10(double)')
+
+c     SIN - Section 13.13.97
+      call c_r(SIN(1.0),0.84147098,'SIN(real)')
+      call c_d(SIN(1.d0),0.84147098d0,'SIN(double)')
+      call c_c(SIN((1.,0.)),(0.84147098,0.),'SIN(complex)')
+      call c_z(SIN((1.d0,0.d0)),(0.84147098d0,0.d0),
+     $     'SIN(double complex)')
+
+c     SINH - Section 13.13.98
+      call c_r(SINH(1.0),1.175201,'SINH(real)')
+      call c_d(SINH(1.d0),1.175201d0,'SINH(double)')
+
+c     SQRT - Section 13.13.102
+      call c_r(SQRT(4.0),2.0,'SQRT(real)')
+      call c_d(SQRT(4.d0),2.d0,'SQRT(double)')
+      call c_c(SQRT((4.,0.)),(2.,0.),'SQRT(complex)')
+      call c_z(SQRT((4.d0,0.)),(2.d0,0.),
+     $     'SQRT(double complex)')
+c     TAN - Section 13.13.105
+      call c_r(TAN(1.0),1.5574077,'TAN(real)')
+      call c_d(TAN(1.d0),1.5574077d0,'TAN(double)')
+     
+c     TANH - Section 13.13.106
+      call c_r(TANH(1.0),0.76159416,'TANH(real)')
+      call c_d(TANH(1.d0),0.76159416d0,'TANH(double)')
+
+      if ( fail ) call abort()
+      end
+
+      subroutine failure(label)
+c     Report failure and set flag
+      character*(*) label
+      logical fail
+      common /flags/ fail
+      write(6,'(a,a,a)') 'Test ',label,' FAILED'
+      fail = .true.
+      end
+
+      subroutine c_r(a,b,label)
+c     Check if REAL a equals b, and fail otherwise
+      real a, b
+      character*(*) label
+      if ( abs(a-b) .gt. 1.0e-5 ) then
+         call failure(label)
+         write(6,*) 'Got ',a,' expected ', b
+      end if
+      end
+
+      subroutine c_d(a,b,label)
+c     Check if DOUBLE PRECISION a equals b, and fail otherwise
+      double precision a, b
+      character*(*) label
+      if ( abs(a-b) .gt. 1.0d-5 ) then
+         call failure(label)
+         write(6,*) 'Got ',a,' expected ', b
+      end if
+      end
+
+      subroutine c_c(a,b,label)
+c     Check if COMPLEX a equals b, and fail otherwise
+      complex a, b
+      character*(*) label
+      if ( abs(a-b) .gt. 1.0e-5 ) then
+         call failure(label)
+         write(6,*) 'Got ',a,' expected ', b
+      end if
+      end
+
+      subroutine c_z(a,b,label)
+c     Check if COMPLEX a equals b, and fail otherwise
+      double complex a, b
+      character*(*) label
+      if ( abs(a-b) .gt. 1.0d-5 ) then
+         call failure(label)
+         write(6,*) 'Got ',a,' expected ', b
+      end if
+      end
diff --git a/gcc/testsuite/gfortran.dg/g77/f90-intrinsic-numeric.f b/gcc/testsuite/gfortran.dg/g77/f90-intrinsic-numeric.f
new file mode 100644 (file)
index 0000000..01ff8a7
--- /dev/null
@@ -0,0 +1,283 @@
+c { dg-do run }
+c  f90-intrinsic-numeric.f
+c
+c Test Fortran 90 intrinsic numeric functions - Section 13.10.2 and 13.13 
+c     David Billinghurst <David.Billinghurst@riotinto.com>
+c
+c Notes:
+c  * g77 does not fully comply with F90.  Noncompliances noted in comments.
+c  * Section 13.12: Specific names for intrinsic functions tested in
+c intrinsic77.f
+
+      logical fail
+      integer*2 j, j2, ja
+      integer*1 k, k2, ka
+
+      common /flags/ fail
+      fail = .false.
+
+c     ABS - Section 13.13.1
+      j = -9
+      ja = 9
+      k = j
+      ka = ja
+      call c_i(ABS(-7),7,'ABS(integer)')
+      call c_i2(ABS(j),ja,'ABS(integer*2)')
+      call c_i1(ABS(k),ka,'ABS(integer*1)')
+      call c_r(ABS(-7.),7.,'ABS(real)')
+      call c_d(ABS(-7.d0),7.d0,'ABS(double)')
+      call c_r(ABS((3.,-4.)),5.0,'ABS(complex)')
+      call c_d(ABS((3.d0,-4.d0)),5.0d0,'ABS(double complex)')
+
+c     AIMAG - Section 13.13.6
+      call c_r(AIMAG((2.,-7.)),-7.,'AIMAG(complex)')
+c     g77: AIMAG(double complex) does not comply with F90
+c     call c_d(AIMAG((2.d0,-7.d0)),-7.d0,'AIMAG(double complex)')
+
+c     AINT - Section 13.13.7
+      call c_r(AINT(2.783),2.0,'AINT(real) 1')
+      call c_r(AINT(-2.783),-2.0,'AINT(real) 2')
+      call c_d(AINT(2.783d0),2.0d0,'AINT(double precision) 1')
+      call c_d(AINT(-2.783d0),-2.0d0,'AINT(double precision) 2')
+c     Note:  g77 does not support optional argument KIND
+
+c     ANINT - Section 13.13.10
+      call c_r(ANINT(2.783),3.0,'ANINT(real) 1')
+      call c_r(ANINT(-2.783),-3.0,'ANINT(real) 2')
+      call c_d(ANINT(2.783d0),3.0d0,'ANINT(double precision) 1')
+      call c_d(ANINT(-2.783d0),-3.0d0,'ANINT(double precision) 2')  
+c     Note:  g77 does not support optional argument KIND
+
+c     CEILING - Section 13.13.18
+c     Not implemented
+
+c     CMPLX - Section 13.13.20
+      j = 1
+      ja = 2
+      k = 1
+      ka = 2
+      call c_c(CMPLX(1),(1.,0.),'CMPLX(integer)')
+      call c_c(CMPLX(1,2),(1.,2.),'CMPLX(integer, integer)')
+      call c_c(CMPLX(j),(1.,0.),'CMPLX(integer*2)')
+      call c_c(CMPLX(j,ja),(1.,2.),'CMPLX(integer*2, integer*2)')
+      call c_c(CMPLX(k),(1.,0.),'CMPLX(integer*1)')
+      call c_c(CMPLX(k,ka),(1.,2.),'CMPLX(integer*1, integer*1)')
+      call c_c(CMPLX(1.),(1.,0.),'CMPLX(real)')
+      call c_c(CMPLX(1.d0),(1.,0.),'CMPLX(double)')
+      call c_c(CMPLX(1.d0,2.d0),(1.,2.),'CMPLX(double,double)')
+      call c_c(CMPLX(1.,2.),(1.,2.),'CMPLX(complex)')
+      call c_c(CMPLX(1.d0,2.d0),(1.,2.),'CMPLX(double complex)')
+c     NOTE: g77 does not support optional argument KIND
+   
+c     CONJG - Section 13.13.21
+      call c_c(CONJG((2.,-7.)),(2.,7.),'CONJG(complex)')
+      call c_z(CONJG((2.d0,-7.d0)),(2.d0,7.d0),'CONJG(double complex)')
+
+c     DBLE - Section 13.13.27
+      j = 5
+      k = 5
+      call c_d(DBLE(5),5.0d0,'DBLE(integer)')
+      call c_d(DBLE(j),5.0d0,'DBLE(integer*2)')
+      call c_d(DBLE(k),5.0d0,'DBLE(integer*1)')
+      call c_d(DBLE(5.),5.0d0,'DBLE(real)')
+      call c_d(DBLE(5.0d0),5.0d0,'DBLE(double)')
+      call c_d(DBLE((5.0,0.5)),5.0d0,'DBLE(complex)')
+      call c_d(DBLE((5.0d0,0.5d0)),5.0d0,'DBLE(double complex)')
+
+c     DIM - Section 13.13.29
+      j = -8
+      j2 = -3
+      ja = 0
+      k = -8
+      k2 = -3
+      ka = 0
+      call c_i(DIM(-8,-3),0,'DIM(integer)')
+      call c_i2(DIM(j,j2),ja,'DIM(integer*2)')
+      call c_i1(DIM(k,k2),ka,'DIM(integer*1)')
+      call c_r(DIM(-8.,-3.),0.,'DIM(real,real)')
+      call c_d(DIM(-8.d0,-3.d0),0.d0,'DIM(double,double)')
+c     DPROD - Section 13.13.31
+      call c_d(DPROD(-8.,-3.),24.d0,'DPROD(real,real)')
+     
+c     FLOOR - Section 13.13.36
+c     Not implemented
+
+c     INT - Section 13.13.47
+      j = 5
+      k = 5
+      call c_i(INT(5),5,'INT(integer)')
+      call c_i(INT(j),5,'INT(integer*2)')
+      call c_i(INT(k),5,'INT(integer*1)')
+      call c_i(INT(5.01),5,'INT(real)')
+      call c_i(INT(5.01d0),5,'INT(double)')
+c     Note: Does not accept optional second argument KIND
+
+c     MAX - Section 13.13.63
+      j = 1
+      j2 = 2
+      ja = 2
+      k = 1
+      k2 = 2
+      ka = 2
+      call c_i(MAX(1,2,3),3,'MAX(integer,integer,integer)')
+      call c_i2(MAX(j,j2),ja,'MAX(integer*2,integer*2)')
+      call c_i1(MAX(k,k2),ka,'MAX(integer*1,integer*1)')
+      call c_r(MAX(1.,2.,3.),3.,'MAX(real,real,real)')
+      call c_d(MAX(1.d0,2.d0,3.d0),3.d0,'MAX(double,double,double)')
+
+c     MIN - Section 13.13.68
+      j = 1
+      j2 = 2
+      ja = 1
+      k = 1
+      k2 = 2
+      ka = 1
+      call c_i(MIN(1,2,3),1,'MIN(integer,integer,integer)')
+      call c_i2(MIN(j,j2),ja,'MIN(integer*2,integer*2)')
+      call c_i1(MIN(k,k2),ka,'MIN(integer*1,integer*1)')
+      call c_r(MIN(1.,2.,3.),1.,'MIN(real,real,real)')
+      call c_d(MIN(1.d0,2.d0,3.d0),1.d0,'MIN(double,double,double)')
+
+c     MOD - Section 13.13.72
+      call c_i(MOD(8,5),3,'MOD(integer,integer) 1')
+      call c_i(MOD(-8,5),-3,'MOD(integer,integer) 2')
+      call c_i(MOD(8,-5),3,'MOD(integer,integer) 3')
+      call c_i(MOD(-8,-5),-3,'MOD(integer,integer) 4')
+      j = 8
+      j2 = 5
+      ja = 3
+      call c_i2(MOD(j,j2),ja,'MOD(integer*2,integer*2) 1')
+      call c_i2(MOD(-j,j2),-ja,'MOD(integer*2,integer*2) 2')
+      call c_i2(MOD(j,-j2),ja,'MOD(integer*2,integer*2) 3')
+      call c_i2(MOD(-j,-j2),-ja,'MOD(integer*2,integer*2) 4')
+      k = 8
+      k2 = 5
+      ka = 3
+      call c_i1(MOD(k,k2),ka,'MOD(integer*1,integer*1) 1')
+      call c_i1(MOD(-k,k2),-ka,'MOD(integer*1,integer*1) 2')
+      call c_i1(MOD(k,-k2),ka,'MOD(integer*1,integer*1) 3')
+      call c_i1(MOD(-k,-k2),-ka,'MOD(integer*1,integer*1) 4')
+      call c_r(MOD(8.,5.),3.,'MOD(real,real) 1')
+      call c_r(MOD(-8.,5.),-3.,'MOD(real,real) 2')
+      call c_r(MOD(8.,-5.),3.,'MOD(real,real) 3')
+      call c_r(MOD(-8.,-5.),-3.,'MOD(real,real) 4')
+      call c_d(MOD(8.d0,5.d0),3.d0,'MOD(double,double) 1')
+      call c_d(MOD(-8.d0,5.d0),-3.d0,'MOD(double,double) 2')
+      call c_d(MOD(8.d0,-5.d0),3.d0,'MOD(double,double) 3')
+      call c_d(MOD(-8.d0,-5.d0),-3.d0,'MOD(double,double) 4')
+
+c     MODULO - Section 13.13.73
+c     Not implemented
+
+c     NINT - Section 13.13.76
+      call c_i(NINT(2.783),3,'NINT(real)')
+      call c_i(NINT(2.783d0),3,'NINT(double)')
+c     Optional second argument KIND not implemented
+
+c     REAL - Section 13.13.86
+      j = -2
+      k = -2
+      call c_r(REAL(-2),-2.0,'REAL(integer)')
+      call c_r(REAL(j),-2.0,'REAL(integer*2)')
+      call c_r(REAL(k),-2.0,'REAL(integer*1)')
+      call c_r(REAL(-2.0),-2.0,'REAL(real)')
+      call c_r(REAL(-2.0d0),-2.0,'REAL(double)')
+      call c_r(REAL((-2.,9.)),-2.0,'REAL(complex)')
+c     REAL(double complex) not implemented
+c     call c_r(REAL((-2.d0,9.d0)),-2.0,'REAL(double complex)')
+
+c     SIGN - Section 13.13.96
+      j = -3
+      j2 = 2
+      ja = 3
+      k = -3
+      k2 = 2
+      ka = 3
+      call c_i(SIGN(-3,2),3,'SIGN(integer)')
+      call c_i2(SIGN(j,j2),ja,'SIGN(integer*2)')
+      call c_i1(SIGN(k,k2),ka,'SIGN(integer*1)')
+      call c_r(SIGN(-3.0,2.),3.,'SIGN(real,real)')
+      call c_d(SIGN(-3.d0,2.d0),3.d0,'SIGN(double,double)')
+      if ( fail ) call abort()
+      end
+
+      subroutine failure(label)
+c     Report failure and set flag
+      character*(*) label
+      logical fail
+      common /flags/ fail
+      write(6,'(a,a,a)') 'Test ',label,' FAILED'
+      fail = .true.
+      end
+
+      subroutine c_i(i,j,label)
+c     Check if INTEGER i equals j, and fail otherwise
+      integer i,j
+      character*(*) label
+      if ( i .ne. j ) then
+         call failure(label)
+         write(6,*) 'Got ',i,' expected ', j
+      end if
+      end
+
+      subroutine c_i2(i,j,label)
+c     Check if INTEGER*2 i equals j, and fail otherwise
+      integer*2 i,j
+      character*(*) label
+      if ( i .ne. j ) then
+         call failure(label)
+         write(6,*) 'Got ',i,' expected ', j
+      end if
+      end
+
+      subroutine c_i1(i,j,label)
+c     Check if INTEGER*1 i equals j, and fail otherwise
+      integer*1 i,j
+      character*(*) label
+      if ( i .ne. j ) then
+         call failure(label)
+         write(6,*) 'Got ',i,' expected ', j
+      end if
+      end
+
+      subroutine c_r(a,b,label)
+c     Check if REAL a equals b, and fail otherwise
+      real a, b
+      character*(*) label
+      if ( abs(a-b) .gt. 1.0e-5 ) then
+         call failure(label)
+         write(6,*) 'Got ',a,' expected ', b
+      end if
+      end
+
+      subroutine c_d(a,b,label)
+c     Check if DOUBLE PRECISION a equals b, and fail otherwise
+      double precision a, b
+      character*(*) label
+      if ( abs(a-b) .gt. 1.0d-5 ) then
+         call failure(label)
+         write(6,*) 'Got ',a,' expected ', b
+      end if
+      end
+
+      subroutine c_c(a,b,label)
+c     Check if COMPLEX a equals b, and fail otherwise
+      complex a, b
+      character*(*) label
+      if ( abs(a-b) .gt. 1.0e-5 ) then
+         call failure(label)
+         write(6,*) 'Got ',a,' expected ', b
+      end if
+      end
+
+      subroutine c_z(a,b,label)
+c     Check if COMPLEX a equals b, and fail otherwise
+      double complex a, b
+      character*(*) label
+      if ( abs(a-b) .gt. 1.0d-5 ) then
+         call failure(label)
+         write(6,*) 'Got ',a,' expected ', b
+      end if
+      end
diff --git a/gcc/testsuite/gfortran.dg/g77/int8421.f b/gcc/testsuite/gfortran.dg/g77/int8421.f
new file mode 100644 (file)
index 0000000..3e4625f
--- /dev/null
@@ -0,0 +1,21 @@
+c { dg-do run }
+      integer*1 i1, i11
+      integer*2 i2, i22
+      integer   i, ii
+      integer*4 i4, i44
+      integer*8 i8, i88
+      real      r, rr
+      real*4    r4, r44
+      double precision d, dd
+      real*8    r8, r88
+      parameter (i1 = 1, i2 = 2, i4 = 4, i = 5, i8 = i + i4*i2 + i2*i1)
+      parameter (r = 3.0, r4 = 4.0, r8 = 8.d0, d = i8*r + r4*i2 + r8*i1)
+      if (i8 .ne. 15   ) call abort
+      if (d  .ne. 61.d0) call abort
+      i11 = 1; i22 = 2; i44 = 4; ii = 5
+      i88 = i + i4*i2 + i2*i1
+      if (i88 .ne. i8) call abort
+      rr = 3.0; r44 = 4.0; r88 = 8.0d0
+      dd = i88*rr + r44*i22 + r88*i11
+      if (dd .ne. d) call abort
+      end
diff --git a/gcc/testsuite/gfortran.dg/g77/labug1.f b/gcc/testsuite/gfortran.dg/g77/labug1.f
new file mode 100644 (file)
index 0000000..d004f76
--- /dev/null
@@ -0,0 +1,58 @@
+c { dg-do run }
+      PROGRAM LABUG1
+
+*  This program core dumps on mips-sgi-irix6.2 when compiled
+*  with egcs-19981101, egcs-19981109 and egcs-19981122 snapshots
+*  with -O2
+*
+*  Originally derived from LAPACK test suite.
+*  Almost any change allows it to run.
+*
+*  David Billinghurst, (David.Billinghurst@riotinto.com.au)
+*  25 November 1998
+* 
+*     .. Parameters ..
+      INTEGER   LDA, LDE
+      PARAMETER ( LDA = 2500, LDE = 50  )
+      COMPLEX   CZERO 
+      PARAMETER ( CZERO = ( 0.0E+0, 0.0E+0 ) )
+
+      INTEGER   I, J, M, N
+      REAL      V
+      COMPLEX   A(LDA),B(LDA),C(LDA),E(LDE,LDE),F(LDE,LDE)  
+      COMPLEX   Z
+
+      N=2
+      M=1
+*
+      do i = 1, m
+         do j = 1, n
+            e(i,j) = czero
+            f(i,j) = czero
+        end do
+      end do
+*
+      DO J = 1, N
+         DO I = 1, M
+            V =  ABS( E(I,J) - F(I,J) )
+         END DO
+      END DO
+      CALL SUB2(M,Z)
+
+      END
+
+      subroutine SUB2(I,A)
+      integer i
+      complex a
+      end
+
+
+
+
+
+
+
+
+
+
diff --git a/gcc/testsuite/gfortran.dg/g77/large_vec.f b/gcc/testsuite/gfortran.dg/g77/large_vec.f
new file mode 100644 (file)
index 0000000..f5ff87d
--- /dev/null
@@ -0,0 +1,4 @@
+c { dg-do run }
+      parameter (nmax=165000)
+      double precision x(nmax)
+      end
diff --git a/gcc/testsuite/gfortran.dg/g77/le.f b/gcc/testsuite/gfortran.dg/g77/le.f
new file mode 100644 (file)
index 0000000..c62ac46
--- /dev/null
@@ -0,0 +1,30 @@
+c { dg-do run }
+      program fool
+
+      real     foo
+      integer  n
+      logical  t
+
+      foo = 2.5
+      n = 5
+
+      t = (n > foo)
+      if (t .neqv. .true.) call abort
+      t = (n >= foo)
+      if (t .neqv. .true.) call abort
+      t = (n < foo)
+      if (t .neqv. .false.) call abort
+      t = (n <= 5)
+      if (t .neqv. .true.) call abort
+      t = (n >= 5 )
+      if (t .neqv. .true.) call abort
+      t = (n == 5)
+      if (t .neqv. .true.) call abort
+      t = (n /= 5)
+      if (t .neqv. .false.) call abort
+      t = (n /= foo)
+      if (t .neqv. .true.) call abort
+      t = (n == foo)
+      if (t .neqv. .false.) call abort
+
+      end
diff --git a/gcc/testsuite/gfortran.dg/g77/short.f b/gcc/testsuite/gfortran.dg/g77/short.f
new file mode 100644 (file)
index 0000000..3f0e122
--- /dev/null
@@ -0,0 +1,58 @@
+c { dg-do run }
+      program short
+
+      parameter   (   N=2  )
+      common /chb/    pi,sig(0:N)
+      common /parm/   h(2,2)
+
+c  initialize some variables
+      h(2,2) = 1117
+      h(2,1) = 1178
+      h(1,2) = 1568
+      h(1,1) = 1621
+      sig(0) = -1.
+      sig(1) = 0.
+      sig(2) = 1.
+
+      call printout
+      stop
+      end
+
+c ******************************************************************
+
+      subroutine printout
+      parameter   (   N=2  )
+      common /chb/    pi,sig(0:N)
+      common /parm/   h(2,2)
+      dimension       yzin1(0:N), yzin2(0:N)
+
+c  function subprograms
+      z(i,j,k) = 0.5*h(i,j)*(sig(k)-1.)
+
+c  a four-way average of rhobar
+      do 260  k=0,N
+        yzin1(k) = 0.25 * 
+     &       ( z(2,2,k) + z(1,2,k) +
+     &         z(2,1,k) + z(1,1,k) )
+  260       continue
+
+c  another four-way average of rhobar
+      do 270  k=0,N
+       rtmp1 = z(2,2,k)
+       rtmp2 = z(1,2,k)
+       rtmp3 = z(2,1,k)
+       rtmp4 = z(1,1,k)
+        yzin2(k) = 0.25 * 
+     &       ( rtmp1 + rtmp2 + rtmp3 + rtmp4 )
+  270       continue
+
+      do k=0,N
+       if (yzin1(k) .ne. yzin2(k)) call abort
+      enddo
+      if (yzin1(0) .ne. -1371.) call abort
+      if (yzin1(1) .ne. -685.5) call abort
+      if (yzin1(2) .ne. 0.) call abort
+
+      return
+      end
+