summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ChangeLog16
-rw-r--r--changes4
-rw-r--r--generic/tclInterp.c6
-rw-r--r--tests/chanio.test6
-rw-r--r--tests/cmdAH.test4
-rw-r--r--tests/event.test4
-rw-r--r--tests/interp.test33
-rw-r--r--tests/io.test6
-rw-r--r--tests/ioTrans.test7
-rw-r--r--tests/namespace.test18
10 files changed, 77 insertions, 27 deletions
diff --git a/ChangeLog b/ChangeLog
index 718adad..b4ad340 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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>
diff --git a/changes b/changes
index ecb0d47..ed5a9da 100644
--- a/changes
+++ b/changes
@@ -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 {
generated by cgit v0.12 at 2024-11-14 15:59:59 (GMT)