summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog10
-rw-r--r--generic/tclInterp.c6
-rw-r--r--tests/chanio.test6
-rw-r--r--tests/event.test4
-rw-r--r--tests/interp.test25
-rw-r--r--tests/io.test6
6 files changed, 45 insertions, 12 deletions
diff --git a/ChangeLog b/ChangeLog
index ec4546d..9420469 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,15 @@
2008-06-19 Don Porter <dgp@users.sourceforge.net>
+ * generic/tclInterp.c: Fixed completely boneheaded mistake that
+ * tests/interp.test: [interp bgerror $slave] and [$slave bgerror]
+ would always act like [interp bgerror {}]. [Bug 1999035].
+
+ * tests/chanio.test: Corrected flawed tests revealed by a -debug 1
+ * tests/event.test: -singleproc 1 test suite run.
+ * tests/io.test:
+
+2008-06-19 Don Porter <dgp@users.sourceforge.net>
+
* changes: Updates for 8.5.3 release.
2008-06-17 Andreas Kupries <andreask@activestate.com>
diff --git a/generic/tclInterp.c b/generic/tclInterp.c
index 1f2921a..78772bd 100644
--- a/generic/tclInterp.c
+++ b/generic/tclInterp.c
@@ -10,7 +10,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclInterp.c,v 1.83 2008/01/30 10:45:55 msofer Exp $
+ * RCS: @(#) $Id: tclInterp.c,v 1.83.2.1 2008/06/20 19:23:25 dgp Exp $
*/
#include "tclInt.h"
@@ -2061,9 +2061,9 @@ SlaveBgerror(
NULL);
return TCL_ERROR;
}
- TclSetBgErrorHandler(interp, objv[0]);
+ TclSetBgErrorHandler(slaveInterp, objv[0]);
}
- Tcl_SetObjResult(interp, TclGetBgErrorHandler(interp));
+ Tcl_SetObjResult(interp, TclGetBgErrorHandler(slaveInterp));
return TCL_OK;
}
diff --git a/tests/chanio.test b/tests/chanio.test
index 4226c45..ce87e94 100644
--- a/tests/chanio.test
+++ b/tests/chanio.test
@@ -13,7 +13,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: chanio.test,v 1.3.2.10 2008/05/23 21:10:44 andreas_kupries Exp $
+# RCS: @(#) $Id: chanio.test,v 1.3.2.11 2008/06/20 19:23:26 dgp Exp $
if {[catch {package require tcltest 2}]} {
chan puts stderr "Skipping tests in [info script]. tcltest 2 required."
@@ -7698,8 +7698,8 @@ test chan-io-73.1 {channel Tcl_Obj SetChannelFromAny} {} {
# ### ### ### ######### ######### #########
# cleanup
-foreach file [list fooBar longfile script output test1 pipe my_script foo \
- bar test2 test3 cat stdout kyrillic.txt utf8-fcopy.txt utf8-rp.txt] {
+foreach file [list fooBar longfile script output test1 pipe my_script \
+ test2 test3 cat stdout kyrillic.txt utf8-fcopy.txt utf8-rp.txt] {
removeFile $file
}
cleanupTests
diff --git a/tests/event.test b/tests/event.test
index bdfad16..5ef3aa2 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.27 2008/03/10 17:54:47 dgp Exp $
+# RCS: @(#) $Id: event.test,v 1.27.2.1 2008/06/20 19:23:26 dgp Exp $
package require tcltest 2
namespace import -force ::tcltest::*
@@ -205,7 +205,7 @@ test event-5.3 {HandleBgErrors: [Bug 1670155]} -setup {
rename demo {}
rename trial {}
} -result {}
-test event-5.3 {Default [interp bgerror] handler} -body {
+test event-5.3.1 {Default [interp bgerror] handler} -body {
::tcl::Bgerror
} -returnCodes error -match glob -result {*msg options*}
test event-5.4 {Default [interp bgerror] handler} -body {
diff --git a/tests/interp.test b/tests/interp.test
index 76d642b..99a979e 100644
--- a/tests/interp.test
+++ b/tests/interp.test
@@ -10,7 +10,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: interp.test,v 1.54 2008/03/02 19:12:41 msofer Exp $
+# RCS: @(#) $Id: interp.test,v 1.54.2.1 2008/06/20 19:23:26 dgp Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2.1
@@ -3446,6 +3446,29 @@ test interp-36.6 {SlaveBgerror returns handler} -setup {
interp delete slave
} -result {foo bar soom}
+test interp-36.7 {SlaveBgerror sets error handler of slave [1999035]} -setup {
+ interp create slave
+ slave alias handler handler
+ slave bgerror handler
+ variable result {untouched}
+ proc handler {args} {
+ variable result
+ set result [lindex $args 0]
+ }
+} -body {
+ slave eval {
+ variable done {}
+ after 0 error foo
+ after 10 [list ::set [namespace which -variable done] {}]
+ vwait [namespace which -variable done]
+ }
+ set result
+} -cleanup {
+ variable result {}
+ unset result
+ interp delete slave
+} -result foo
+
# cleanup
foreach i [interp slaves] {
interp delete $i
diff --git a/tests/io.test b/tests/io.test
index 367f0e1..a2aaf7f 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -13,7 +13,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: io.test,v 1.80.2.11 2008/05/26 18:27:53 hobbs Exp $
+# RCS: @(#) $Id: io.test,v 1.80.2.12 2008/06/20 19:23:26 dgp Exp $
if {[catch {package require tcltest 2}]} {
puts stderr "Skipping tests in [info script]. tcltest 2 required."
@@ -7698,8 +7698,8 @@ test io-73.1 {channel Tcl_Obj SetChannelFromAny} {} {
# ### ### ### ######### ######### #########
# cleanup
-foreach file [list fooBar longfile script output test1 pipe my_script foo \
- bar test2 test3 cat stdout kyrillic.txt utf8-fcopy.txt utf8-rp.txt] {
+foreach file [list fooBar longfile script output test1 pipe my_script \
+ test2 test3 cat stdout kyrillic.txt utf8-fcopy.txt utf8-rp.txt] {
removeFile $file
}
cleanupTests