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
)