Skip to content

Commit f86d08b

Browse files
langoulangou
authored
Merge pull request #845 from weslleyspereira/try-better-message-fortran-intrinsic-tests
2 parents c8f7bbb + 35b7a4b commit f86d08b

4 files changed

Lines changed: 102 additions & 6 deletions

File tree

‎INSTALL/test_zcomplexabs.f‎

Lines changed: 27 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -59,7 +59,8 @@ program zabs
5959
* ..
6060
* .. Local Variables ..
6161
integer i, min, Max, m, subnormalTreatedAs0,
62-
$ caseAFails, caseBFails, caseCFails, caseDFails
62+
$ caseAFails, caseBFails, caseCFails, caseDFails,
63+
$ caseEFails, caseFFails, nFailingTests, nTests
6364
double precision X( N ), R, answerC,
6465
$ answerD, aInf, aNaN, relDiff, b,
6566
$ eps, blueMin, blueMax, Xj, stepX(N), limX(N)
@@ -77,6 +78,10 @@ program zabs
7778
caseBFails = 0
7879
caseCFails = 0
7980
caseDFails = 0
81+
caseEFails = 0
82+
caseFFails = 0
83+
nFailingTests = 0
84+
nTests = 0
8085
*
8186
* .. Initialize machine constants ..
8287
min = MINEXPONENT(0.0d0)
@@ -156,6 +161,7 @@ program zabs
156161
endif
157162
else
158163
do while( Xj .ne. limX(i) )
164+
nTests = nTests + 1
159165
Y = DCMPLX( Xj, 0.0d0 )
160166
R = ABS( Y )
161167
if( R .ne. Xj ) then
@@ -180,6 +186,7 @@ program zabs
180186
endif
181187
else
182188
do while( Xj .ne. limX(i) )
189+
nTests = nTests + 1
183190
Y = DCMPLX( 0.0d0, Xj )
184191
R = ABS( Y )
185192
if( R .ne. Xj ) then
@@ -209,6 +216,7 @@ program zabs
209216
endif
210217
else
211218
do while( Xj .ne. limX(i) )
219+
nTests = nTests + 1
212220
answerC = fiveFourth * Xj
213221
Y = DCMPLX( threeFourth * Xj, Xj )
214222
R = ABS( Y )
@@ -247,6 +255,7 @@ program zabs
247255
print *, "!! [d] fl( subnormal ) may be 0"
248256
endif
249257
else
258+
nTests = nTests + 1
250259
Y = DCMPLX( oneHalf * Xj, oneHalf * Xj )
251260
R = ABS( Y )
252261
relDiff = ABS(R-answerD)/answerD
@@ -267,26 +276,41 @@ program zabs
267276
*
268277
* Test (e) Infs
269278
do 50 i = 1, nInf
279+
nTests = nTests + 1
270280
Y = cInf(i)
271281
R = ABS( Y )
272282
if( .not.(R .gt. HUGE(0.0d0)) ) then
283+
caseEFails = caseEFails + 1
273284
WRITE( *, FMT = 9997 ) 'i',i, Y, R
274285
endif
275286
50 continue
276287
*
277288
* Test (f) NaNs
278289
do 60 i = 1, nNaN
290+
nTests = nTests + 1
279291
Y = cNaN(i)
280292
R = ABS( Y )
281293
if( R .eq. R ) then
294+
caseFFails = caseFFails + 1
282295
WRITE( *, FMT = 9998 ) 'n',i, Y, R
283296
endif
284297
60 continue
285298
*
299+
* If any test fails, displays a message
300+
nFailingTests = caseAFails + caseBFails + caseCFails + caseDFails
301+
$ + caseEFails + caseFFails
302+
if( nFailingTests .gt. 0 ) then
303+
print *, "# ", nTests-nFailingTests, " tests out of ", nTests,
304+
$ " pass for ABS(a+b*I),", nFailingTests, " tests fail."
305+
else
306+
print *, "# All tests pass for ABS(a+b*I)"
307+
endif
308+
*
286309
* If anything was written to stderr, print the message
287310
if( (caseAFails .gt. 0) .or. (caseBFails .gt. 0) .or.
288-
$ (caseCFails .gt. 0) .or. (caseDFails .gt. 0) )
289-
$ print *, "# Please check the failed ABS(a+b*I) in [stderr]"
311+
$ (caseCFails .gt. 0) .or. (caseDFails .gt. 0) ) then
312+
print *, "# Please check the failed ABS(a+b*I) in [stderr]"
313+
endif
290314
*
291315
* .. Formats ..
292316
9997 FORMAT( '[',A1,I1, '] ABS(', (ES8.1,SP,ES8.1,"*I"), ' ) = ',

‎INSTALL/test_zcomplexdiv.f‎

Lines changed: 32 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -75,7 +75,9 @@ program zdiv
7575
* .. Local Variables ..
7676
integer i, min, Max, m,
7777
$ subnormalTreatedAs0, caseAFails, caseBFails,
78-
$ caseCFails, caseDFails, caseEFails, caseFFails
78+
$ caseCFails, caseDFails, caseEFails, caseFFails,
79+
$ caseInfFails, caseNaNFails, nFailingTests,
80+
$ nTests
7981
double precision X( N ), aInf, aNaN, b,
8082
$ eps, blueMin, blueMax, OV, Xj, stepX(N), limX(N)
8183
double complex Y, Y2, R, cInf( nInf ), cNaN( nNaN )
@@ -94,6 +96,10 @@ program zdiv
9496
caseDFails = 0
9597
caseEFails = 0
9698
caseFFails = 0
99+
caseInfFails = 0
100+
caseNaNFails = 0
101+
nFailingTests = 0
102+
nTests = 0
97103
*
98104
* .. Initialize machine constants ..
99105
min = MINEXPONENT(0.0d0)
@@ -174,6 +180,7 @@ program zdiv
174180
endif
175181
else
176182
do while( Xj .ne. limX(i) )
183+
nTests = nTests + 1
177184
Y = DCMPLX( Xj, 0.0d0 )
178185
R = Y / Y
179186
if( R .ne. 1.0D0 ) then
@@ -199,6 +206,7 @@ program zdiv
199206
endif
200207
else
201208
do while( Xj .ne. limX(i) )
209+
nTests = nTests + 1
202210
Y = DCMPLX( 0.0d0, Xj )
203211
R = Y / Y
204212
if( R .ne. 1.0D0 ) then
@@ -224,6 +232,7 @@ program zdiv
224232
endif
225233
else
226234
do while( Xj .ne. limX(i) )
235+
nTests = nTests + 1
227236
Y = DCMPLX( Xj, Xj )
228237
R = Y / Y
229238
if( R .ne. 1.0D0 ) then
@@ -249,6 +258,7 @@ program zdiv
249258
endif
250259
else
251260
do while( Xj .ne. limX(i) )
261+
nTests = nTests + 1
252262
Y = DCMPLX( 0.0d0, Xj )
253263
Y2 = DCMPLX( Xj, 0.0d0 )
254264
R = Y / Y2
@@ -275,6 +285,7 @@ program zdiv
275285
endif
276286
else
277287
do while( Xj .ne. limX(i) )
288+
nTests = nTests + 1
278289
Y = DCMPLX( 0.0d0, Xj )
279290
Y2 = DCMPLX( Xj, 0.0d0 )
280291
R = Y2 / Y
@@ -301,6 +312,7 @@ program zdiv
301312
endif
302313
else
303314
do while( Xj .ne. limX(i) )
315+
nTests = nTests + 1
304316
Y = DCMPLX( Xj, Xj )
305317
R = Y / DCONJG( Y )
306318
if( R .ne. DCMPLX(0.0D0,1.0D0) ) then
@@ -318,38 +330,57 @@ program zdiv
318330
*
319331
* Test (g) Infs
320332
do 70 i = 1, nInf
333+
nTests = nTests + 3
321334
Y = cInf(i)
322335
R = czero / Y
323336
if( (R .ne. czero) .and. (R .eq. R) ) then
337+
caseInfFails = caseInfFails + 1
324338
WRITE( *, FMT = 9998 ) 'ia',i, czero, Y, R, 'NaN and 0'
325339
endif
326340
R = cone / Y
327341
if( (R .ne. czero) .and. (R .eq. R) ) then
342+
caseInfFails = caseInfFails + 1
328343
WRITE( *, FMT = 9998 ) 'ib',i, cone, Y, R, 'NaN and 0'
329344
endif
330345
R = Y / Y
331346
if( R .eq. R ) then
347+
caseInfFails = caseInfFails + 1
332348
WRITE( *, FMT = 9998 ) 'ic',i, Y, Y, R, 'NaN'
333349
endif
334350
70 continue
335351
*
336352
* Test (h) NaNs
337353
do 80 i = 1, nNaN
354+
nTests = nTests + 3
338355
Y = cNaN(i)
339356
R = czero / Y
340357
if( R .eq. R ) then
358+
caseNaNFails = caseNaNFails + 1
341359
WRITE( *, FMT = 9998 ) 'na',i, czero, Y, R, 'NaN'
342360
endif
343361
R = cone / Y
344362
if( R .eq. R ) then
363+
caseNaNFails = caseNaNFails + 1
345364
WRITE( *, FMT = 9998 ) 'nb',i, cone, Y, R, 'NaN'
346365
endif
347366
R = Y / Y
348367
if( R .eq. R ) then
368+
caseNaNFails = caseNaNFails + 1
349369
WRITE( *, FMT = 9998 ) 'nc',i, Y, Y, R, 'NaN'
350370
endif
351371
80 continue
352372
*
373+
* If any test fails, displays a message
374+
nFailingTests = caseAFails + caseBFails + caseCFails + caseDFails
375+
$ + caseEFails + caseFFails + caseInfFails
376+
$ + caseNaNFails
377+
if( nFailingTests .gt. 0 ) then
378+
print *, "# ", nTests-nFailingTests, " tests out of ", nTests,
379+
$ " pass for complex division,", nFailingTests," fail."
380+
else
381+
print *, "# All tests pass for complex division."
382+
endif
383+
*
353384
* If anything was written to stderr, print the message
354385
if( (caseAFails .gt. 0) .or. (caseBFails .gt. 0) .or.
355386
$ (caseCFails .gt. 0) .or. (caseDFails .gt. 0) .or.

‎INSTALL/test_zcomplexmult.f‎

Lines changed: 22 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -55,14 +55,18 @@ program zmul
5555
$ cone = DCMPLX( 1.0d0, 0.0d0 ) )
5656
* ..
5757
* .. Local Variables ..
58-
integer i
58+
integer i, nFailingTests, nTests
5959
double precision aInf, aNaN, OV
6060
double complex Y, R, cInf( nInf ), cNaN( nNaN )
6161
*
6262
* .. Intrinsic Functions ..
6363
intrinsic HUGE, DCMPLX
6464

6565
*
66+
* .. Initialize error counts ..
67+
nFailingTests = 0
68+
nTests = 0
69+
*
6670
* .. Inf entries ..
6771
OV = HUGE(0.0d0)
6872
aInf = OV * 2
@@ -83,48 +87,65 @@ program zmul
8387
*
8488
* Test (a) Infs
8589
do 10 i = 1, nInf
90+
nTests = nTests + 3
8691
Y = cInf(i)
8792
R = czero * Y
8893
if( R .eq. R ) then
94+
nFailingTests = nFailingTests + 1
8995
WRITE( *, FMT = 9998 ) 'ia',i, czero, Y, R, 'NaN'
9096
endif
9197
R = cone * Y
9298
if( (R .ne. Y) .and. (R .eq. R) ) then
99+
nFailingTests = nFailingTests + 1
93100
WRITE( *, FMT = 9998 ) 'ib',i, cone, Y, R,
94101
$ 'the input and NaN'
95102
endif
96103
R = Y * Y
97104
if( (i.eq.1) .or. (i.eq.2) ) then
98105
if( (R .ne. cInf(1)) .and. (R .eq. R) ) then
106+
nFailingTests = nFailingTests + 1
99107
WRITE( *, FMT = 9998 ) 'ic',i, Y, Y, R, 'Inf and NaN'
100108
endif
101109
else if( (i.eq.3) .or. (i.eq.4) ) then
102110
if( (R .ne. cInf(2)) .and. (R .eq. R) ) then
111+
nFailingTests = nFailingTests + 1
103112
WRITE( *, FMT = 9998 ) 'ic',i, Y, Y, R, '-Inf and NaN'
104113
endif
105114
else
106115
if( R .eq. R ) then
116+
nFailingTests = nFailingTests + 1
107117
WRITE( *, FMT = 9998 ) 'ic',i, Y, Y, R, 'NaN'
108118
endif
109119
endif
110120
10 continue
111121
*
112122
* Test (b) NaNs
113123
do 20 i = 1, nNaN
124+
nTests = nTests + 3
114125
Y = cNaN(i)
115126
R = czero * Y
116127
if( R .eq. R ) then
128+
nFailingTests = nFailingTests + 1
117129
WRITE( *, FMT = 9998 ) 'na',i, czero, Y, R, 'NaN'
118130
endif
119131
R = cone * Y
120132
if( R .eq. R ) then
133+
nFailingTests = nFailingTests + 1
121134
WRITE( *, FMT = 9998 ) 'nb',i, cone, Y, R, 'NaN'
122135
endif
123136
R = Y * Y
124137
if( R .eq. R ) then
138+
nFailingTests = nFailingTests + 1
125139
WRITE( *, FMT = 9998 ) 'nc',i, Y, Y, R, 'NaN'
126140
endif
127141
20 continue
142+
*
143+
if( nFailingTests .gt. 0 ) then
144+
print *, "# ", nTests-nFailingTests, " tests out of ", nTests,
145+
$ " pass for complex multiplication,", nFailingTests," fail."
146+
else
147+
print *, "# All tests pass for complex multiplication."
148+
endif
128149
*
129150
* .. Formats ..
130151
9998 FORMAT( '[',A2,I1, '] (', (ES24.16E3,SP,ES24.16E3,"*I"), ') * (',

‎INSTALL/test_zminMax.f‎

Lines changed: 21 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -44,13 +44,17 @@ program zmul
4444
parameter ( zero = 0.0d0 )
4545
* ..
4646
* .. Local Variables ..
47-
integer i
47+
integer i, nFailingTests, nTests
4848
double precision aInf, aNaN, OV, R, X(n), Y(n)
4949
*
5050
* .. Intrinsic Functions ..
5151
intrinsic HUGE, MIN, MAX
5252

5353
*
54+
* .. Initialize error counts ..
55+
nFailingTests = 0
56+
nTests = 0
57+
*
5458
* .. Inf and NaN entries ..
5559
OV = HUGE(0.0d0)
5660
aInf = OV * 2
@@ -62,35 +66,51 @@ program zmul
6266
* .. Tests ..
6367
*
6468
do 10 i = 1, 3
69+
nTests = nTests + 2
6570
R = MIN( X(i), Y(i) )
6671
if( R .ne. X(i) ) then
72+
nFailingTests = nFailingTests + 1
6773
WRITE( *, FMT = 9998 ) 'i',i, 'MIN', X(i), Y(i), R
6874
endif
6975
R = MAX( X(i), Y(i) )
7076
if( R .ne. Y(i) ) then
77+
nFailingTests = nFailingTests + 1
7178
WRITE( *, FMT = 9998 ) 'i',i, 'MAX', X(i), Y(i), R
7279
endif
7380
10 continue
7481
do 20 i = 4, 6
82+
nTests = nTests + 2
7583
R = MIN( X(i), Y(i) )
7684
if( R .ne. Y(i) ) then
85+
nFailingTests = nFailingTests + 1
7786
WRITE( *, FMT = 9998 ) 'i',i, 'MIN', X(i), Y(i), R
7887
endif
7988
R = MAX( X(i), Y(i) )
8089
if( R .ne. X(i) ) then
90+
nFailingTests = nFailingTests + 1
8191
WRITE( *, FMT = 9998 ) 'i',i, 'MAX', X(i), Y(i), R
8292
endif
8393
20 continue
8494
do 30 i = 7, 8
95+
nTests = nTests + 2
8596
R = MIN( X(i), Y(i) )
8697
if( R .eq. R ) then
98+
nFailingTests = nFailingTests + 1
8799
WRITE( *, FMT = 9998 ) 'i',i, 'MIN', X(i), Y(i), R
88100
endif
89101
R = MAX( X(i), Y(i) )
90102
if( R .eq. R ) then
103+
nFailingTests = nFailingTests + 1
91104
WRITE( *, FMT = 9998 ) 'i',i, 'MAX', X(i), Y(i), R
92105
endif
93106
30 continue
107+
*
108+
if( nFailingTests .gt. 0 ) then
109+
print *, "# ", nTests-nFailingTests, " tests out of ", nTests,
110+
$ " pass for intrinsic MIN and MAX,", nFailingTests," fail."
111+
else
112+
print *, "# All tests pass for intrinsic MIN and MAX."
113+
endif
94114
*
95115
* .. Formats ..
96116
9998 FORMAT( '[',A1,I1, '] ', A3, '(', F5.0, ',', F5.0, ') = ', F5.0 )

0 commit comments

Comments
 (0)