blob: ebb0daf2b7369aa5e05599e1377a7d91fa1314ce (
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
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
|
set sum_file [open .tmp w]
set reboot 0
set errno ""
# this tests a proc for a returned pattern
proc lib_pat_test { cmd arglist pattern } {
catch { eval [list $cmd] $arglist } result
puts "CMD(lib_pat_test) was: $cmd $arglist"
puts "RESULT(lib_pat_test) was: \"${result}\" for pattern \"$pattern\"."
if { [regexp -- "with too many" $result] } {
return -1
}
if { [string match "$pattern" $result] } {
return 1
} else {
return 0
}
}
# this tests a proc for a returned regexp
proc lib_regexp_test { cmd arglist pattern } {
catch { eval [list $cmd] $arglist } result
puts "CMD(lib_pat_test) was: $cmd $arglist"
puts "RESULT(lib_pat_test) was: \"${result}\" for pattern \"$pattern\"."
if { [regexp -- "with too many" $result] } {
return -1
}
if { [regexp -- "$pattern" $result] } {
return 1
} else {
return 0
}
}
# this tests a proc for a returned value
proc lib_ret_test { cmd arglist val } {
catch { eval [list $cmd] $arglist } result
puts "CMD(lib_ret_test) was: $cmd $arglist"
puts "RESULT(lib_ret_test) was: $result"
if { $result eq $val } {
return 1
} else {
return 0
}
}
# this tests a proc for an expected boolean result
proc lib_bool_test { cmd arglist val } {
catch { eval [list $cmd] $arglist } result
puts "CMD(lib_bool_test) was: $cmd $arglist"
puts "RESULT(lib_bool_test) was: \"$result\" expecting \"$val\"."
if { $val } {
if { $result } { return 1 } else { return 0 }
} else {
if { $result } { return 0 } else { return 1 }
}
}
#
# This runs a standard test for a proc. The list is set up as:
# |test proc|proc being tested|args|pattern|message|
# test proc is something like lib_pat_test or lib_ret_test.
#
proc run_tests { tests } {
foreach test $tests {
# skip comments in test lists
if { [lindex $test 0] eq "#" } { continue }
set result [eval [lrange $test 0 3]]
switch -- $result {
"-1" {
puts "ERRORED: [lindex $test 4]"
}
"1" {
puts "PASSED: [lindex $test 4]"
}
"0" {
puts "FAILED: [lindex $test 4]"
}
default {
puts "BAD VALUE: [lindex $test 4]"
}
}
}
}
proc send_log { args } {
# this is just a stub for testing
}
proc pass { msg } {
puts "PASSED: $msg"
}
proc fail { msg } {
puts "FAILED: $msg"
}
proc perror { msg } {
global errno
puts "ERRORED: $msg"
set errno "$msg"
}
proc warning { msg } {
global errno
puts "WARNED: $msg"
set errno "$msg"
}
proc untested { msg } {
puts "NOTTESTED: $msg"
}
proc unsupported { msg } {
puts "NOTSUPPORTED: $msg"
}
proc verbose { args } {
puts [lindex $args 0]
}
|
