diff options
| -rw-r--r-- | ChangeLog | 16 | ||||
| -rw-r--r-- | changes | 4 | ||||
| -rw-r--r-- | generic/tclInterp.c | 6 | ||||
| -rw-r--r-- | tests/chanio.test | 6 | ||||
| -rw-r--r-- | tests/cmdAH.test | 4 | ||||
| -rw-r--r-- | tests/event.test | 4 | ||||
| -rw-r--r-- | tests/interp.test | 33 | ||||
| -rw-r--r-- | tests/io.test | 6 | ||||
| -rw-r--r-- | tests/ioTrans.test | 7 | ||||
| -rw-r--r-- | tests/namespace.test | 18 |
10 files changed, 77 insertions, 27 deletions
@@ -1,6 +1,20 @@ 2008-06-20 Don Porter <dgp@users.sourceforge.net> - * tests/encoding.test: Make failing tests pass again. + * changes: Updates for 8.6a1 release. + + * 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/cmdAH.test: -singleproc 1 test suite run. + * tests/event.test: + * tests/interp.test: + * tests/io.test: + * tests/ioTrans.test: + * tests/namespace.test: + + * tests/encoding.test: Make failing tests pass again. [Bug 1972867] 2008-06-19 Donal K. Fellows <dkf@users.sf.net> @@ -1,6 +1,6 @@ Recent user-visible changes to Tcl: -RCS: @(#) $Id: changes,v 1.138 2008/06/20 13:51:26 das Exp $ +RCS: @(#) $Id: changes,v 1.139 2008/06/20 20:48:47 dgp Exp $ 1. No more [command1] [command2] construct for grouping multiple commands on a single command line. @@ -7236,4 +7236,6 @@ variables without "." added to customization hooks (kupries) 2008-06-13 (new feature)[TIP 285] [interp cancel]; Tcl_CancelEval() (mistachkin) +2008-06-20 (bug fix)[1999035] make [interp bgerror $i] act in $i (porter) + --- Released 8.6a1, June ??, 2008 --- See ChangeLog for details --- diff --git a/generic/tclInterp.c b/generic/tclInterp.c index 05a2609..c681da5 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.85 2008/06/13 05:45:13 mistachkin Exp $ + * RCS: @(#) $Id: tclInterp.c,v 1.86 2008/06/20 20:48:47 dgp Exp $ */ #include "tclInt.h" @@ -2130,9 +2130,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 14a1554..7e53f77 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.14 2008/06/12 09:46:52 das Exp $ +# RCS: @(#) $Id: chanio.test,v 1.15 2008/06/20 20:48:48 dgp Exp $ if {[catch {package require tcltest 2}]} { chan puts stderr "Skipping tests in [info script]. tcltest 2 required." @@ -7704,8 +7704,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/cmdAH.test b/tests/cmdAH.test index 98b09e9..be7cccf 100644 --- a/tests/cmdAH.test +++ b/tests/cmdAH.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: cmdAH.test,v 1.59 2008/06/13 05:45:14 mistachkin Exp $ +# RCS: @(#) $Id: cmdAH.test,v 1.60 2008/06/20 20:48:49 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2.1 @@ -105,7 +105,7 @@ test cmdAH-2.6 {Tcl_CdObjCmd} -returnCodes error -body { test cmdAH-2.6.1 {Tcl_CdObjCmd} -returnCodes error -body { cd "" } -result {couldn't change working directory to "": no such file or directory} -test cmdAH-2.7 {cd} -constraints {unix nonPortable} -setup { +test cmdAH-2.6.2 {cd} -constraints {unix nonPortable} -setup { set dir [pwd] } -body { cd / diff --git a/tests/event.test b/tests/event.test index bdfad16..8beda80 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.28 2008/06/20 20:48:49 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 57a2020..7af5856 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.56 2008/06/13 05:45:15 mistachkin Exp $ +# RCS: @(#) $Id: interp.test,v 1.57 2008/06/20 20:48:49 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2.1 @@ -2343,9 +2343,10 @@ test interp-27.4 {interp aliases & namespaces} { #} {1 {invalid hidden command name "foo"}} -test interp-28.1 {getting fooled by slave's namespace ?} { +test interp-28.1 {getting fooled by slave's namespace ?} -setup { set i [interp create -safe]; proc master {interp args} {interp hide $interp list} +} -body { $i alias master master $i; set r [interp eval $i { namespace eval foo { @@ -2356,9 +2357,10 @@ test interp-28.1 {getting fooled by slave's namespace ?} { } info commands list }] +} -cleanup { + rename master {} interp delete $i; - set r -} {} +} -result {} test interp-28.2 {master's nsName cache should not cross} -setup { set i [interp create] @@ -3447,6 +3449,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 274c736..d6ed830 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.90 2008/05/26 18:28:47 hobbs Exp $ +# RCS: @(#) $Id: io.test,v 1.91 2008/06/20 20:48:49 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 diff --git a/tests/ioTrans.test b/tests/ioTrans.test index b607885..6298af0 100644 --- a/tests/ioTrans.test +++ b/tests/ioTrans.test @@ -11,7 +11,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: ioTrans.test,v 1.3 2008/06/16 18:38:42 andreas_kupries Exp $ +# RCS: @(#) $Id: ioTrans.test,v 1.4 2008/06/20 20:48:49 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -690,9 +690,12 @@ test iortrans-11.0 {origin interpreter of moved transform gone} -match glob -bod # Set up channel and transform in interpreter interp eval $ida $helperscript + interp eval $ida [list ::variable tempchan [tempchan]] + interp transfer {} $::tempchan $ida set chan [interp eval $ida { + variable tempchan proc foo {args} {oninit clear drain flush limit? read write; onfinal; track; return} - set chan [chan push [tempchan] foo] + set chan [chan push $tempchan foo] fconfigure $chan -buffering none set chan }] diff --git a/tests/namespace.test b/tests/namespace.test index 9fb2d9a..f88e93c 100644 --- a/tests/namespace.test +++ b/tests/namespace.test @@ -11,7 +11,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: namespace.test,v 1.71 2008/05/20 22:22:17 dkf Exp $ +# RCS: @(#) $Id: namespace.test,v 1.72 2008/06/20 20:48:49 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -715,14 +715,16 @@ test namespace-16.8 {Tcl_FindCommand, relative name found} { cmd a b c } } {::test_ns_1::cmd: a b c} -test namespace-16.9 {Tcl_FindCommand, relative name found} { - catch {rename cmd2 {}} +test namespace-16.9 {Tcl_FindCommand, relative name found} -body { proc cmd2 {args} {return "[namespace current]::cmd2: $args"} namespace eval test_ns_1 { cmd2 a b c } -} {::::cmd2: a b c} -test namespace-16.10 {Tcl_FindCommand, relative name found, only look in current then global ns} { +} -cleanup { + catch {rename cmd2 {}} +} -result {::::cmd2: a b c} +test namespace-16.10 {Tcl_FindCommand, relative name found, only look in current then global ns} -body { + proc cmd2 {args} {return "[namespace current]::cmd2: $args"} namespace eval test_ns_1 { proc cmd2 {args} { return "[namespace current]::cmd2 in test_ns_1: $args" @@ -731,7 +733,9 @@ test namespace-16.10 {Tcl_FindCommand, relative name found, only look in current cmd2 a b c } } -} {::::cmd2: a b c} +} -cleanup { + catch {rename cmd2 {}} +} -result {::::cmd2: a b c} test namespace-16.11 {Tcl_FindCommand, relative name not found} { namespace eval test_ns_1 { list [catch {cmd3 a b c} msg] $msg @@ -2058,6 +2062,7 @@ test namespace-50.3 {chained ensembles affect error messages} -body { a b d } -returnCodes error -result "wrong # args: should be \"a b d f\"" -cleanup { rename a {} + rename c {} } test namespace-50.4 {chained ensembles affect error messages} -body { namespace ens cre -command a -map {b {c d}} @@ -2066,6 +2071,7 @@ test namespace-50.4 {chained ensembles affect error messages} -body { a b d } -returnCodes error -result "wrong # args: should be \"a b\"" -cleanup { rename a {} + rename c {} } test namespace-51.1 {name resolution path control} -body { |