334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
|
}
}
# Perform a test
#
set test_count 0
proc test {name expr {constraints ""}} {
global bad_test test_count RESULT
incr test_count
set knownBug [expr {"knownBug" in $constraints}]
set r [uplevel 1 [list expr $expr]]
if {$r} {
if {$knownBug && !$::STRICT} {
protOut "test $name OK (knownBug)?"
} else {
protOut "test $name OK"
}
} else {
if {$knownBug && !$::STRICT} {
protOut "test $name FAILED (knownBug)!" 1
} else {
protOut "test $name FAILED!" 1
if {$::QUIET} {protOut "RESULT: $RESULT" 1}
lappend bad_test $name
if {$::HALT} exit
}
}
}
set bad_test {}
# Return a random string N characters long.
#
set vocabulary 01234567890abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
append vocabulary " ()*^!.eeeeeeeeaaaaattiioo "
set nvocabulary [string length $vocabulary]
proc rand_str {N} {
|
|
>
>
|
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
|
}
}
# Perform a test
#
set test_count 0
proc test {name expr {constraints ""}} {
global bad_test ignored_test test_count RESULT
incr test_count
set knownBug [expr {"knownBug" in $constraints}]
set r [uplevel 1 [list expr $expr]]
if {$r} {
if {$knownBug && !$::STRICT} {
protOut "test $name OK (knownBug)?"
} else {
protOut "test $name OK"
}
} else {
if {$knownBug && !$::STRICT} {
protOut "test $name FAILED (knownBug)!" 1
lappend ignored_test $name
} else {
protOut "test $name FAILED!" 1
if {$::QUIET} {protOut "RESULT: $RESULT" 1}
lappend bad_test $name
if {$::HALT} exit
}
}
}
set bad_test {}
set ignored_test {}
# Return a random string N characters long.
#
set vocabulary 01234567890abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
append vocabulary " ()*^!.eeeeeeeeaaaaattiioo "
set nvocabulary [string length $vocabulary]
proc rand_str {N} {
|
509
510
511
512
513
514
515
516
517
518
519
520
|
protOut "***** $testfile ******"
source $testdir/$testfile.test
protOut "***** End of $testfile: [llength $bad_test] errors so far ******"
cd $origwd
}
set nErr [llength $bad_test]
if {$nErr>0 || !$::QUIET} {
protOut "***** Final result: $nErr errors out of $test_count tests" 1
}
if {$nErr>0} {
protOut "***** Failures: $bad_test" 1
}
|
|
|
>
>
>
>
>
>
>
|
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
|
protOut "***** $testfile ******"
source $testdir/$testfile.test
protOut "***** End of $testfile: [llength $bad_test] errors so far ******"
cd $origwd
}
set nErr [llength $bad_test]
if {$nErr>0 || !$::QUIET} {
protOut "***** Final results: $nErr errors out of $test_count tests" 1
}
if {$nErr>0} {
protOut "***** Considered failures: $bad_test" 1
}
set nErr [llength $ignored_test]
if {$nErr>0 || !$::QUIET} {
protOut "***** Ignored results: $nErr ignored errors out of $test_count tests" 1
}
if {$nErr>0} {
protOut "***** Ignored failures: $ignored_test" 1
}
|