diff options
Diffstat (limited to 'testsuite/runtest.all/default_procs.tcl')
-rw-r--r-- | testsuite/runtest.all/default_procs.tcl | 94 |
1 files changed, 94 insertions, 0 deletions
diff --git a/testsuite/runtest.all/default_procs.tcl b/testsuite/runtest.all/default_procs.tcl new file mode 100644 index 0000000..a0e6f88 --- /dev/null +++ b/testsuite/runtest.all/default_procs.tcl @@ -0,0 +1,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]" +} |