* generic/tclEvent.c ([::tcl::Bgerror]): Corrections to Tcl's

        * tests/event.test:     default [interp bgerror] handler so that when
        it falls back to a hidden [bgerror] in a safe interp, it gets the
        right error context data.  [Bug 1790274].

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