Skip to content

Commit

Permalink
Use a better (more informative) message when we say the compiler intr…
Browse files Browse the repository at this point in the history 
…insics fail
  • Loading branch information
@weslleyspereira
weslleyspereira committed May 30, 2023
1 parent c8f7bbb commit 35b7a4b
Show file tree
Hide file tree
Showing 4 changed files with 102 additions and 6 deletions.
30 changes: 27 additions & 3 deletions INSTALL/test_zcomplexabs.f
View file
Original file line number Diff line number Diff line change
Expand Up @@ -59,7 +59,8 @@ program zabs
* ..
* .. Local Variables ..
integer i, min, Max, m, subnormalTreatedAs0,
$ caseAFails, caseBFails, caseCFails, caseDFails
$ caseAFails, caseBFails, caseCFails, caseDFails,
$ caseEFails, caseFFails, nFailingTests, nTests
double precision X( N ), R, answerC,
$ answerD, aInf, aNaN, relDiff, b,
$ eps, blueMin, blueMax, Xj, stepX(N), limX(N)
Expand All @@ -77,6 +78,10 @@ program zabs
caseBFails = 0
caseCFails = 0
caseDFails = 0
caseEFails = 0
caseFFails = 0
nFailingTests = 0
nTests = 0
*
* .. Initialize machine constants ..
min = MINEXPONENT(0.0d0)
Expand Down Expand Up @@ -156,6 +161,7 @@ program zabs
endif
else
do while( Xj .ne. limX(i) )
nTests = nTests + 1
Y = DCMPLX( Xj, 0.0d0 )
R = ABS( Y )
if( R .ne. Xj ) then
Expand All @@ -180,6 +186,7 @@ program zabs
endif
else
do while( Xj .ne. limX(i) )
nTests = nTests + 1
Y = DCMPLX( 0.0d0, Xj )
R = ABS( Y )
if( R .ne. Xj ) then
Expand Down Expand Up @@ -209,6 +216,7 @@ program zabs
endif
else
do while( Xj .ne. limX(i) )
nTests = nTests + 1
answerC = fiveFourth * Xj
Y = DCMPLX( threeFourth * Xj, Xj )
R = ABS( Y )
Expand Down Expand Up @@ -247,6 +255,7 @@ program zabs
print *, "!! [d] fl( subnormal ) may be 0"
endif
else
nTests = nTests + 1
Y = DCMPLX( oneHalf * Xj, oneHalf * Xj )
R = ABS( Y )
relDiff = ABS(R-answerD)/answerD
Expand All @@ -267,26 +276,41 @@ program zabs
*
* Test (e) Infs
do 50 i = 1, nInf
nTests = nTests + 1
Y = cInf(i)
R = ABS( Y )
if( .not.(R .gt. HUGE(0.0d0)) ) then
caseEFails = caseEFails + 1
WRITE( *, FMT = 9997 ) 'i',i, Y, R
endif
50 continue
*
* Test (f) NaNs
do 60 i = 1, nNaN
nTests = nTests + 1
Y = cNaN(i)
R = ABS( Y )
if( R .eq. R ) then
caseFFails = caseFFails + 1
WRITE( *, FMT = 9998 ) 'n',i, Y, R
endif
60 continue
*
* If any test fails, displays a message
nFailingTests = caseAFails + caseBFails + caseCFails + caseDFails
$ + caseEFails + caseFFails
if( nFailingTests .gt. 0 ) then
print *, "# ", nTests-nFailingTests, " tests out of ", nTests,
$ " pass for ABS(a+b*I),", nFailingTests, " tests fail."
else
print *, "# All tests pass for ABS(a+b*I)"
endif
*
* If anything was written to stderr, print the message
if( (caseAFails .gt. 0) .or. (caseBFails .gt. 0) .or.
$ (caseCFails .gt. 0) .or. (caseDFails .gt. 0) )
$ print *, "# Please check the failed ABS(a+b*I) in [stderr]"
$ (caseCFails .gt. 0) .or. (caseDFails .gt. 0) ) then
print *, "# Please check the failed ABS(a+b*I) in [stderr]"
endif
*
* .. Formats ..
9997 FORMAT( '[',A1,I1, '] ABS(', (ES8.1,SP,ES8.1,"*I"), ' ) = ',
Expand Down
33 changes: 32 additions & 1 deletion INSTALL/test_zcomplexdiv.f
View file
Original file line number Diff line number Diff line change
Expand Up @@ -75,7 +75,9 @@ program zdiv
* .. Local Variables ..
integer i, min, Max, m,
$ subnormalTreatedAs0, caseAFails, caseBFails,
$ caseCFails, caseDFails, caseEFails, caseFFails
$ caseCFails, caseDFails, caseEFails, caseFFails,
$ caseInfFails, caseNaNFails, nFailingTests,
$ nTests
double precision X( N ), aInf, aNaN, b,
$ eps, blueMin, blueMax, OV, Xj, stepX(N), limX(N)
double complex Y, Y2, R, cInf( nInf ), cNaN( nNaN )
Expand All @@ -94,6 +96,10 @@ program zdiv
caseDFails = 0
caseEFails = 0
caseFFails = 0
caseInfFails = 0
caseNaNFails = 0
nFailingTests = 0
nTests = 0
*
* .. Initialize machine constants ..
min = MINEXPONENT(0.0d0)
Expand Down Expand Up @@ -174,6 +180,7 @@ program zdiv
endif
else
do while( Xj .ne. limX(i) )
nTests = nTests + 1
Y = DCMPLX( Xj, 0.0d0 )
R = Y / Y
if( R .ne. 1.0D0 ) then
Expand All @@ -199,6 +206,7 @@ program zdiv
endif
else
do while( Xj .ne. limX(i) )
nTests = nTests + 1
Y = DCMPLX( 0.0d0, Xj )
R = Y / Y
if( R .ne. 1.0D0 ) then
Expand All @@ -224,6 +232,7 @@ program zdiv
endif
else
do while( Xj .ne. limX(i) )
nTests = nTests + 1
Y = DCMPLX( Xj, Xj )
R = Y / Y
if( R .ne. 1.0D0 ) then
Expand All @@ -249,6 +258,7 @@ program zdiv
endif
else
do while( Xj .ne. limX(i) )
nTests = nTests + 1
Y = DCMPLX( 0.0d0, Xj )
Y2 = DCMPLX( Xj, 0.0d0 )
R = Y / Y2
Expand All @@ -275,6 +285,7 @@ program zdiv
endif
else
do while( Xj .ne. limX(i) )
nTests = nTests + 1
Y = DCMPLX( 0.0d0, Xj )
Y2 = DCMPLX( Xj, 0.0d0 )
R = Y2 / Y
Expand All @@ -301,6 +312,7 @@ program zdiv
endif
else
do while( Xj .ne. limX(i) )
nTests = nTests + 1
Y = DCMPLX( Xj, Xj )
R = Y / DCONJG( Y )
if( R .ne. DCMPLX(0.0D0,1.0D0) ) then
Expand All @@ -318,38 +330,57 @@ program zdiv
*
* Test (g) Infs
do 70 i = 1, nInf
nTests = nTests + 3
Y = cInf(i)
R = czero / Y
if( (R .ne. czero) .and. (R .eq. R) ) then
caseInfFails = caseInfFails + 1
WRITE( *, FMT = 9998 ) 'ia',i, czero, Y, R, 'NaN and 0'
endif
R = cone / Y
if( (R .ne. czero) .and. (R .eq. R) ) then
caseInfFails = caseInfFails + 1
WRITE( *, FMT = 9998 ) 'ib',i, cone, Y, R, 'NaN and 0'
endif
R = Y / Y
if( R .eq. R ) then
caseInfFails = caseInfFails + 1
WRITE( *, FMT = 9998 ) 'ic',i, Y, Y, R, 'NaN'
endif
70 continue
*
* Test (h) NaNs
do 80 i = 1, nNaN
nTests = nTests + 3
Y = cNaN(i)
R = czero / Y
if( R .eq. R ) then
caseNaNFails = caseNaNFails + 1
WRITE( *, FMT = 9998 ) 'na',i, czero, Y, R, 'NaN'
endif
R = cone / Y
if( R .eq. R ) then
caseNaNFails = caseNaNFails + 1
WRITE( *, FMT = 9998 ) 'nb',i, cone, Y, R, 'NaN'
endif
R = Y / Y
if( R .eq. R ) then
caseNaNFails = caseNaNFails + 1
WRITE( *, FMT = 9998 ) 'nc',i, Y, Y, R, 'NaN'
endif
80 continue
*
* If any test fails, displays a message
nFailingTests = caseAFails + caseBFails + caseCFails + caseDFails
$ + caseEFails + caseFFails + caseInfFails
$ + caseNaNFails
if( nFailingTests .gt. 0 ) then
print *, "# ", nTests-nFailingTests, " tests out of ", nTests,
$ " pass for complex division,", nFailingTests," fail."
else
print *, "# All tests pass for complex division."
endif
*
* If anything was written to stderr, print the message
if( (caseAFails .gt. 0) .or. (caseBFails .gt. 0) .or.
$ (caseCFails .gt. 0) .or. (caseDFails .gt. 0) .or.
Expand Down
23 changes: 22 additions & 1 deletion INSTALL/test_zcomplexmult.f
View file
Original file line number Diff line number Diff line change
Expand Up @@ -55,14 +55,18 @@ program zmul
$ cone = DCMPLX( 1.0d0, 0.0d0 ) )
* ..
* .. Local Variables ..
integer i
integer i, nFailingTests, nTests
double precision aInf, aNaN, OV
double complex Y, R, cInf( nInf ), cNaN( nNaN )
*
* .. Intrinsic Functions ..
intrinsic HUGE, DCMPLX

*
* .. Initialize error counts ..
nFailingTests = 0
nTests = 0
*
* .. Inf entries ..
OV = HUGE(0.0d0)
aInf = OV * 2
Expand All @@ -83,48 +87,65 @@ program zmul
*
* Test (a) Infs
do 10 i = 1, nInf
nTests = nTests + 3
Y = cInf(i)
R = czero * Y
if( R .eq. R ) then
nFailingTests = nFailingTests + 1
WRITE( *, FMT = 9998 ) 'ia',i, czero, Y, R, 'NaN'
endif
R = cone * Y
if( (R .ne. Y) .and. (R .eq. R) ) then
nFailingTests = nFailingTests + 1
WRITE( *, FMT = 9998 ) 'ib',i, cone, Y, R,
$ 'the input and NaN'
endif
R = Y * Y
if( (i.eq.1) .or. (i.eq.2) ) then
if( (R .ne. cInf(1)) .and. (R .eq. R) ) then
nFailingTests = nFailingTests + 1
WRITE( *, FMT = 9998 ) 'ic',i, Y, Y, R, 'Inf and NaN'
endif
else if( (i.eq.3) .or. (i.eq.4) ) then
if( (R .ne. cInf(2)) .and. (R .eq. R) ) then
nFailingTests = nFailingTests + 1
WRITE( *, FMT = 9998 ) 'ic',i, Y, Y, R, '-Inf and NaN'
endif
else
if( R .eq. R ) then
nFailingTests = nFailingTests + 1
WRITE( *, FMT = 9998 ) 'ic',i, Y, Y, R, 'NaN'
endif
endif
10 continue
*
* Test (b) NaNs
do 20 i = 1, nNaN
nTests = nTests + 3
Y = cNaN(i)
R = czero * Y
if( R .eq. R ) then
nFailingTests = nFailingTests + 1
WRITE( *, FMT = 9998 ) 'na',i, czero, Y, R, 'NaN'
endif
R = cone * Y
if( R .eq. R ) then
nFailingTests = nFailingTests + 1
WRITE( *, FMT = 9998 ) 'nb',i, cone, Y, R, 'NaN'
endif
R = Y * Y
if( R .eq. R ) then
nFailingTests = nFailingTests + 1
WRITE( *, FMT = 9998 ) 'nc',i, Y, Y, R, 'NaN'
endif
20 continue
*
if( nFailingTests .gt. 0 ) then
print *, "# ", nTests-nFailingTests, " tests out of ", nTests,
$ " pass for complex multiplication,", nFailingTests," fail."
else
print *, "# All tests pass for complex multiplication."
endif
*
* .. Formats ..
9998 FORMAT( '[',A2,I1, '] (', (ES24.16E3,SP,ES24.16E3,"*I"), ') * (',
Expand Down
22 changes: 21 additions & 1 deletion INSTALL/test_zminMax.f
View file
Original file line number Diff line number Diff line change
Expand Up @@ -44,13 +44,17 @@ program zmul
parameter ( zero = 0.0d0 )
* ..
* .. Local Variables ..
integer i
integer i, nFailingTests, nTests
double precision aInf, aNaN, OV, R, X(n), Y(n)
*
* .. Intrinsic Functions ..
intrinsic HUGE, MIN, MAX

*
* .. Initialize error counts ..
nFailingTests = 0
nTests = 0
*
* .. Inf and NaN entries ..
OV = HUGE(0.0d0)
aInf = OV * 2
Expand All @@ -62,35 +66,51 @@ program zmul
* .. Tests ..
*
do 10 i = 1, 3
nTests = nTests + 2
R = MIN( X(i), Y(i) )
if( R .ne. X(i) ) then
nFailingTests = nFailingTests + 1
WRITE( *, FMT = 9998 ) 'i',i, 'MIN', X(i), Y(i), R
endif
R = MAX( X(i), Y(i) )
if( R .ne. Y(i) ) then
nFailingTests = nFailingTests + 1
WRITE( *, FMT = 9998 ) 'i',i, 'MAX', X(i), Y(i), R
endif
10 continue
do 20 i = 4, 6
nTests = nTests + 2
R = MIN( X(i), Y(i) )
if( R .ne. Y(i) ) then
nFailingTests = nFailingTests + 1
WRITE( *, FMT = 9998 ) 'i',i, 'MIN', X(i), Y(i), R
endif
R = MAX( X(i), Y(i) )
if( R .ne. X(i) ) then
nFailingTests = nFailingTests + 1
WRITE( *, FMT = 9998 ) 'i',i, 'MAX', X(i), Y(i), R
endif
20 continue
do 30 i = 7, 8
nTests = nTests + 2
R = MIN( X(i), Y(i) )
if( R .eq. R ) then
nFailingTests = nFailingTests + 1
WRITE( *, FMT = 9998 ) 'i',i, 'MIN', X(i), Y(i), R
endif
R = MAX( X(i), Y(i) )
if( R .eq. R ) then
nFailingTests = nFailingTests + 1
WRITE( *, FMT = 9998 ) 'i',i, 'MAX', X(i), Y(i), R
endif
30 continue
*
if( nFailingTests .gt. 0 ) then
print *, "# ", nTests-nFailingTests, " tests out of ", nTests,
$ " pass for intrinsic MIN and MAX,", nFailingTests," fail."
else
print *, "# All tests pass for intrinsic MIN and MAX."
endif
*
* .. Formats ..
9998 FORMAT( '[',A1,I1, '] ', A3, '(', F5.0, ',', F5.0, ') = ', F5.0 )
Expand Down

0 comments on commit 35b7a4b

Please sign in to comment.