New test.

From-SVN: r16577

diff --git a/gcc/testsuite/g77.f-torture/execute/dnrm2.f b/gcc/testsuite/g77.f-torture/execute/dnrm2.f
new file mode 100644 (file)
index 0000000..649e872
--- /dev/null
+++ b/gcc/testsuite/g77.f-torture/execute/dnrm2.f
@@ -0,0 +1,72 @@
+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)
+      do i=1,100
+         a(i)=0.D0
+      enddo
+      if (dnrm2(100,a,1) .ne. 0.0) call exit(1)
+      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/
+      if(n .gt. 0 .and. incx.gt.0) go to 10
+         dnrm2  = zero
+         go to 300
+   10 assign 30 to next
+      sum = zero
+      i = 1
+      ix = 1
+   20    go to next,(30, 50, 70, 110)
+   30 if( dabs(dx(i)) .gt. cutlo) go to 85
+      assign 50 to next
+      xmax = zero
+   50 if( dx(i) .eq. zero) go to 200
+      if( dabs(dx(i)) .gt. cutlo) go to 85
+      assign 70 to next
+      go to 105
+  100 continue
+      ix = j
+      assign 110 to next
+      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