diff options
Diffstat (limited to 'tests/error.test')
| -rw-r--r-- | tests/error.test | 98 |
1 files changed, 58 insertions, 40 deletions
diff --git a/tests/error.test b/tests/error.test index 8aa99d6..b989338 100644 --- a/tests/error.test +++ b/tests/error.test @@ -16,6 +16,7 @@ if {[lsearch [namespace children] ::tcltest] == -1} { namespace import -force ::tcltest::* } +namespace eval ::tcl::test::error { proc foo {} { global errorInfo set a [catch {format [error glorp2]} b] @@ -41,7 +42,7 @@ test error-1.2 {simple errors from commands} { test error-1.3 {simple errors from commands} { catch {format [string index]} b - set errorInfo + set ::errorInfo # this used to return '... while executing ...', but # string index is fully compiled as of 8.4a3 } {wrong # args: should be "string index string charIndex" @@ -58,18 +59,22 @@ test error-1.5 {simple errors from commands} { } glorp test error-1.6 {simple errors from commands} { - catch {catch a b c} b + catch {catch a b c d} b } 1 test error-1.7 {simple errors from commands} { - catch {catch a b c} b + catch {catch a b c d} b set b -} {wrong # args: should be "catch command ?varName?"} +} {wrong # args: should be "catch script ?resultVarName? ?optionVarName?"} -test error-1.8 {simple errors from commands} {nonPortable} { +test error-1.8 {simple errors from commands} { # This test is non-portable: it generates a memory fault on # machines like DEC Alphas (infinite recursion overflows # stack?) + # + # That claims sounds like a bug to be fixed rather than a portability + # problem. Anyhow, I believe it's out of date (bug's been fixed) so + # this test is re-enabled. proc p {} { uplevel 1 catch p error @@ -91,7 +96,7 @@ test error-2.2 {errors in nested procedures} { test error-2.3 {errors in nested procedures} { catch foo b - set errorInfo + set ::errorInfo } {Human-generated while executing "error {Human-generated}" @@ -110,7 +115,7 @@ test error-2.5 {errors in nested procedures} { test error-2.6 {errors in nested procedures} { catch foo2 b - set errorInfo + set ::errorInfo } {glorp2 while executing "error glorp2" @@ -122,10 +127,10 @@ test error-2.6 {errors in nested procedures} { test error-3.1 {errors in catch command} { list [catch {catch} msg] $msg -} {1 {wrong # args: should be "catch command ?varName?"}} +} {1 {wrong # args: should be "catch script ?resultVarName? ?optionVarName?"}} test error-3.2 {errors in catch command} { list [catch {catch a b c} msg] $msg -} {1 {wrong # args: should be "catch command ?varName?"}} +} {0 1} test error-3.3 {errors in catch command} { catch {unset a} set a(0) 22 @@ -136,27 +141,27 @@ catch {unset a} # More tests related to errorInfo and errorCode test error-4.1 {errorInfo and errorCode variables} { - list [catch {error msg1 msg2 msg3} msg] $msg $errorInfo $errorCode + list [catch {error msg1 msg2 msg3} msg] $msg $::errorInfo $::errorCode } {1 msg1 msg2 msg3} test error-4.2 {errorInfo and errorCode variables} { - list [catch {error msg1 {} msg3} msg] $msg $errorInfo $errorCode + list [catch {error msg1 {} msg3} msg] $msg $::errorInfo $::errorCode } {1 msg1 {msg1 while executing "error msg1 {} msg3"} msg3} test error-4.3 {errorInfo and errorCode variables} { - list [catch {error msg1 {}} msg] $msg $errorInfo $errorCode + list [catch {error msg1 {}} msg] $msg $::errorInfo $::errorCode } {1 msg1 {msg1 while executing "error msg1 {}"} NONE} test error-4.4 {errorInfo and errorCode variables} { - set errorCode bogus - list [catch {error msg1} msg] $msg $errorInfo $errorCode + set ::errorCode bogus + list [catch {error msg1} msg] $msg $::errorInfo $::errorCode } {1 msg1 {msg1 while executing "error msg1"} NONE} test error-4.5 {errorInfo and errorCode variables} { - set errorCode bogus - list [catch {error msg1 msg2 {}} msg] $msg $errorInfo $errorCode + set ::errorCode bogus + list [catch {error msg1 msg2 {}} msg] $msg $::errorInfo $::errorCode } {1 msg1 msg2 {}} # Errors in error command itself @@ -172,53 +177,66 @@ test error-5.2 {errors in error command} { test error-6.1 {catch must reset error state} { catch {error outer [catch {error inner inner.errorInfo inner.errorCode}]} - list $errorCode $errorInfo + list $::errorCode $::errorInfo +} {NONE 1} +test error-6.2 {catch must reset error state} { + catch {error outer [catch {return -level 0 -code error -errorcode BUG}]} + list $::errorCode $::errorInfo } {NONE 1} test error-6.3 {catch must reset error state} { - set errorCode BUG + set ::errorCode BUG catch {error outer [catch set]} - list $errorCode $errorInfo + list $::errorCode $::errorInfo } {NONE 1} test error-6.4 {catch must reset error state} { catch {error [catch {error foo bar baz}] 1} - list $errorCode $errorInfo + list $::errorCode $::errorInfo +} {NONE 1} +test error-6.5 {catch must reset error state} { + catch {error [catch {return -level 0 -code error -errorcode BUG}] 1} + list $::errorCode $::errorInfo +} {NONE 1} +test error-6.6 {catch must reset error state} { + catch {return -level 0 -code error -errorinfo [catch {error foo bar baz}]} + list $::errorCode $::errorInfo } {NONE 1} test error-6.7 {catch must reset error state} { proc foo {} { - return -code error -errorinfo [catch {error foo bar baz}] + return -code error -errorinfo [catch {error foo bar baz}] } catch foo - list $errorCode + list $::errorCode +} {NONE} +test error-6.8 {catch must reset error state} { + catch {return -level 0 -code error [catch {error foo bar baz}]} + list $::errorCode } {NONE} test error-6.9 {catch must reset error state} { proc foo {} { - return -code error [catch {error foo bar baz}] + return -code error [catch {error foo bar baz}] } catch foo - list $errorCode + list $::errorCode } {NONE} -namespace eval ::tcl::test::error { test error-7.0 {Bug 1397843} -body { - variable cmds - proc EIWrite args { - variable cmds - lappend cmds [lindex [info level -2] 0] - } - proc BadProc {} { - set i a - incr i - } - trace add variable ::errorInfo write [namespace code EIWrite] - catch BadProc - trace remove variable ::errorInfo write [namespace code EIWrite] - set cmds + variable cmds + proc EIWrite args { + variable cmds + lappend cmds [lindex [info level -2] 0] + } + proc BadProc {} { + set i a + incr i + } + trace add variable ::errorInfo write [namespace code EIWrite] + catch BadProc + trace remove variable ::errorInfo write [namespace code EIWrite] + set cmds } -match glob -result {*BadProc*} } namespace delete ::tcl::test::error - - # cleanup catch {rename p ""} ::tcltest::cleanupTests |