blob: a0e6f88fa4888e332e3f21fe26cf3b19f25e3d00 (
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
|
set sum_file [open .tmp w]
set reboot 0
set errno ""
# this tests a proc for a returned pattern
proc lib_pat_test { cmd arg pattern } {
catch "$cmd \"$arg\"" result
puts "CMD(lib_pat_test) was: $cmd \"$arg\""
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 value
proc lib_ret_test { cmd arg val } {
catch "$cmd \"$arg\"" result
# catch "set result [$cmd $arg]" output
# set result "$cmd [eval $arg]
puts "CMD(lib_ret_test) was: $cmd $arg"
puts "RESULT(lib_ret_test) was: $result"
# puts "OUTPUT(lib_ret_test) was: $output"
if { $result == $val } {
return 1
} else {
return 0
}
}
#
# 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 i "$tests" {
set result [ [lindex $i 0] "[lindex $i 1]" "[lindex $i 2]" "[lindex $i 3]" ]
switch -- $result {
"-1" {
puts "ERRORED: [lindex $i 4]"
}
"1" {
puts "PASSED: [lindex $i 4]"
}
"0" {
puts "FAILED: [lindex $i 4]"
}
default {
puts "BAD VALUE: [lindex $i 4]"
}
}
}
}
proc send_log { msg } {
# 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]"
}
|
