summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-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
7 files changed, 56 insertions, 22 deletions
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-12 21:43:41 (GMT)