summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-rw-r--r--tests/event.test41
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