From 554fd8c5195424bdbcabf5de30fdc183aba391bd Mon Sep 17 00:00:00 2001
From: upstream source tree <ports@midipix.org>
Date: Sun, 15 Mar 2015 20:14:05 -0400
Subject: obtained gcc-4.6.4.tar.bz2 from upstream website; verified
 gcc-4.6.4.tar.bz2.sig; imported gcc-4.6.4 source tree from verified upstream
 tarball.

downloading a git-generated archive based on the 'upstream' tag
should provide you with a source tree that is binary identical
to the one extracted from the above tarball.

if you have obtained the source via the command 'git clone',
however, do note that line-endings of files in your working
directory might differ from line-endings of the respective
files in the upstream repository.
---
 gcc/testsuite/gfortran.dg/g77/dnrm2.f | 76 +++++++++++++++++++++++++++++++++++
 1 file changed, 76 insertions(+)
 create mode 100644 gcc/testsuite/gfortran.dg/g77/dnrm2.f

(limited to 'gcc/testsuite/gfortran.dg/g77/dnrm2.f')

diff --git a/gcc/testsuite/gfortran.dg/g77/dnrm2.f b/gcc/testsuite/gfortran.dg/g77/dnrm2.f
new file mode 100644
index 000000000..dbf9f0d05
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/dnrm2.f
@@ -0,0 +1,76 @@
+c { dg-do run }
+c { dg-options "-fno-bounds-check" }
+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
-- 
cgit v1.2.3