2 c { dg-options "-fno-bounds-check" }
3 CCC g77 0.5.21 `Actual Bugs':
4 CCC * A code-generation bug afflicts Intel x86 targets when `-O2' is
5 CCC specified compiling, for example, an old version of the `DNRM2'
6 CCC routine. The x87 coprocessor stack is being somewhat mismanaged
7 CCC in cases where assigned `GOTO' and `ASSIGN' are involved.
9 CCC Version 0.5.21 of `g77' contains an initial effort to fix the
10 CCC problem, but this effort is incomplete, and a more complete fix is
11 CCC planned for the next release.
13 C Currently this test fails with (at least) `-O2 -funroll-loops' on
14 C i586-unknown-linux-gnulibc1.
16 C (This is actually an obsolete version of dnrm2 -- consult the
17 c current Netlib BLAS.)
20 double precision a(1:100), dnrm2
24 if (dnrm2(100,a,1) .ne. 0.0) call abort
27 double precision function dnrm2 ( n, dx, incx)
28 integer i, incx, ix, j, n, next
29 double precision dx(1), cutlo, cuthi, hitest, sum, xmax,zero,one
30 data zero, one /0.0d0, 1.0d0/
31 data cutlo, cuthi / 8.232d-11, 1.304d19 /
33 if(n .gt. 0 .and. incx.gt.0) go to 10
36 10 assign 30 to next ! { dg-warning "ASSIGN" "" }
40 20 go to next,(30, 50, 70, 110) ! { dg-warning "Assigned GOTO" "" }
41 30 if( dabs(dx(i)) .gt. cutlo) go to 85
42 assign 50 to next ! { dg-warning "ASSIGN" "" }
44 50 if( dx(i) .eq. zero) go to 200
45 if( dabs(dx(i)) .gt. cutlo) go to 85
46 assign 70 to next ! { dg-warning "ASSIGN" "" }
50 assign 110 to next ! { dg-warning "ASSIGN" "" }
51 sum = (sum / dx(i)) / dx(i)
52 105 xmax = dabs(dx(i))
54 70 if( dabs(dx(i)) .gt. cutlo ) go to 75
55 110 if( dabs(dx(i)) .le. xmax ) go to 115
56 sum = one + sum * (xmax / dx(i))**2
59 115 sum = sum + (dx(i)/xmax)**2
61 75 sum = (sum * xmax) * xmax
62 85 hitest = cuthi/float( n )
64 if(dabs(dx(i)) .ge. hitest) go to 100
73 if( ix .le. n ) go to 20
74 dnrm2 = xmax * dsqrt(sum)