From f1797e198ccb2c3a784d65272c7eb5d3fa9ca502 Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 20 Jun 2008 19:23:23 +0000 Subject: * 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: --- ChangeLog | 10 ++++++++++ generic/tclInterp.c | 6 +++--- tests/chanio.test | 6 +++--- tests/event.test | 4 ++-- tests/interp.test | 25 ++++++++++++++++++++++++- tests/io.test | 6 +++--- 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 + * 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 + * changes: Updates for 8.5.3 release. 2008-06-17 Andreas Kupries 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 -- cgit v0.12