blob: 3142c72d4c31bcef6fa847816de8f0126e923e3a (
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
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
|
proc makeFile {contents name} {
set f [open $name w]
puts $f $contents
close $f
}
proc info_source {script} {
join [info source $script] :
}
catch {
# Tcl-only things
info tclversion
proc errorInfo {msg} {
return $::errorInfo
}
proc info_source {script} {
return ""
}
}
proc section {name} {
puts "-- $name ----------------"
}
set testresults(numfail) 0
set testresults(numpass) 0
set testresults(failed) {}
proc test {id descr script expected} {
if {!$::testquiet} {
puts -nonewline "$id "
}
set rc [catch {uplevel 1 $script} result]
# Note that rc=2 is return
if {($rc == 0 || $rc == 2) && $result eq $expected} {
if {!$::testquiet} {
puts "OK $descr"
}
incr ::testresults(numpass)
} else {
if {$::testquiet} {
puts -nonewline "$id "
}
puts "ERR $descr"
puts "At : [info_source $script]"
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[info_source $script]\t$id"
}
puts "PASSED: $::testresults(numpass)"
puts "----------------------------------------------------------------------\n"
}
proc testerror {} {
error "deliberate error"
}
puts [string repeat = 40]
puts $argv0
puts [string repeat = 40]
set ::testquiet [info exists ::env(testquiet)]
|
