diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/event.test | 41 |
1 files changed, 40 insertions, 1 deletions
diff --git a/tests/event.test b/tests/event.test index 101a17e..9006131 100644 --- a/tests/event.test +++ b/tests/event.test @@ -9,7 +9,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: event.test,v 1.24 2007/03/12 19:28:50 dgp Exp $ +# RCS: @(#) $Id: event.test,v 1.25 2007/09/07 18:11:24 dgp Exp $ package require tcltest 2 namespace import -force ::tcltest::* @@ -304,6 +304,45 @@ test event-7.5 {correct behaviour when there is no bgerror [Bug 219142]} {exec} "error hello" ("after" script)}} +test event-7.6 {safe hidden bgerror fallback} { + variable result {} + interp create -safe safe + safe alias puts puts + safe alias result ::append [namespace which -variable result] + safe eval {proc bgerror m {result $m\n$::errorCode\n$::errorInfo\n}} + safe hide bgerror + safe eval after 0 error foo + update + interp delete safe + set result +} {foo +NONE +foo + while executing +"error foo" + ("after" script) +} + +test event-7.7 {safe hidden bgerror fallback} { + variable result {} + interp create -safe safe + safe alias puts puts + safe alias result ::append [namespace which -variable result] + safe eval {proc bgerror m {result $m\n$::errorCode\n$::errorInfo\n}} + safe hide bgerror + safe eval {proc bgerror m {error bar soom baz}} + safe eval after 0 error foo + update + interp delete safe + set result +} {foo +NONE +foo + while executing +"error foo" + ("after" script) +} + # someday : add a test checking that # when there is no bgerror, an error msg goes to stderr |