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]" }