blob: 49564505dc9192c2754df217f8360b5ec2ba73e8 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
|
# Uses references to automatically close files when the handle
# can no longer be accessed.
#
# e.g. bio copy [autoopen infile] [autoopen outfile w]; collect
#
proc autoopen {filename {mode r}} {
set ref [ref [open $filename $mode] aio lambdaFinalizer]
rename [getref $ref] $ref
return $ref
}
# Hardly needed
proc filecopy {read write} {
bio copy [autoopen $read] [autoopen $write w]
collect
}
proc section {name} {
puts "-- $name ----------------"
}
array set testresults {numfail 0 numpass 0 failed {}}
proc test {id descr script expected} {
puts -nonewline "$id "
set rc [catch {uplevel 1 $script} result]
# Note that rc=2 is return
if {($rc == 0 || $rc == 2) && $result eq $expected} {
puts "OK $descr"
incr ::testresults(numpass)
} else {
puts "ERR $descr"
puts "Expected: '$expected'"
puts "Got : '$result'"
incr ::testresults(numfail)
lappend ::testresults(failed) [list $id $descr $script $expected $result]
}
}
proc testreport {} {
puts "----------------------------------------------------------------------"
puts "FAILED: $::testresults(numfail)"
foreach failed $::testresults(failed) {
foreach {id descr script expected result} $failed {}
puts "\t$id"
}
puts "PASSED: $::testresults(numpass)"
puts "----------------------------------------------------------------------\n"
}
proc testerror {} {
error "deliberate error"
}
puts [string repeat = 40]
puts $argv0
puts [string repeat = 40]
|
