TABLE OF CONTENTS
::pwtk::test
SYNOPSIS
proc ::pwtk::test {cmd {expectedResult ""} {expectedError ""}} {
PURPOSE
A command for testing scripts and commands, used by tests in tests/*test. It produces a nice and readable output.
ARGUMENTS
- expectedResult -- (optional) the result of the test will be compared against $expectedResult
- expectedError -- (optional) the error text of the test will be compared against $expectedError
SOURCE
variable catch_error set expectedResultPr [testProcessResult_ $expectedResult] set expectedErrorPr [testProcessResult_ $expectedError] set result {} set resultErr {} set error {} set pass N/A puts " ===============================================================Testing== SCRIPT: $cmd " set tmp [file join [::fileutil::tempdir] error.[pid]] # delete the error file, if it exists file delete $tmp set catch_error 1 try { if { $expectedError ne {} } { ::pwtk::redirect_stderr_to $tmp { set result [uplevel $cmd] } } else { set result [uplevel $cmd] } } on error err { if { [info commands ::tcl::orig_puts] ne {} } { # BEWARE: error occurred while evaluation script in # ::pwtk::redirect_stderr_to, revert "puts" to default Tcl puts # (see ::pwtk::redirect_stderr_to) rename ::puts {} rename ::tcl::orig_puts ::puts } if { $expectedError ne {} } { set resultErr [testProcessResult_ [readFile $tmp]] } ifnotempty err { set error "\n\nCODING_ERROR: $err" } } set catch_error 0 set result [testProcessResult_ $result] if { $expectedResult ne {} } { set pass [expr { $result == $expectedResultPr ? 1 : 0 } ] } if { $expectedError ne {} } { if { $resultErr eq {} && [file exists $tmp] } { # for checking stderr message set resultErr [testProcessResult_ [readFile $tmp]] } set passErr [expr { [filterQEerror_ $resultErr] == [filterQEerror_ $expectedErrorPr] ? 1 : 0 } ] if { ! $passErr } { set pass 0 } if { $expectedResult eq {} } { set pass $passErr } } ifnotempty result { puts "RESULT:\n$result" } if { $pass != 1 && $expectedResult ne {} } { puts "EXPECTED RESULT:\n$expectedResultPr" } if { [file exists $tmp] && [file size $tmp] > 0} { puts "RESULTING STDERR:\n$resultErr" } if { $pass != 1 && $expectedError ne {} } { puts "EXPECTED ERROR:\n$expectedErrorPr" } puts " PASSED: $pass$error ======================================================================== " }