summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-rw-r--r--tests/assocd.test14
-rw-r--r--tests/basic.test18
-rw-r--r--tests/cmdInfo.test12
-rw-r--r--tests/dcall.test8
-rw-r--r--tests/env.test2
-rw-r--r--tests/exec.test2
-rw-r--r--tests/expr-old.test20
-rw-r--r--tests/http.test7
-rw-r--r--tests/info.test25
-rw-r--r--tests/listObj.test4
-rw-r--r--tests/main.test4
-rw-r--r--tests/msgcat.test8
-rw-r--r--tests/nre.test25
-rw-r--r--tests/parse.test9
-rw-r--r--tests/parseExpr.test8
-rw-r--r--tests/parseOld.test15
-rw-r--r--tests/pkgMkIndex.test30
-rw-r--r--tests/platform.test17
-rw-r--r--tests/result.test6
-rw-r--r--tests/stack.test6
-rwxr-xr-xtests/tcltest.test21
-rw-r--r--tests/thread.test107
-rw-r--r--tests/tm.test10
-rw-r--r--tests/trace.test512
-rw-r--r--tests/unixInit.test14
-rw-r--r--tests/unknown.test12
26 files changed, 436 insertions, 480 deletions
diff --git a/tests/assocd.test b/tests/assocd.test
index ddab034..b543c64 100644
--- a/tests/assocd.test
+++ b/tests/assocd.test
@@ -11,17 +11,15 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {"::tcltest" ni [namespace children]} {
- package require tcltest
- namespace import -force ::tcltest::*
-}
+package require tcltest 2
+namespace import ::tcltest::*
::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
-::tcltest::testConstraint testgetassocdata [llength [info commands testgetassocdata]]
-::tcltest::testConstraint testsetassocdata [llength [info commands testsetassocdata]]
-::tcltest::testConstraint testdelassocdata [llength [info commands testdelassocdata]]
+testConstraint testgetassocdata [llength [info commands testgetassocdata]]
+testConstraint testsetassocdata [llength [info commands testsetassocdata]]
+testConstraint testdelassocdata [llength [info commands testdelassocdata]]
test assocd-1.1 {testing setting assoc data} testsetassocdata {
testsetassocdata a 1
@@ -60,5 +58,5 @@ test assocd-3.3 {testing deleting assoc data} testdelassocdata {
} {0 {}}
# cleanup
-::tcltest::cleanupTests
+cleanupTests
return
diff --git a/tests/basic.test b/tests/basic.test
index 270d8d9..ccf26cc 100644
--- a/tests/basic.test
+++ b/tests/basic.test
@@ -16,7 +16,7 @@
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
package require tcltest 2
-namespace import -force ::tcltest::*
+namespace import ::tcltest::*
::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
@@ -613,7 +613,7 @@ test basic-46.4 {Tcl_AllowExceptions: exception return not allowed} -setup {
removeFile BREAKtest
} -returnCodes error -match glob -result {invoked "break" outside of a loop
while executing*
-"foo \[set a 1\] \[break\]"
+"foo \[set a 1] \[break]"
(file "*BREAKtest" line 2)}
test basic-46.5 {Tcl_AllowExceptions: exception return not allowed} -setup {
@@ -647,12 +647,12 @@ proc l3 {} {
# Do all tests once byte compiled and once with direct string evaluation
for {set noComp 0} {$noComp <= 1} {incr noComp} {
-if {$noComp} {
- interp alias "" run "" testevalex
+if $noComp {
+ interp alias {} run {} testevalex
set constraints testevalex
} else {
- interp alias "" run "" if 1
- set constraints ""
+ interp alias {} run {} if 1
+ set constraints {}
}
test basic-47.2.$noComp {Tcl_EvalEx: error during word expansion} -body {
@@ -961,8 +961,8 @@ test basic-49.2 {Tcl_EvalEx: verify TCL_EVAL_GLOBAL operation} testevalex {
# Clean up after expand tests
unset noComp l1 l2 constraints
-rename l3 ""
-rename run ""
+rename l3 {}
+rename run {}
#cleanup
catch {namespace delete {*}[namespace children :: test_ns_*]}
@@ -973,5 +973,5 @@ catch {rename q ""}
catch {rename cmd ""}
catch {rename value:at: ""}
unset -nocomplain x
-::tcltest::cleanupTests
+cleanupTests
return
diff --git a/tests/cmdInfo.test b/tests/cmdInfo.test
index 18e5c95..0a587e8 100644
--- a/tests/cmdInfo.test
+++ b/tests/cmdInfo.test
@@ -13,10 +13,8 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {"::tcltest" ni [namespace children]} {
- package require tcltest 2
- namespace import -force ::tcltest::*
-}
+package require tcltest 2
+namespace import ::tcltest::*
::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
@@ -73,8 +71,8 @@ test cmdinfo-4.1 {Tcl_GetCommandName/Tcl_GetCommandFullName procedures} \
lappend y {*}[testcmdtoken name $x]
} {newName ::newName x1 ::x1}
-catch {rename newTestCmd ""}
-catch {rename newTestCmd2 ""}
+catch {rename newTestCmd {}}
+catch {rename newTestCmd2 {}}
test cmdinfo-5.1 {Names for commands created when inside namespaces} \
{testcmdtoken} {
@@ -101,7 +99,7 @@ test cmdinfo-6.1 {Names for commands created when outside namespaces} \
# cleanup
catch {namespace delete cmdInfoNs1::cmdInfoNs2 cmdInfoNs1}
catch {rename x1 ""}
-::tcltest::cleanupTests
+cleanupTests
return
# Local Variables:
diff --git a/tests/dcall.test b/tests/dcall.test
index fadbd45..41dd777 100644
--- a/tests/dcall.test
+++ b/tests/dcall.test
@@ -11,10 +11,8 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {"::tcltest" ni [namespace children]} {
- package require tcltest
- namespace import -force ::tcltest::*
-}
+package require tcltest 2
+namespace import ::tcltest::*
::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
@@ -41,5 +39,5 @@ test dcall-1.6 {deletion callbacks} testdcall {
} {}
# cleanup
-::tcltest::cleanupTests
+cleanupTests
return
diff --git a/tests/env.test b/tests/env.test
index 34c758b..8f22f53 100644
--- a/tests/env.test
+++ b/tests/env.test
@@ -70,7 +70,7 @@ set printenvScript [makeFile {
}
proc mangle s {
regsub -all {\[|\\|\]} $s {\\&} s
- regsub -all {[\u0000-\u001f\u007f-\uffff]} $s {[manglechar &]} s
+ regsub -all "\[\u0000-\u001f\u007f-\uffff\]" $s {[manglechar &]} s
return [subst -novariables $s]
}
proc manglechar c {
diff --git a/tests/exec.test b/tests/exec.test
index 916b739..a354440 100644
--- a/tests/exec.test
+++ b/tests/exec.test
@@ -157,7 +157,7 @@ test exec-2.6 {redirecting input from immediate source, with UTF} -setup {
encoding system iso8859-1
proc quotenonascii s {
regsub -all {\[|\\|\]} $s {\\&} s
- regsub -all {[\u007f-\uffff]} $s \
+ regsub -all "\[\u007f-\uffff\]" $s \
{[apply {c {format {\u%04x} [scan $c %c]}} &]} s
return [subst -novariables $s]
}
diff --git a/tests/expr-old.test b/tests/expr-old.test
index 3d93b98..06a00ba 100644
--- a/tests/expr-old.test
+++ b/tests/expr-old.test
@@ -13,10 +13,8 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {"::tcltest" ni [namespace children]} {
- package require tcltest 2.1
- namespace import -force ::tcltest::*
-}
+package require tcltest 2.1
+namespace import ::tcltest::*
::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
@@ -24,9 +22,9 @@ catch [list package require -exact Tcltest [info patchlevel]]
testConstraint testexprlong [llength [info commands testexprlong]]
testConstraint testexprdouble [llength [info commands testexprdouble]]
testConstraint testexprstring [llength [info commands testexprstring]]
-testConstraint longIs32bit [expr { ( int (0x80000000) ) < 0}]
+testConstraint longIs32bit [expr {int(0x80000000) < 0}]
-if {[catch {expr T1()} msg] && ($msg eq {invalid command name "tcl::mathfunc::T1"})} {
+if {[catch {expr T1()} msg] && $msg eq {invalid command name "tcl::mathfunc::T1"}} {
testConstraint testmathfunctions 0
} else {
testConstraint testmathfunctions 1
@@ -1016,11 +1014,11 @@ test expr-old-36.14 {ExprLooksLikeInt procedure} {
} 123456789012345678901234567891
test expr-old-36.15 {ExprLooksLikeInt procedure} {
set x "0o99 "
- list [catch {expr {$x + 1}} msg] $msg
+ list [catch {expr {$x+1}} msg] $msg
} {1 {can't use invalid octal number as operand of "+"}}
test expr-old-36.16 {ExprLooksLikeInt procedure} {
set x " 0xffffffffffffffffffffffffffffffffffffff "
- expr {$x + 1}
+ expr {$x+1}
} [expr 0x100000000000000000000000000000000000000]
test expr-old-37.1 {Check that Tcl_ExprLong doesn't modify interpreter result if no error} testexprlong {
@@ -1165,7 +1163,7 @@ test expr-old-40.3 {min math function} -body {
} -result {1 {too few arguments to math function "min"}}
test expr-old-40.4 {min math function} -body {
expr {min(wide(-1) << 30, 4.5, -10)}
-} -result [expr { ( wide (-1) ) << 30}]
+} -result [expr {wide(-1) << 30}]
test expr-old-40.5 {min math function} -body {
expr {min("a", 0)}
} -returnCodes error -match glob -result *
@@ -1184,7 +1182,7 @@ test expr-old-41.3 {max math function} -body {
} -result {1 {too few arguments to math function "max"}}
test expr-old-41.4 {max math function} -body {
expr {max(wide(1) << 30, 4.5, -10)}
-} -result [expr { ( wide(1) ) << 30}]
+} -result [expr {wide(1) << 30}]
test expr-old-41.5 {max math function} -body {
expr {max("a", 0)}
} -returnCodes error -match glob -result *
@@ -1194,7 +1192,7 @@ test expr-old-41.6 {max math function} -body {
# Special test for Pentium arithmetic bug of 1994:
-if {(4195835.0 - ((4195835.0 / 3145727.0) * 3145727.0)) == 256.0} {
+if {(4195835.0 - (4195835.0/3145727.0)*3145727.0) == 256.0} {
puts "Warning: this machine contains a defective Pentium processor"
puts "that performs arithmetic incorrectly. I recommend that you"
puts "call Intel customer service immediately at 1-800-628-8686"
diff --git a/tests/http.test b/tests/http.test
index 5e09bfc..cd64f6d 100644
--- a/tests/http.test
+++ b/tests/http.test
@@ -547,11 +547,10 @@ test http-4.14 {http::Event} -body {
error "bogus return from http::geturl"
}
http::wait $token
- http::status $token
- # error code varies among platforms.
-} -returnCodes 1 -match regexp -cleanup {
+ lindex [http::error $token] 0
+} -cleanup {
catch {http::cleanup $token}
-} -result {(connect failed|couldn't open socket)}
+} -result {connect failed connection refused}
# Bogus host
test http-4.15 {http::Event} -body {
# This test may fail if you use a proxy server. That is to be
diff --git a/tests/info.test b/tests/info.test
index f19d91c..e6d737b 100644
--- a/tests/info.test
+++ b/tests/info.test
@@ -693,33 +693,32 @@ test info-21.5 {miscellaneous error conditions} -returnCodes error -body {
##
# ### ### ### ######### ######### #########
## info frame
+
## Helper
# For the more complex results we cut the file name down to remove path
# dependencies, and we use only part of the first line of the reported
# command. The latter is required because otherwise the whole test case may
# appear in some results, but the result is part of the testcase. An infinite
# string would be required to describe that. The cutting-down breaks this.
+
proc reduce {frame} {
- set pos [lsearch -exact $frame cmd]
- incr pos
- set cmd [lindex $frame $pos]
+ set cmd [dict get $frame cmd]
if {[regexp \n $cmd]} {
- set first [string range [lindex [split $cmd \n] 0] 0 end-4]
- set frame [lreplace $frame $pos $pos $first]
+ dict set frame cmd \
+ [string range [lindex [split $cmd \n] 0] 0 end-4]
}
- set pos [lsearch -exact $frame file]
- if {$pos >= 0} {
- incr pos
- set tail [file tail [lindex $frame $pos]]
- set frame [lreplace $frame $pos $pos $tail]
+ if {[dict exists $frame file]} {
+ dict set frame file \
+ [file tail [dict get $frame file]]
}
- set frame
+ return $frame
}
proc subinterp {} {
interp create sub
interp debug sub -frame 1
interp eval sub [list proc reduce [info args reduce] [info body reduce]]
}
+
## Helper
# Generate a stacktrace from the current location to top. This code
# not only depends on the exact location of things, but also on the
@@ -1465,9 +1464,9 @@ test info-30.1 {bs+nl in literal words, procedure body, compiled} -body {
test info-30.2 {bs+nl in literal words, namespace script} {
namespace eval xxx {
variable res \
- [reduce [info frame 0]];# line 1468
+ [info frame 0];# line 1468
}
- return $xxx::res
+ return [reduce $xxx::res]
} {type source line 1468 file info.test cmd {info frame 0} level 0}
test info-30.3 {bs+nl in literal words, namespace multi-word script} {
diff --git a/tests/listObj.test b/tests/listObj.test
index 09a84d9..081e88a 100644
--- a/tests/listObj.test
+++ b/tests/listObj.test
@@ -196,6 +196,10 @@ test listobj-10.1 {Bug [2971669]} {*}{
-result {{a b c d e} {} {a b c d e f}}
}
+test listobj-11.1 {bug 3598580} {
+ testobj bug3598580
+} 123
+
# cleanup
::tcltest::cleanupTests
return
diff --git a/tests/main.test b/tests/main.test
index 3e2b85f..351fd4f 100644
--- a/tests/main.test
+++ b/tests/main.test
@@ -618,7 +618,7 @@ namespace eval ::tcl::test::main {
after cancel $id
set wait
} -cleanup {
- if {("timeout" eq $wait) && [testConstraint unix]} {
+ if {$wait eq "timeout" && [testConstraint unix]} {
exec kill [pid $f]
}
close $f
@@ -641,7 +641,7 @@ namespace eval ::tcl::test::main {
after cancel $id
set wait
} -cleanup {
- if {("timeout" eq $wait) && [testConstraint unix]} {
+ if {$wait eq "timeout" && [testConstraint unix]} {
exec kill [pid $f]
}
close $f
diff --git a/tests/msgcat.test b/tests/msgcat.test
index 5ed61a7..70a7af2 100644
--- a/tests/msgcat.test
+++ b/tests/msgcat.test
@@ -12,7 +12,7 @@
# Note that after running these tests, entries will be left behind in the
# message catalogs for locales foo, foo_BAR, and foo_BAR_baz.
-package require Tcl 8.2
+package require Tcl 8.5
if {[catch {package require tcltest 2}]} {
puts stderr "Skipping tests in [info script]. tcltest 2 required."
return
@@ -56,8 +56,8 @@ namespace eval ::msgcat::test {
set result [string tolower \
[msgcat::ConvertLocale $::tcl::mac::locale]]
} else {
- if {([info sharedlibextension] eq ".dll") &&
- (![catch {package require registry}])} {
+ if {([info sharedlibextension] eq ".dll")
+ && ![catch {package require registry}]} {
# Windows and Cygwin have other ways to determine the
# locale when the environment variables are missing
# and the registry package is present
@@ -417,7 +417,7 @@ namespace eval ::msgcat::test {
mclocale $locale
} -body {
mcload $msgdir
- } -result [expr { $count + 1 }]
+ } -result [expr { $count+1 }]
incr count
}
diff --git a/tests/nre.test b/tests/nre.test
index 4f1bd5e..85ac8d8 100644
--- a/tests/nre.test
+++ b/tests/nre.test
@@ -74,7 +74,6 @@ test nre-1.1 {self-recursive procs} -setup {
} -constraints {
testnrelevels
} -result {{0 1 1 1} 0}
-
test nre-1.2 {self-recursive lambdas} -setup {
set a [list i [makebody {apply $::a $i}]]
} -body {
@@ -85,7 +84,6 @@ test nre-1.2 {self-recursive lambdas} -setup {
} -constraints {
testnrelevels
} -result {{0 1 1 1} 0}
-
test nre-1.3 {mutually recursive procs and lambdas} -setup {
proc a i {
apply $::b [incr i]
@@ -164,8 +162,7 @@ test nre-5.1 {[namespace eval] is not recursive} -setup {
namespace delete ::foo
} -constraints {
testnrelevels
-} -result {{0 3 2 2} 0}
-
+} -result {{0 2 2 2} 0}
test nre-5.2 {[namespace eval] is not recursive} -setup {
namespace eval ::foo {
setabs
@@ -177,7 +174,7 @@ test nre-5.2 {[namespace eval] is not recursive} -setup {
namespace delete ::foo
} -constraints {
testnrelevels
-} -result {{0 3 2 2} 0}
+} -result {{0 2 2 2} 0}
test nre-6.1 {[uplevel] is not recursive} -setup {
proc a i [makebody {uplevel 1 [list a $i]}]
@@ -189,7 +186,6 @@ test nre-6.1 {[uplevel] is not recursive} -setup {
} -constraints {
testnrelevels
} -result {{0 2 2 0} 0}
-
test nre-6.2 {[uplevel] is not recursive} -setup {
setabs
proc a i [makebody {uplevel 1 "set x $i; a $i"}]
@@ -211,7 +207,6 @@ test nre-7.1 {[catch] is not recursive} -setup {
} -constraints {
testnrelevels
} -result {{0 3 3 0} 0}
-
test nre-7.2 {[if] is not recursive} -setup {
setabs
proc a i [makebody {uplevel 1 "if 1 {a $i}"}]
@@ -222,7 +217,6 @@ test nre-7.2 {[if] is not recursive} -setup {
} -constraints {
testnrelevels
} -result {{0 2 2 0} 0}
-
test nre-7.3 {[while] is not recursive} -setup {
setabs
proc a i [makebody {uplevel 1 "while 1 {set res \[a $i\]; break}; set res"}]
@@ -233,7 +227,6 @@ test nre-7.3 {[while] is not recursive} -setup {
} -constraints {
testnrelevels
} -result {{0 2 2 0} 0}
-
test nre-7.4 {[for] is not recursive} -setup {
setabs
proc a i [makebody {uplevel 1 "for {set j 0} {\$j < 10} {incr j} {set res \[a $i\]; break}; set res"}]
@@ -244,7 +237,6 @@ test nre-7.4 {[for] is not recursive} -setup {
} -constraints {
testnrelevels
} -result {{0 2 2 0} 0}
-
test nre-7.5 {[foreach] is not recursive} -setup {
#
# Enable once [foreach] is NR-enabled
@@ -258,7 +250,6 @@ test nre-7.5 {[foreach] is not recursive} -setup {
} -constraints {
testnrelevels
} -result {{0 3 3 0} 0}
-
test nre-7.6 {[eval] is not recursive} -setup {
proc a i [makebody {eval [list a $i]}]
} -body {
@@ -269,7 +260,6 @@ test nre-7.6 {[eval] is not recursive} -setup {
} -constraints {
testnrelevels
} -result {{0 2 2 1} 0}
-
test nre-7.7 {[eval] is not recursive} -setup {
proc a i [makebody {eval "a $i"}]
} -body {
@@ -280,7 +270,6 @@ test nre-7.7 {[eval] is not recursive} -setup {
} -constraints {
testnrelevels
} -result {{0 2 2 1} 0}
-
test nre-7.8 {bug #2910748: switch out of stale BC is not nre-aware} -setup {
proc foo args {}
foo
@@ -295,17 +284,14 @@ test nre-7.8 {bug #2910748: switch out of stale BC is not nre-aware} -setup {
} -body {
# if switching to plain eval is not nre aware, this will cause a "cannot
# yield" error
-
list [bar] [bar] [bar]
} -cleanup {
rename bar ""
rename foo ""
} -result {1 2 3}
-
test nre-8.1 {nre and {*}} -body {
# force an expansion that grows the evaluation stack, check that nre
# adapts the TEBCdataPtr. This crashes on failure.
-
proc inner {} {
set long [lrepeat 1000000 1]
list {*}$long
@@ -320,14 +306,12 @@ test nre-8.2 {nre and {*}, [Bug 2415422]} -body {
# force an expansion that grows the evaluation stack, check that nre
# adapts the bcFramePtr. This causes an NRE assertion to fail if it is not
# done properly.
-
proc nop {} {}
proc crash {} {
foreach val [list {*}[lrepeat 100000 x]] {
nop
}
}
-
crash
} -cleanup {
rename nop ""
@@ -349,7 +333,6 @@ test nre-oo.1 {really deep calls in oo - direct} -setup {
} -constraints {
testnrelevels
} -result {{0 1 1 1} 0}
-
test nre-oo.2 {really deep calls in oo - call via [self]} -setup {
oo::object create foo
oo::objdefine foo method bar i [makebody {[self] bar $i}]
@@ -361,7 +344,6 @@ test nre-oo.2 {really deep calls in oo - call via [self]} -setup {
} -constraints {
testnrelevels
} -result {{0 1 1 1} 0}
-
test nre-oo.3 {really deep calls in oo - private calls} -setup {
oo::object create foo
oo::objdefine foo method bar i [makebody {my bar $i}]
@@ -373,7 +355,6 @@ test nre-oo.3 {really deep calls in oo - private calls} -setup {
} -constraints {
testnrelevels
} -result {{0 1 1 1} 0}
-
test nre-oo.4 {really deep calls in oo - overriding} -setup {
oo::class create foo {
method bar i [makebody {my bar $i}]
@@ -390,7 +371,6 @@ test nre-oo.4 {really deep calls in oo - overriding} -setup {
} -constraints {
testnrelevels
} -result {{0 1 1 1} 0}
-
test nre-oo.5 {really deep calls in oo - forwards} -setup {
oo::object create foo
set body [makebody {my boo $i}]
@@ -407,7 +387,6 @@ test nre-oo.5 {really deep calls in oo - forwards} -setup {
testnrelevels
} -result {{0 2 1 1} 0}
-
#
# NASTY BUG found by tcllib's interp package
#
diff --git a/tests/parse.test b/tests/parse.test
index bc9fb11..b9cfe80 100644
--- a/tests/parse.test
+++ b/tests/parse.test
@@ -26,6 +26,7 @@ testConstraint testparsevarname [llength [info commands testparsevarname]]
testConstraint testparsevar [llength [info commands testparsevar]]
testConstraint testasync [llength [info commands testasync]]
testConstraint testcmdtrace [llength [info commands testcmdtrace]]
+testConstraint testevent [llength [info commands testevent]]
test parse-1.1 {Tcl_ParseCommand procedure, computing string length} testparser {
testparser [bytestring "foo\0 bar"] -1
@@ -436,6 +437,7 @@ test parse-8.12 {Tcl_EvalObjv procedure, TCL_EVAL_INVOKE} {
set ::info
} global
+
test parse-9.1 {Tcl_LogCommandInfo, line numbers} testevalex {
unset -nocomplain x
list [catch {testevalex {for {} 1 {} {
@@ -1089,6 +1091,13 @@ test parse-20.12 {TclParseBackslash: truncated escape} testparser {
testparser {\x12X} 5
} {- {\x12X} 1 word {\x12X} 2 backslash {\x12} 0 text X 0 {}}
+test parse-21.0 {Bug 1884496} testevent {
+ set ::script {testevent delete a; set a [p]; set ::done $a}
+ proc ::p {} {string first s $::script}
+ testevent queue a head $::script
+ vwait done
+} {}
+
cleanupTests
}
diff --git a/tests/parseExpr.test b/tests/parseExpr.test
index 98d3f67..714c45b 100644
--- a/tests/parseExpr.test
+++ b/tests/parseExpr.test
@@ -8,10 +8,8 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {"::tcltest" ni [namespace children]} {
- package require tcltest 2
- namespace import -force ::tcltest::*
-}
+package require tcltest 2
+namespace import ::tcltest::*
::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
@@ -1067,5 +1065,5 @@ test parseExpr-22.18 {Bug 3401704} -constraints testexprparser -body {
# cleanup
-::tcltest::cleanupTests
+cleanupTests
return
diff --git a/tests/parseOld.test b/tests/parseOld.test
index 0e5b68f..f3b1591 100644
--- a/tests/parseOld.test
+++ b/tests/parseOld.test
@@ -13,10 +13,8 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {"::tcltest" ni [namespace children]} {
- package require tcltest
- namespace import -force ::tcltest::*
-}
+package require tcltest
+namespace import ::tcltest::*
::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
@@ -34,7 +32,7 @@ proc fourArgs {a b c d} {
set arg4 $d
}
-proc getArgs {args} {
+proc getArgs args {
global argv
set argv $args
}
@@ -110,7 +108,7 @@ test parseOld-3.6 {braces} {
set argv
} "a{{}}b"
test parseOld-3.7 {braces} {
- set a [format "last\]"]
+ set a [format "last]"]
set a
} {last]}
@@ -510,10 +508,11 @@ test parseOld-14.17 {TclWordEnd procedure} {testwordend} {
} {c}
test parseOld-14.18 {TclWordEnd procedure} {testwordend} {
testwordend \[a\000\]
-} {\]}
+} {]}
test parseOld-14.19 {TclWordEnd procedure} {testwordend} {
testwordend \"a\000\"
-} {\"}
+} {"}
+#" Emacs formatting :^(
test parseOld-14.20 {TclWordEnd procedure} {testwordend} {
testwordend a{\000}b
} {b}
diff --git a/tests/pkgMkIndex.test b/tests/pkgMkIndex.test
index daf9c1c..84c82ce 100644
--- a/tests/pkgMkIndex.test
+++ b/tests/pkgMkIndex.test
@@ -8,10 +8,8 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
-if {"::tcltest" ni [namespace children]} {
- package require tcltest 2
- namespace import -force ::tcltest::*
-}
+package require tcltest 2
+namespace import ::tcltest::*
set fullPkgPath [makeDirectory pkg]
@@ -45,7 +43,7 @@ proc pkgtest::parseArgs { args } {
set a [lindex $args $iarg]
if {[regexp {^-} $a]} {
lappend options $a
- if {"-load" eq $a} {
+ if {$a eq "-load"} {
incr iarg
lappend options [lindex $args $iarg]
}
@@ -75,7 +73,7 @@ proc pkgtest::parseArgs { args } {
proc pkgtest::parseIndex { filePath } {
# create a slave interpreter, where we override "package ifneeded"
- global errorCode errorInfo
+
set slave [interp create]
if {[catch {
$slave eval {
@@ -111,9 +109,9 @@ proc pkgtest::parseIndex { filePath } {
foreach k [lsort [array names P]] {
lappend PKGS $k $P($k)
}
- } err]} {
- set ei $errorInfo
- set ec $errorCode
+ } err opts]} {
+ set ei [dict get $opts -errorinfo]
+ set ec [dict get $opts -errorcode]
catch {interp delete $slave}
@@ -153,7 +151,7 @@ proc pkgtest::createIndex { args } {
file mkdir $dirPath
if {[catch {
- file delete -- [file join $dirPath pkgIndex.tcl]
+ file delete [file join $dirPath pkgIndex.tcl]
pkg_mkIndex {*}$options $dirPath {*}$patternList
} err]} {
return [list 1 $err]
@@ -184,7 +182,7 @@ proc makePkgList { inList } {
set pkgList ""
foreach {k v} $inList {
- switch -- [lindex $v 0] {
+ switch [lindex $v 0] {
tclPkgSetup {
set l tclPkgSetup
foreach s [lindex $v 4] {
@@ -234,7 +232,7 @@ proc pkgtest::runCreatedIndex {rv args} {
} err]} {
set result [list 1 $err]
}
- file delete -- $idxFile
+ file delete $idxFile
} else {
set result $rv
}
@@ -358,7 +356,7 @@ proc direct1::pd2 { stg } {
return [string toupper $stg]
}
} [file join direct1 direct1.tcl]
-pkg_mkIndex -direct -- $direct1 direct1.tcl
+pkg_mkIndex -direct $direct1 direct1.tcl
makeFile {
# Does a package require of direct1, whose pkgIndex.tcl entry is created
@@ -382,7 +380,7 @@ test pkgMkIndex-5.1 {requires -direct package} {
} {0 {{std:1.0 {tclPkgSetup {std.tcl source {::std::p1 ::std::p2}}}}}}
removeFile [file join direct1 direct1.tcl]
-file delete -- [file join $direct1 pkgIndex.tcl]
+file delete [file join $direct1 pkgIndex.tcl]
removeDirectory direct1
removeFile [file join pkg std.tcl]
@@ -565,7 +563,7 @@ proc pkga_neq { x } {
return [expr {! [pkgq_eq $x]}]
}
} [file join pkg pkga.tcl]
- file copy -force -- $x $fullPkgPath
+ file copy -force $x $fullPkgPath
}
testConstraint exec [llength [info commands ::exec]]
@@ -592,7 +590,7 @@ test pkgMkIndex-10.2 {package in DLL hidden by -load} [list exec $dll] {
} {0 {}}
if {[testConstraint $dll]} {
- file delete -force -- [file join $fullPkgPath [file tail $x]]
+ file delete -force [file join $fullPkgPath [file tail $x]]
removeFile [file join pkg pkga.tcl]
}
diff --git a/tests/platform.test b/tests/platform.test
index 8639f0c..6596975 100644
--- a/tests/platform.test
+++ b/tests/platform.test
@@ -9,10 +9,14 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {"::tcltest" ni [namespace children]} {
- package require tcltest
- namespace import -force ::tcltest::*
-}
+package require tcltest 2
+
+namespace eval ::tcl::test::platform {
+ namespace import ::tcltest::testConstraint
+ namespace import ::tcltest::test
+ namespace import ::tcltest::cleanupTests
+
+ variable ::tcl_platform
::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
@@ -54,7 +58,10 @@ test platform-3.1 {CPU ID on Windows/UNIX} \
-result {^(?:AuthenticAMD|CentaurHauls|CyrixInstead|GenuineIntel)$}
# cleanup
-::tcltest::cleanupTests
+cleanupTests
+
+}
+namespace delete ::tcl::test::platform
return
# Local Variables:
diff --git a/tests/result.test b/tests/result.test
index 43cf9a5..9e8a66b 100644
--- a/tests/result.test
+++ b/tests/result.test
@@ -10,10 +10,8 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {"::tcltest" ni [namespace children]} {
- package require tcltest 2
- namespace import -force ::tcltest::*
-}
+package require tcltest 2
+namespace import ::tcltest::*
::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
diff --git a/tests/stack.test b/tests/stack.test
index cf46b7b..13bc524 100644
--- a/tests/stack.test
+++ b/tests/stack.test
@@ -9,10 +9,8 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {"::tcltest" ni [namespace children]} {
- package require tcltest 2
- namespace import -force ::tcltest::*
-}
+package require tcltest 2
+namespace import ::tcltest::*
# Note that a failure in this test may result in a crash of the executable.
diff --git a/tests/tcltest.test b/tests/tcltest.test
index 37637d9..ce8d617 100755
--- a/tests/tcltest.test
+++ b/tests/tcltest.test
@@ -65,9 +65,9 @@ test tcltest-1.3 {tcltest -h} {exec} {
proc slave {msgVar args} {
upvar 1 $msgVar msg
- interp create -- [namespace current]::i
+ interp create [namespace current]::i
# Fake the slave interp into dumping output to a file
- i eval {namespace eval ::tcltest ""}
+ i eval {namespace eval ::tcltest {}}
i eval "set tcltest::outputChannel\
\[[list open [set of [makeFile {} output]] w]]"
i eval "set tcltest::errorChannel\
@@ -80,10 +80,7 @@ proc slave {msgVar args} {
# Need to capture output in msg
- set code [catch {i eval {source $argv0}} foo]
-if {$code} {
-#puts "$code: $foo\n$::errorInfo"
-}
+ set code [catch {i eval {source $argv0}}]
i eval {close $tcltest::outputChannel}
interp delete [namespace current]::i
set f [open $of]
@@ -99,8 +96,6 @@ if {$code} {
append msg \n$err
}
return $code
-
-# return [catch {uplevel 1 [linsert $args 0 exec [interpreter]]} msg]
}
test tcltest-2.0 {tcltest (verbose default - 'b')} {unixOrPc} {
set result [slave msg test.tcl]
@@ -520,10 +515,10 @@ set a [makeFile {
exit
} a.tcl]
-set tdiaf [::tcltest::makeFile {} thisdirectoryisafile]
+set tdiaf [makeFile {} thisdirectoryisafile]
-set normaldirectory [::tcltest::makeDirectory normaldirectory]
-::tcltest::normalizePath normaldirectory
+set normaldirectory [makeDirectory normaldirectory]
+normalizePath normaldirectory
# -tmpdir, [temporaryDirectory]
test tcltest-8.1 {tcltest a.tcl -tmpdir a} -constraints unixOrPc -setup {
@@ -549,7 +544,7 @@ set notWriteableDir [file join [temporaryDirectory] notwriteable]
makeDirectory notreadable
makeDirectory notwriteable
switch -- $::tcl_platform(platform) {
- "unix" {
+ unix {
file attributes $notReadableDir -permissions 00333
file attributes $notWriteableDir -permissions 00555
}
@@ -717,7 +712,7 @@ test tcltest-8.60 {::workingDirectory} {
# clean up from directory testing
switch -- $::tcl_platform(platform) {
- "unix" {
+ unix {
file attributes $notReadableDir -permissions 777
file attributes $notWriteableDir -permissions 777
}
diff --git a/tests/thread.test b/tests/thread.test
index febc7a8..f32ef61 100644
--- a/tests/thread.test
+++ b/tests/thread.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.
-if {"::tcltest" ni [namespace children]} {
+if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2.2
namespace import -force ::tcltest::*
}
@@ -42,11 +42,11 @@ set threadSuperKillScript {
proc getThreadErrorFromInfo { info } {
set list [split $info \n]
set idx [lsearch -glob $list "*eval*unwound*"]
- if {$idx != -1} {
+ if {$idx != -1} then {
return [lindex $list $idx]
}
set idx [lsearch -glob $list "*eval*canceled*"]
- if {$idx != -1} {
+ if {$idx != -1} then {
return [lindex $list $idx]
}
return ""; # some other error we do not care about.
@@ -55,7 +55,7 @@ proc getThreadErrorFromInfo { info } {
proc findThreadError { info } {
foreach error [lreverse $info] {
set error [getThreadErrorFromInfo $error]
- if {[string length $error] > 0} {
+ if {[string length $error] > 0} then {
return $error
}
}
@@ -64,7 +64,7 @@ proc findThreadError { info } {
proc ThreadError {id info} {
global threadSawError
- if {[string length [getThreadErrorFromInfo $info]] > 0} {
+ if {[string length [getThreadErrorFromInfo $info]] > 0} then {
global threadId threadError
set threadId $id
lappend threadError($id) $info
@@ -84,28 +84,6 @@ if {[testConstraint testthread]} {
}
testthread errorproc ThreadError
-
- set mainThread [testthread id]
-
- proc ThreadNullError {id info} {
- # ignore
- }
-
- proc threadReap {} {
- testthread errorproc ThreadNullError
- while {[llength [testthread names]] > 1} {
- foreach tid [testthread names] {
- if {$tid != [testthread id]} {
- catch {
- testthread send -async $tid {testthread exit}
- }
- }
- }
- after 1
- }
- testthread errorproc ThreadError
- return [llength [testthread names]]
- }
}
# Some tests require manual draining of the event queue
@@ -159,7 +137,7 @@ test thread-1.15 {Tcl_ThreadObjCmd: wait} {thread} {
# ThreadErrorProc, except for printing to standard error
test thread-2.1 {ListUpdateInner and ListRemove} {thread} {
- unset -nocomplain tid
+ catch {unset tid}
foreach t {0 1 2} {
upvar #0 t$t tid
set tid [thread::create -preserved]
@@ -172,7 +150,7 @@ test thread-2.1 {ListUpdateInner and ListRemove} {thread} {
} 1
test thread-3.1 {TclThreadList} {thread} {
- unset -nocomplain tid
+ catch {unset tid}
set len [llength [thread::names]]
set l1 {}
foreach t {0 1 2} {
@@ -187,7 +165,7 @@ test thread-3.1 {TclThreadList} {thread} {
} {1 0}
test thread-4.1 {TclThreadSend to self} {thread} {
- unset -nocomplain x
+ catch {unset x}
thread::send [thread::id] {
set x 4
}
@@ -233,6 +211,7 @@ test thread-4.5 {TclThreadSend preserve errorCode} {thread} {
list $x $msg $savedErrorCode
} {1 ERR CODE}
+
test thread-5.0 {Joining threads} {thread} {
set serverthread [thread::create -joinable -preserved]
thread::send -async $serverthread {after 1000 ; thread::release}
@@ -274,7 +253,7 @@ test thread-7.4 {cancel: pure bytecode loop} -constraints {thread drainEventQueu
set serverthread [thread::create -joinable \
[string map [list %ID% [thread::id]] {
proc foobar {} {
- if {![info exists foo]} {
+ if {![info exists foo]} then {
# signal the primary thread that we are ready
# to be canceled now (we are running).
thread::send %ID% [list set ::threadIdStarted [thread::id]]
@@ -305,7 +284,7 @@ test thread-7.5 {cancel: pure inside-command loop} -constraints {thread drainEve
set serverthread [thread::create -joinable \
[string map [list %ID% [thread::id]] {
proc foobar {} {
- if {![info exists foo]} {
+ if {![info exists foo]} then {
# signal the primary thread that we are ready
# to be canceled now (we are running).
thread::send %ID% [list set ::threadIdStarted [thread::id]]
@@ -337,7 +316,7 @@ test thread-7.6 {cancel: pure bytecode loop -unwind} -constraints {thread drainE
set serverthread [thread::create -joinable \
[string map [list %ID% [thread::id]] {
proc foobar {} {
- if {![info exists foo]} {
+ if {![info exists foo]} then {
# signal the primary thread that we are ready
# to be canceled now (we are running).
thread::send %ID% [list set ::threadIdStarted [thread::id]]
@@ -368,7 +347,7 @@ test thread-7.7 {cancel: pure inside-command loop -unwind} -constraints {thread
set serverthread [thread::create -joinable \
[string map [list %ID% [thread::id]] {
proc foobar {} {
- if {![info exists foo]} {
+ if {![info exists foo]} then {
# signal the primary thread that we are ready
# to be canceled now (we are running).
thread::send %ID% [list set ::threadIdStarted [thread::id]]
@@ -400,7 +379,7 @@ test thread-7.8 {cancel: pure bytecode loop custom result} -constraints {thread
set serverthread [thread::create -joinable \
[string map [list %ID% [thread::id]] {
proc foobar {} {
- if {![info exists foo]} {
+ if {![info exists foo]} then {
# signal the primary thread that we are ready
# to be canceled now (we are running).
thread::send %ID% [list set ::threadIdStarted [thread::id]]
@@ -434,7 +413,7 @@ test thread-7.9 {cancel: pure inside-command loop custom result} -constraints {
set serverthread [thread::create -joinable \
[string map [list %ID% [thread::id]] {
proc foobar {} {
- if {![info exists foo]} {
+ if {![info exists foo]} then {
# signal the primary thread that we are ready
# to be canceled now (we are running).
thread::send %ID% [list set ::threadIdStarted [thread::id]]
@@ -469,7 +448,7 @@ test thread-7.10 {cancel: pure bytecode loop custom result -unwind} -constraints
set serverthread [thread::create -joinable \
[string map [list %ID% [thread::id]] {
proc foobar {} {
- if {![info exists foo]} {
+ if {![info exists foo]} then {
# signal the primary thread that we are ready
# to be canceled now (we are running).
thread::send %ID% [list set ::threadIdStarted [thread::id]]
@@ -503,7 +482,7 @@ test thread-7.11 {cancel: pure inside-command loop custom result -unwind} -const
set serverthread [thread::create -joinable \
[string map [list %ID% [thread::id]] {
proc foobar {} {
- if {![info exists foo]} {
+ if {![info exists foo]} then {
# signal the primary thread that we are ready
# to be canceled now (we are running).
thread::send %ID% [list set ::threadIdStarted [thread::id]]
@@ -534,7 +513,7 @@ test thread-7.12 {cancel: after} -constraints {thread drainEventQueue} -setup {
} -body {
set serverthread [thread::create -joinable \
[string map [list %ID% [thread::id]] {
- if {![info exists foo]} {
+ if {![info exists foo]} then {
# signal the primary thread that we are ready
# to be canceled now (we are running).
thread::send %ID% [list set ::threadIdStarted [thread::id]]
@@ -560,7 +539,7 @@ test thread-7.13 {cancel: after -unwind} -constraints {thread drainEventQueue} -
} -body {
set serverthread [thread::create -joinable \
[string map [list %ID% [thread::id]] {
- if {![info exists foo]} {
+ if {![info exists foo]} then {
# signal the primary thread that we are ready
# to be canceled now (we are running).
thread::send %ID% [list set ::threadIdStarted [thread::id]]
@@ -586,7 +565,7 @@ test thread-7.14 {cancel: vwait} -constraints {thread drainEventQueue} -setup {
} -body {
set serverthread [thread::create -joinable \
[string map [list %ID [thread::id]] {
- if {![info exists foo]} {
+ if {![info exists foo]} then {
# signal the primary thread that we are ready
# to be canceled now (we are running).
thread::send %ID% [list set ::threadIdStarted [thread::id]]
@@ -612,7 +591,7 @@ test thread-7.15 {cancel: vwait -unwind} -constraints {thread drainEventQueue} -
} -body {
set serverthread [thread::create -joinable \
[string map [list %ID% [thread::id]] {
- if {![info exists foo]} {
+ if {![info exists foo]} then {
# signal the primary thread that we are ready
# to be canceled now (we are running).
thread::send %ID% [list set ::threadIdStarted [thread::id]]
@@ -641,7 +620,7 @@ test thread-7.16 {cancel: expr} -constraints {thread drainEventQueue} -setup {
set i [interp create]
$i eval "package require -exact Thread [package present Thread]"
$i eval {
- if {![info exists foo]} {
+ if {![info exists foo]} then {
# signal the primary thread that we are ready
# to be canceled now (we are running).
@@ -672,7 +651,7 @@ test thread-7.17 {cancel: expr -unwind} -constraints {thread drainEventQueue} -s
set i [interp create]
$i eval "package require -exact Thread [package present Thread]"
$i eval {
- if {![info exists foo]} {
+ if {![info exists foo]} then {
# signal the primary thread that we are ready
# to be canceled now (we are running).
thread::send %ID% [list set ::threadIdStarted [thread::id]]
@@ -701,7 +680,7 @@ test thread-7.18 {cancel: expr bignum} {thread drainEventQueue knownBug} {
set i [interp create]
$i eval "package require -exact Thread [package present Thread]"
$i eval {
- if {![info exists foo]} {
+ if {![info exists foo]} then {
# signal the primary thread that we are ready
# to be canceled now (we are running).
thread::send %ID% [list set ::threadIdStarted [thread::id]]
@@ -733,7 +712,7 @@ test thread-7.19 {cancel: expr bignum -unwind} {thread drainEventQueue knownBug}
set i [interp create]
$i eval "package require -exact Thread [package present Thread]"
$i eval {
- if {![info exists foo]} {
+ if {![info exists foo]} then {
# signal the primary thread that we are ready
# to be canceled now (we are running).
thread::send %ID% [list set ::threadIdStarted [thread::id]]
@@ -766,7 +745,7 @@ test thread-7.20 {cancel: subst} -constraints {thread drainEventQueue} -setup {
set i [interp create]
$i eval "package require -exact Thread [package present Thread]"
$i eval {
- if {![info exists foo]} {
+ if {![info exists foo]} then {
# signal the primary thread that we are ready
# to be canceled now (we are running).
thread::send %ID% [list set ::threadIdStarted [thread::id]]
@@ -796,7 +775,7 @@ test thread-7.21 {cancel: subst -unwind} -constraints {thread drainEventQueue} -
set i [interp create]
$i eval "package require -exact Thread [package present Thread]"
$i eval {
- if {![info exists foo]} {
+ if {![info exists foo]} then {
# signal the primary thread that we are ready
# to be canceled now (we are running).
thread::send %ID% [list set ::threadIdStarted [thread::id]]
@@ -826,7 +805,7 @@ test thread-7.22 {cancel: slave interp} -constraints {thread drainEventQueue} -s
set i [interp create]
$i eval "package require -exact Thread [package present Thread]"
$i eval {
- if {![info exists foo]} {
+ if {![info exists foo]} then {
# signal the primary thread that we are ready
# to be canceled now (we are running).
thread::send %ID% [list set ::threadIdStarted [thread::id]]
@@ -856,7 +835,7 @@ test thread-7.23 {cancel: slave interp -unwind} -constraints {thread drainEventQ
set i [interp create]
$i eval "package require -exact Thread [package present Thread]"
$i eval {
- if {![info exists foo]} {
+ if {![info exists foo]} then {
# signal the primary thread that we are ready
# to be canceled now (we are running).
thread::send %ID% [list set ::threadIdStarted [thread::id]]
@@ -884,7 +863,7 @@ test thread-7.24 {cancel: nested catch inside pure bytecode loop} {thread drainE
[string map [list %ID% [thread::id]] {
proc foobar {} {
while {1} {
- if {![info exists foo]} {
+ if {![info exists foo]} then {
# signal the primary thread that we are ready
# to be canceled now (we are running).
thread::send %ID% [list set ::threadIdStarted [thread::id]]
@@ -926,7 +905,7 @@ test thread-7.25 {cancel: nested catch inside pure inside-command loop} {thread
set catch catch
set while while
$while {1} {
- if {![info exists foo]} {
+ if {![info exists foo]} then {
# signal the primary thread that we are ready
# to be canceled now (we are running).
thread::send %ID% [list set ::threadIdStarted [thread::id]]
@@ -966,7 +945,7 @@ test thread-7.26 {cancel: send async cancel bad interp path} {thread drainEventQ
[string map [list %ID% [thread::id]] {
proc foobar {} {
while {1} {
- if {![info exists foo]} {
+ if {![info exists foo]} then {
# signal the primary thread that we are ready
# to be canceled now (we are running).
thread::send %ID% [list set ::threadIdStarted [thread::id]]
@@ -995,7 +974,7 @@ test thread-7.27 {cancel: send async cancel -- switch} -constraints {thread drai
$i eval {
proc foobar {} {
while {1} {
- if {![info exists foo]} {
+ if {![info exists foo]} then {
# signal the primary thread that we are ready
# to be canceled now (we are running).
thread::send %ID% [list set ::threadIdStarted [thread::id]]
@@ -1026,7 +1005,7 @@ test thread-7.28 {cancel: send async cancel nested catch inside pure bytecode lo
[string map [list %ID% [thread::id]] {
proc foobar {} {
while {1} {
- if {![info exists foo]} {
+ if {![info exists foo]} then {
# signal the primary thread that we are ready
# to be canceled now (we are running).
thread::send %ID% [list set ::threadIdStarted [thread::id]]
@@ -1068,7 +1047,7 @@ test thread-7.29 {cancel: send async cancel nested catch pure inside-command loo
set catch catch
set while while
$while {1} {
- if {![info exists foo]} {
+ if {![info exists foo]} then {
# signal the primary thread that we are ready
# to be canceled now (we are running).
thread::send %ID% [list set ::threadIdStarted [thread::id]]
@@ -1108,7 +1087,7 @@ test thread-7.30 {cancel: send async thread cancel nested catch inside pure byte
[string map [list %ID% [thread::id]] {
proc foobar {} {
while {1} {
- if {![info exists foo]} {
+ if {![info exists foo]} then {
# signal the primary thread that we are ready
# to be canceled now (we are running).
thread::send %ID% [list set ::threadIdStarted [thread::id]]
@@ -1150,7 +1129,7 @@ test thread-7.31 {cancel: send async thread cancel nested catch pure inside-comm
set catch catch
set while while
$while {1} {
- if {![info exists foo]} {
+ if {![info exists foo]} then {
# signal the primary thread that we are ready
# to be canceled now (we are running).
thread::send %ID% [list set ::threadIdStarted [thread::id]]
@@ -1191,7 +1170,7 @@ test thread-7.32 {cancel: nested catch inside pure bytecode loop -unwind} -const
[string map [list %ID% [thread::id]] {
proc foobar {} {
while {1} {
- if {![info exists foo]} {
+ if {![info exists foo]} then {
# signal the primary thread that we are ready
# to be canceled now (we are running).
thread::send %ID% [list set ::threadIdStarted [thread::id]]
@@ -1232,7 +1211,7 @@ test thread-7.33 {cancel: nested catch inside pure inside-command loop -unwind}
set catch catch
set while while
$while {1} {
- if {![info exists foo]} {
+ if {![info exists foo]} then {
# signal the primary thread that we are ready
# to be canceled now (we are running).
thread::send %ID% [list set ::threadIdStarted [thread::id]]
@@ -1271,7 +1250,7 @@ test thread-7.34 {cancel: send async cancel nested catch inside pure bytecode lo
[string map [list %ID% [thread::id]] {
proc foobar {} {
while {1} {
- if {![info exists foo]} {
+ if {![info exists foo]} then {
# signal the primary thread that we are ready
# to be canceled now (we are running).
thread::send %ID% [list set ::threadIdStarted [thread::id]]
@@ -1314,7 +1293,7 @@ test thread-7.35 {cancel: send async cancel nested catch inside pure inside-comm
set catch catch
set while while
$while {1} {
- if {![info exists foo]} {
+ if {![info exists foo]} then {
# signal the primary thread that we are ready
# to be canceled now (we are running).
thread::send %ID% [list set ::threadIdStarted [thread::id]]
@@ -1355,7 +1334,7 @@ test thread-7.36 {cancel: send async thread cancel nested catch inside pure byte
[string map [list %ID% [thread::id]] {
proc foobar {} {
while {1} {
- if {![info exists foo]} {
+ if {![info exists foo]} then {
# signal the primary thread that we are ready
# to be canceled now (we are running).
thread::send %ID% [list set ::threadIdStarted [thread::id]]
@@ -1398,7 +1377,7 @@ test thread-7.37 {cancel: send async thread cancel nested catch inside pure insi
set catch catch
set while while
$while {1} {
- if {![info exists foo]} {
+ if {![info exists foo]} then {
# signal the primary thread that we are ready
# to be canceled now (we are running).
thread::send %ID% [list set ::threadIdStarted [thread::id]]
diff --git a/tests/tm.test b/tests/tm.test
index 85db6aa..1b22f8c 100644
--- a/tests/tm.test
+++ b/tests/tm.test
@@ -40,6 +40,7 @@ test tm-2.3 {tm: roots command syntax} -returnCodes error -body {
::tcl::tm::roots foo bar
} -result "wrong # args: should be \"::tcl::tm::roots paths\""
+
test tm-3.1 {tm: module path management, input validation} -setup {
# Save and clear the list
set defaults [::tcl::tm::path list]
@@ -195,11 +196,12 @@ test tm-3.11 {tm: module path management, remove ignores unknown path} -setup {
::tcl::tm::path list
} -result {geode snarf foo}
-proc genpaths {a_base} {
+
+proc genpaths {base} {
# Normalizing picks up drive letters on windows [Bug 1053568]
- set base [file normalize $a_base]
- lassign [split [info tclversion] "."] major minor
- set results [list]
+ set base [file normalize $base]
+ lassign [split [package present Tcl] .] major minor
+ set results {}
set base [file join $base tcl$major]
lappend results [file join $base site-tcl]
for {set i 0} {$i <= $minor} {incr i} {
diff --git a/tests/trace.test b/tests/trace.test
index 35429f6..b4957c0 100644
--- a/tests/trace.test
+++ b/tests/trace.test
@@ -11,10 +11,8 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {"::tcltest" ni [namespace children]} {
- package require tcltest
- namespace import -force ::tcltest::*
-}
+package require tcltest
+namespace import ::tcltest::*
::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
@@ -84,40 +82,40 @@ test trace-0.0 {memory corruption in trace (Tcl Bug 484339)} {
test trace-1.1 {trace variable reads} {
unset -nocomplain x
- set info ""
+ set info {}
trace add variable x read traceScalar
list [catch {set x} msg] $msg $info
} {1 {can't read "x": no such variable} {x {} read 1 {can't read "x": no such variable}}}
test trace-1.2 {trace variable reads} {
unset -nocomplain x
set x 123
- set info ""
+ set info {}
trace add variable x read traceScalar
list [catch {set x} msg] $msg $info
} {0 123 {x {} read 0 123}}
test trace-1.3 {trace variable reads} {
unset -nocomplain x
- set info ""
+ set info {}
trace add variable x read traceScalar
set x 123
set info
} {}
test trace-1.4 {trace array element reads} {
unset -nocomplain x
- set info ""
+ set info {}
trace add variable x(2) read traceArray
list [catch {set x(2)} msg] $msg $info
} {1 {can't read "x(2)": no such element in array} {x 2 read 1 {can't read "x(2)": no such element in array}}}
test trace-1.5 {trace array element reads} {
unset -nocomplain x
set x(2) zzz
- set info ""
+ set info {}
trace add variable x(2) read traceArray
list [catch {set x(2)} msg] $msg $info
} {0 zzz {x 2 read 0 zzz}}
test trace-1.6 {trace array element reads} {
unset -nocomplain x
- set info ""
+ set info {}
trace add variable x read traceArray2
proc p {} {
global x
@@ -128,7 +126,7 @@ test trace-1.6 {trace array element reads} {
} {0 willi {x 2 read}}
test trace-1.7 {trace array element reads, create element undefined if nonexistant} {
unset -nocomplain x
- set info ""
+ set info {}
trace add variable x read q
proc q {name1 name2 op} {
global info
@@ -145,21 +143,21 @@ test trace-1.7 {trace array element reads, create element undefined if nonexista
} {0 wolf {x Y read}}
test trace-1.8 {trace reads on whole arrays} {
unset -nocomplain x
- set info ""
+ set info {}
trace add variable x read traceArray
list [catch {set x(2)} msg] $msg $info
} {1 {can't read "x(2)": no such variable} {}}
test trace-1.9 {trace reads on whole arrays} {
unset -nocomplain x
set x(2) zzz
- set info ""
+ set info {}
trace add variable x read traceArray
list [catch {set x(2)} msg] $msg $info
} {0 zzz {x 2 read 0 zzz}}
test trace-1.10 {trace variable reads} {
unset -nocomplain x
set x 444
- set info ""
+ set info {}
trace add variable x read traceScalar
unset x
set info
@@ -197,21 +195,21 @@ test trace-1.14 {read traces that modify the array structure} {
test trace-2.1 {trace variable writes} {
unset -nocomplain x
- set info ""
+ set info {}
trace add variable x write traceScalar
set x 123
set info
} {x {} write 0 123}
test trace-2.2 {trace writes to array elements} {
unset -nocomplain x
- set info ""
+ set info {}
trace add variable x(33) write traceArray
set x(33) 444
set info
} {x 33 write 0 444}
test trace-2.3 {trace writes on whole arrays} {
unset -nocomplain x
- set info ""
+ set info {}
trace add variable x write traceArray
set x(abc) qq
set info
@@ -219,7 +217,7 @@ test trace-2.3 {trace writes on whole arrays} {
test trace-2.4 {trace variable writes} {
unset -nocomplain x
set x 1234
- set info ""
+ set info {}
trace add variable x write traceScalar
set x
set info
@@ -227,7 +225,7 @@ test trace-2.4 {trace variable writes} {
test trace-2.5 {trace variable writes} {
unset -nocomplain x
set x 1234
- set info ""
+ set info {}
trace add variable x write traceScalar
unset x
set info
@@ -239,7 +237,7 @@ test trace-2.6 {trace variable writes on compiled local} {
# already indirectly tested in trace-1.7
#
unset -nocomplain x
- set info ""
+ set info {}
proc p {} {
trace add variable x write traceArray
set x(X) willy
@@ -268,7 +266,7 @@ test trace-2.7 {trace variable writes on errorInfo} -body {
test trace-3.1 {trace variable read-modify-writes} {
unset -nocomplain x
- set info ""
+ set info {}
trace add variable x read traceScalarAppend
append x 123
append x 456
@@ -277,7 +275,7 @@ test trace-3.1 {trace variable read-modify-writes} {
} {x {} read 0 123456}
test trace-3.2 {trace variable read-modify-writes} {
unset -nocomplain x
- set info ""
+ set info {}
trace add variable x {read write} traceScalarAppend
append x 123
lappend x 456
@@ -288,7 +286,7 @@ test trace-3.2 {trace variable read-modify-writes} {
test trace-4.1 {trace variable unsets} {
unset -nocomplain x
- set info ""
+ set info {}
trace add variable x unset traceScalar
unset -nocomplain x
set info
@@ -296,14 +294,14 @@ test trace-4.1 {trace variable unsets} {
test trace-4.2 {variable mustn't exist during unset trace} {
unset -nocomplain x
set x 1234
- set info ""
+ set info {}
trace add variable x unset traceScalar
unset x
set info
} {x {} unset 1 {can't read "x": no such variable}}
test trace-4.3 {unset traces mustn't be called during reads and writes} {
unset -nocomplain x
- set info ""
+ set info {}
trace add variable x unset traceScalar
set x 44
set x
@@ -312,7 +310,7 @@ test trace-4.3 {unset traces mustn't be called during reads and writes} {
test trace-4.4 {trace unsets on array elements} {
unset -nocomplain x
set x(0) 18
- set info ""
+ set info {}
trace add variable x(1) unset traceArray
unset -nocomplain x(1)
set info
@@ -320,7 +318,7 @@ test trace-4.4 {trace unsets on array elements} {
test trace-4.5 {trace unsets on array elements} {
unset -nocomplain x
set x(1) 18
- set info ""
+ set info {}
trace add variable x(1) unset traceArray
unset x(1)
set info
@@ -328,7 +326,7 @@ test trace-4.5 {trace unsets on array elements} {
test trace-4.6 {trace unsets on array elements} {
unset -nocomplain x
set x(1) 18
- set info ""
+ set info {}
trace add variable x(1) unset traceArray
unset x
set info
@@ -336,7 +334,7 @@ test trace-4.6 {trace unsets on array elements} {
test trace-4.7 {trace unsets on whole arrays} {
unset -nocomplain x
set x(1) 18
- set info ""
+ set info {}
trace add variable x unset traceProc
unset -nocomplain x(0)
set info
@@ -346,7 +344,7 @@ test trace-4.8 {trace unsets on whole arrays} {
set x(1) 18
set x(2) 144
set x(3) 14
- set info ""
+ set info {}
trace add variable x unset traceProc
unset x(1)
set info
@@ -356,7 +354,7 @@ test trace-4.9 {trace unsets on whole arrays} {
set x(1) 18
set x(2) 144
set x(3) 14
- set info ""
+ set info {}
trace add variable x unset traceProc
unset x
set info
@@ -367,7 +365,7 @@ test trace-5.1 {array traces fire on accesses via [array]} {
unset -nocomplain x
set x(b) 2
trace add variable x array traceArray2
- set ::info ""
+ set ::info {}
array set x {a 1}
set ::info
} {x {} array}
@@ -375,7 +373,7 @@ test trace-5.2 {array traces do not fire on normal accesses} {
unset -nocomplain x
set x(b) 2
trace add variable x array traceArray2
- set ::info ""
+ set ::info {}
set x(a) 1
set x(b) $x(a)
set ::info
@@ -383,7 +381,7 @@ test trace-5.2 {array traces do not fire on normal accesses} {
test trace-5.3 {array traces do not outlive variable} {
unset -nocomplain x
trace add variable x array traceArray2
- set ::info ""
+ set ::info {}
set x(a) 1
unset x
array set x {a 1}
@@ -405,14 +403,14 @@ test trace-5.6 {array traces don't fire on scalar variables} {
unset -nocomplain x
set x foo
trace add variable x array traceArray2
- set ::info ""
+ set ::info {}
catch {array set x {a 1}}
set ::info
} {}
test trace-5.7 {array traces fire for undefined variables} {
unset -nocomplain x
trace add variable x array traceArray2
- set ::info ""
+ set ::info {}
array set x {a 1}
set ::info
} {x {} array}
@@ -426,7 +424,7 @@ test trace-5.8 {array traces fire for undefined variables} {
test trace-6.1 {multiple ops traced at once} {
unset -nocomplain x
- set info ""
+ set info {}
trace add variable x {read write unset} traceProc
catch {set x}
set x 22
@@ -437,7 +435,7 @@ test trace-6.1 {multiple ops traced at once} {
} {x {} read x {} write x {} read x {} write x {} unset}
test trace-6.2 {multiple ops traced on array element} {
unset -nocomplain x
- set info ""
+ set info {}
trace add variable x(0) {read write unset} traceProc
catch {set x(0)}
set x(0) 22
@@ -449,7 +447,7 @@ test trace-6.2 {multiple ops traced on array element} {
} {x 0 read x 0 write x 0 read x 0 write x 0 unset}
test trace-6.3 {multiple ops traced on whole array} {
unset -nocomplain x
- set info ""
+ set info {}
trace add variable x {read write unset} traceProc
catch {set x(0)}
set x(0) 22
@@ -464,7 +462,7 @@ test trace-6.3 {multiple ops traced on whole array} {
test trace-7.1 {order of invocation of traces} {
unset -nocomplain x
- set info ""
+ set info {}
trace add variable x read "traceTag 1"
trace add variable x read "traceTag 2"
trace add variable x read "traceTag 3"
@@ -476,7 +474,7 @@ test trace-7.1 {order of invocation of traces} {
test trace-7.2 {order of invocation of traces} {
unset -nocomplain x
set x(0) 44
- set info ""
+ set info {}
trace add variable x(0) read "traceTag 1"
trace add variable x(0) read "traceTag 2"
trace add variable x(0) read "traceTag 3"
@@ -486,7 +484,7 @@ test trace-7.2 {order of invocation of traces} {
test trace-7.3 {order of invocation of traces} {
unset -nocomplain x
set x(0) 44
- set info ""
+ set info {}
trace add variable x(0) read "traceTag 1"
trace add variable x read "traceTag A1"
trace add variable x(0) read "traceTag 2"
@@ -502,7 +500,7 @@ test trace-7.3 {order of invocation of traces} {
test trace-8.1 {error returns from traces} {
unset -nocomplain x
set x 123
- set info ""
+ set info {}
trace add variable x read "traceTag 1"
trace add variable x read traceError
list [catch {set x} msg] $msg $info
@@ -510,7 +508,7 @@ test trace-8.1 {error returns from traces} {
test trace-8.2 {error returns from traces} {
unset -nocomplain x
set x 123
- set info ""
+ set info {}
trace add variable x write "traceTag 1"
trace add variable x write traceError
list [catch {set x 44} msg] $msg $info
@@ -518,14 +516,14 @@ test trace-8.2 {error returns from traces} {
test trace-8.3 {error returns from traces} {
unset -nocomplain x
set x 123
- set info ""
+ set info {}
trace add variable x write traceError
list [catch {append x 44} msg] $msg $info
} {1 {can't set "x": trace returned error} {}}
test trace-8.4 {error returns from traces} {
unset -nocomplain x
set x 123
- set info ""
+ set info {}
trace add variable x unset "traceTag 1"
trace add variable x unset traceError
list [catch {unset x} msg] $msg $info
@@ -533,7 +531,7 @@ test trace-8.4 {error returns from traces} {
test trace-8.5 {error returns from traces} {
unset -nocomplain x
set x(0) 123
- set info ""
+ set info {}
trace add variable x(0) read "traceTag 1"
trace add variable x read "traceTag 2"
trace add variable x read traceError
@@ -565,7 +563,7 @@ test trace-8.8 {error returns from traces} {
# it should *never* fail.
#
# Adapted from Bug #219393 reported by Don Porter.
- catch {rename ::foo ""}
+ catch {rename ::foo {}}
proc foo {old args} {
trace remove variable ::x write [list foo $old]
trace add variable ::x write [list foo $::x]
@@ -587,31 +585,31 @@ test trace-8.8 {error returns from traces} {
test trace-9.1 {be sure variable is unset before trace is called} {
unset -nocomplain x
set x 33
- set info ""
- trace add variable x unset {traceCheck {uplevel set x}}
+ set info {}
+ trace add variable x unset {traceCheck {uplevel 1 set x}}
unset x
set info
} {1 {can't read "x": no such variable}}
test trace-9.2 {be sure variable is unset before trace is called} {
unset -nocomplain x
set x 33
- set info ""
- trace add variable x unset {traceCheck {uplevel set x 22}}
+ set info {}
+ trace add variable x unset {traceCheck {uplevel 1 set x 22}}
unset x
concat $info [list [catch {set x} msg] $msg]
} {0 22 0 22}
test trace-9.3 {be sure traces are cleared before unset trace called} {
unset -nocomplain x
set x 33
- set info ""
- trace add variable x unset {traceCheck {uplevel trace info variable x}}
+ set info {}
+ trace add variable x unset {traceCheck {uplevel 1 trace info variable x}}
unset x
set info
} {0 {}}
test trace-9.4 {set new trace during unset trace} {
unset -nocomplain x
set x 33
- set info ""
+ set info {}
trace add variable x unset {traceCheck {global x; trace add variable x unset traceProc}}
unset x
concat $info [trace info variable x]
@@ -620,23 +618,23 @@ test trace-9.4 {set new trace during unset trace} {
test trace-10.1 {make sure array elements are unset before traces are called} {
unset -nocomplain x
set x(0) 33
- set info ""
- trace add variable x(0) unset {traceCheck {uplevel set x(0)}}
+ set info {}
+ trace add variable x(0) unset {traceCheck {uplevel 1 set x(0)}}
unset x(0)
set info
} {1 {can't read "x(0)": no such element in array}}
test trace-10.2 {make sure array elements are unset before traces are called} {
unset -nocomplain x
set x(0) 33
- set info ""
- trace add variable x(0) unset {traceCheck {uplevel set x(0) zzz}}
+ set info {}
+ trace add variable x(0) unset {traceCheck {uplevel 1 set x(0) zzz}}
unset x(0)
concat $info [list [catch {set x(0)} msg] $msg]
} {0 zzz 0 zzz}
test trace-10.3 {array elements are unset before traces are called} {
unset -nocomplain x
set x(0) 33
- set info ""
+ set info {}
trace add variable x(0) unset {traceCheck {global x; trace info variable x(0)}}
unset x(0)
set info
@@ -644,8 +642,8 @@ test trace-10.3 {array elements are unset before traces are called} {
test trace-10.4 {set new array element trace during unset trace} {
unset -nocomplain x
set x(0) 33
- set info ""
- trace add variable x(0) unset {traceCheck {uplevel {trace add variable x(0) read {}}}}
+ set info {}
+ trace add variable x(0) unset {traceCheck {uplevel 1 {trace add variable x(0) read {}}}}
unset -nocomplain x(0)
concat $info [trace info variable x(0)]
} {0 {} {read {}}}
@@ -653,32 +651,32 @@ test trace-10.4 {set new array element trace during unset trace} {
test trace-11.1 {make sure arrays are unset before traces are called} {
unset -nocomplain x
set x(0) 33
- set info ""
- trace add variable x unset {traceCheck {uplevel set x(0)}}
+ set info {}
+ trace add variable x unset {traceCheck {uplevel 1 set x(0)}}
unset x
set info
} {1 {can't read "x(0)": no such variable}}
test trace-11.2 {make sure arrays are unset before traces are called} {
unset -nocomplain x
set x(y) 33
- set info ""
- trace add variable x unset {traceCheck {uplevel set x(y) 22}}
+ set info {}
+ trace add variable x unset {traceCheck {uplevel 1 set x(y) 22}}
unset x
concat $info [list [catch {set x(y)} msg] $msg]
} {0 22 0 22}
test trace-11.3 {make sure arrays are unset before traces are called} {
unset -nocomplain x
set x(y) 33
- set info ""
- trace add variable x unset {traceCheck {uplevel array exists x}}
+ set info {}
+ trace add variable x unset {traceCheck {uplevel 1 array exists x}}
unset x
set info
} {0 0}
test trace-11.4 {make sure arrays are unset before traces are called} {
unset -nocomplain x
set x(y) 33
- set info ""
- set cmd {traceCheck {uplevel {trace info variable x}}}
+ set info {}
+ set cmd {traceCheck {uplevel 1 {trace info variable x}}}
trace add variable x unset $cmd
unset x
set info
@@ -686,7 +684,7 @@ test trace-11.4 {make sure arrays are unset before traces are called} {
test trace-11.5 {set new array trace during unset trace} {
unset -nocomplain x
set x(y) 33
- set info ""
+ set info {}
trace add variable x unset {traceCheck {global x; trace add variable x read {}}}
unset x
concat $info [trace info variable x]
@@ -694,7 +692,7 @@ test trace-11.5 {set new array trace during unset trace} {
test trace-11.6 {create scalar during array unset trace} {
unset -nocomplain x
set x(y) 33
- set info ""
+ set info {}
trace add variable x unset {traceCheck {global x; set x 44}}
unset x
concat $info [list [catch {set x} msg] $msg]
@@ -704,39 +702,39 @@ test trace-11.6 {create scalar during array unset trace} {
test trace-12.1 {creating array when setting variable traces} {
unset -nocomplain x
- set info ""
+ set info {}
trace add variable x(0) write traceProc
list [catch {set x 22} msg] $msg
} {1 {can't set "x": variable is array}}
test trace-12.2 {creating array when setting variable traces} {
unset -nocomplain x
- set info ""
+ set info {}
trace add variable x(0) write traceProc
list [catch {set x(0)} msg] $msg
} {1 {can't read "x(0)": no such element in array}}
test trace-12.3 {creating array when setting variable traces} {
unset -nocomplain x
- set info ""
+ set info {}
trace add variable x(0) write traceProc
set x(0) 22
set info
} {x 0 write}
test trace-12.4 {creating variable when setting variable traces} {
unset -nocomplain x
- set info ""
+ set info {}
trace add variable x write traceProc
list [catch {set x} msg] $msg
} {1 {can't read "x": no such variable}}
test trace-12.5 {creating variable when setting variable traces} {
unset -nocomplain x
- set info ""
+ set info {}
trace add variable x write traceProc
set x 22
set info
} {x {} write}
test trace-12.6 {creating variable when setting variable traces} {
unset -nocomplain x
- set info ""
+ set info {}
trace add variable x write traceProc
set x(0) 22
set info
@@ -764,7 +762,7 @@ test trace-13.1 {delete one trace from another} {
}
unset -nocomplain x
set x 44
- set info ""
+ set info {}
trace add variable x read {traceTag 1}
trace add variable x read {traceTag 2}
trace add variable x read {traceTag 3}
@@ -896,7 +894,7 @@ foreach type {variable command execution} err $errs abbvlist $abbvs {
} [list 1 "bad operation list \"\": must be one or more of $err"]
}
}
-rename x ""
+rename x {}
test trace-14.7 {trace command, "trace variable" errors} {
list [catch {trace variable} msg] $msg
@@ -914,15 +912,16 @@ test trace-14.11 {trace command, "trace variable" errors} {
list [catch {trace variable x y z} msg] $msg
} [list 1 "bad operations \"y\": should be one or more of rwua"]
+
test trace-14.12 {trace command ("remove variable" option)} {
unset -nocomplain x
- set info ""
+ set info {}
trace add variable x write traceProc
trace remove variable x write traceProc
} {}
test trace-14.13 {trace command ("remove variable" option)} {
unset -nocomplain x
- set info ""
+ set info {}
trace add variable x write traceProc
trace remove variable x write traceProc
set x 12345
@@ -930,7 +929,7 @@ test trace-14.13 {trace command ("remove variable" option)} {
} {}
test trace-14.14 {trace command ("remove variable" option)} {
unset -nocomplain x
- set info ""
+ set info {}
trace add variable x write {traceTag 1}
trace add variable x write traceProc
trace add variable x write {traceTag 2}
@@ -945,7 +944,7 @@ test trace-14.14 {trace command ("remove variable" option)} {
} {2 x {} write 1 2 1 2}
test trace-14.15 {trace command ("remove variable" option)} {
unset -nocomplain x
- set info ""
+ set info {}
trace add variable x write {traceTag 1}
trace remove variable x write non_existent
set x 12345
@@ -983,7 +982,7 @@ test trace-14.20 {trace command ("info variable" option)} {
test trace-15.1 {long trace command} {
unset -nocomplain x
- set info ""
+ set info {}
trace add variable x write {traceTag {This is a very very long argument. It's \
designed to test out the facilities of TraceVarProc for dealing \
with such long arguments by malloc-ing space. One possibility \
@@ -1009,7 +1008,7 @@ test trace-15.2 {long trace command result to ignore} {
test trace-15.3 {special list-handling in trace commands} {
unset -nocomplain "x y z"
set "x y z(a\n\{)" 44
- set info ""
+ set info {}
trace add variable "x y z(a\n\{)" write traceProc
set "x y z(a\n\{)" 33
set info
@@ -1040,7 +1039,7 @@ proc traceAppend {string name1 name2 op} {
test trace-16.1 {unsets during read traces} {
unset -nocomplain y
set y 1234
- set info ""
+ set info {}
trace add variable y read {traceUnset y}
trace add variable y unset {traceAppend unset}
lappend info [catch {set y} msg] $msg
@@ -1048,49 +1047,49 @@ test trace-16.1 {unsets during read traces} {
test trace-16.2 {unsets during read traces} {
unset -nocomplain y
set y(0) 1234
- set info ""
+ set info {}
trace add variable y(0) read {traceUnset y(0)}
lappend info [catch {set y(0)} msg] $msg
} {0 {} 1 {can't read "x": no such variable} 1 {can't read "y(0)": no such element in array}}
test trace-16.3 {unsets during read traces} {
unset -nocomplain y
set y(0) 1234
- set info ""
+ set info {}
trace add variable y(0) read {traceUnset y}
lappend info [catch {set y(0)} msg] $msg
} {0 {} 1 {can't read "x": no such variable} 1 {can't read "y(0)": no such variable}}
test trace-16.4 {unsets during read traces} {
unset -nocomplain y
set y 1234
- set info ""
+ set info {}
trace add variable y read {traceReset y y}
lappend info [catch {set y} msg] $msg
} {0 {} 0 xyzzy 0 xyzzy}
test trace-16.5 {unsets during read traces} {
unset -nocomplain y
set y(0) 1234
- set info ""
+ set info {}
trace add variable y(0) read {traceReset y(0) y(0)}
lappend info [catch {set y(0)} msg] $msg
} {0 {} 0 xyzzy 0 xyzzy}
test trace-16.6 {unsets during read traces} {
unset -nocomplain y
set y(0) 1234
- set info ""
+ set info {}
trace add variable y(0) read {traceReset y y(0)}
lappend info [catch {set y(0)} msg] $msg [catch {set y(0)} msg] $msg
} {0 {} 1 {can't set "y": upvar refers to element in deleted array} 1 {can't read "y(0)": no such variable} 1 {can't read "y(0)": no such variable}}
test trace-16.7 {unsets during read traces} {
unset -nocomplain y
set y(0) 1234
- set info ""
+ set info {}
trace add variable y(0) read {traceReset2 y y(0)}
lappend info [catch {set y(0)} msg] $msg [catch {set y(0)} msg] $msg
} {0 {} 0 xyzzy 1 {can't read "y(0)": no such element in array} 0 xyzzy}
test trace-16.8 {unsets during write traces} {
unset -nocomplain y
set y 1234
- set info ""
+ set info {}
trace add variable y write {traceUnset y}
trace add variable y unset {traceAppend unset}
lappend info [catch {set y xxx} msg] $msg
@@ -1098,91 +1097,91 @@ test trace-16.8 {unsets during write traces} {
test trace-16.9 {unsets during write traces} {
unset -nocomplain y
set y(0) 1234
- set info ""
+ set info {}
trace add variable y(0) write {traceUnset y(0)}
lappend info [catch {set y(0) xxx} msg] $msg
} {0 {} 1 {can't read "x": no such variable} 0 {}}
test trace-16.10 {unsets during write traces} {
unset -nocomplain y
set y(0) 1234
- set info ""
+ set info {}
trace add variable y(0) write {traceUnset y}
lappend info [catch {set y(0) xxx} msg] $msg
} {0 {} 1 {can't read "x": no such variable} 0 {}}
test trace-16.11 {unsets during write traces} {
unset -nocomplain y
set y 1234
- set info ""
+ set info {}
trace add variable y write {traceReset y y}
lappend info [catch {set y xxx} msg] $msg
} {0 {} 0 xyzzy 0 xyzzy}
test trace-16.12 {unsets during write traces} {
unset -nocomplain y
set y(0) 1234
- set info ""
+ set info {}
trace add variable y(0) write {traceReset y(0) y(0)}
lappend info [catch {set y(0) xxx} msg] $msg
} {0 {} 0 xyzzy 0 xyzzy}
test trace-16.13 {unsets during write traces} {
unset -nocomplain y
set y(0) 1234
- set info ""
+ set info {}
trace add variable y(0) write {traceReset y y(0)}
lappend info [catch {set y(0) xxx} msg] $msg [catch {set y(0)} msg] $msg
} {0 {} 1 {can't set "y": upvar refers to element in deleted array} 0 {} 1 {can't read "y(0)": no such variable}}
test trace-16.14 {unsets during write traces} {
unset -nocomplain y
set y(0) 1234
- set info ""
+ set info {}
trace add variable y(0) write {traceReset2 y y(0)}
lappend info [catch {set y(0) xxx} msg] $msg [catch {set y(0)} msg] $msg
} {0 {} 0 xyzzy 0 {} 0 xyzzy}
test trace-16.15 {unsets during unset traces} {
unset -nocomplain y
set y 1234
- set info ""
+ set info {}
trace add variable y unset {traceUnset y}
lappend info [catch {unset y} msg] $msg [catch {set y} msg] $msg
} {1 {can't unset "x": no such variable} 1 {can't read "x": no such variable} 0 {} 1 {can't read "y": no such variable}}
test trace-16.16 {unsets during unset traces} {
unset -nocomplain y
set y(0) 1234
- set info ""
+ set info {}
trace add variable y(0) unset {traceUnset y(0)}
lappend info [catch {unset y(0)} msg] $msg [catch {set y(0)} msg] $msg
} {1 {can't unset "x": no such variable} 1 {can't read "x": no such variable} 0 {} 1 {can't read "y(0)": no such element in array}}
test trace-16.17 {unsets during unset traces} {
unset -nocomplain y
set y(0) 1234
- set info ""
+ set info {}
trace add variable y(0) unset {traceUnset y}
lappend info [catch {unset y(0)} msg] $msg [catch {set y(0)} msg] $msg
} {0 {} 1 {can't read "x": no such variable} 0 {} 1 {can't read "y(0)": no such variable}}
test trace-16.18 {unsets during unset traces} {
unset -nocomplain y
set y 1234
- set info ""
+ set info {}
trace add variable y unset {traceReset2 y y}
lappend info [catch {unset y} msg] $msg [catch {set y} msg] $msg
} {1 {can't unset "y": no such variable} 0 xyzzy 0 {} 0 xyzzy}
test trace-16.19 {unsets during unset traces} {
unset -nocomplain y
set y(0) 1234
- set info ""
+ set info {}
trace add variable y(0) unset {traceReset2 y(0) y(0)}
lappend info [catch {unset y(0)} msg] $msg [catch {set y(0)} msg] $msg
} {1 {can't unset "y(0)": no such element in array} 0 xyzzy 0 {} 0 xyzzy}
test trace-16.20 {unsets during unset traces} {
unset -nocomplain y
set y(0) 1234
- set info ""
+ set info {}
trace add variable y(0) unset {traceReset2 y y(0)}
lappend info [catch {unset y(0)} msg] $msg [catch {set y(0)} msg] $msg
} {0 {} 0 xyzzy 0 {} 0 xyzzy}
test trace-16.21 {unsets cancelling traces} {
unset -nocomplain y
set y 1234
- set info ""
+ set info {}
trace add variable y read {traceAppend first}
trace add variable y read {traceUnset y}
trace add variable y read {traceAppend third}
@@ -1192,7 +1191,7 @@ test trace-16.21 {unsets cancelling traces} {
test trace-16.22 {unsets cancelling traces} {
unset -nocomplain y
set y(0) 1234
- set info ""
+ set info {}
trace add variable y(0) read {traceAppend first}
trace add variable y(0) read {traceUnset y}
trace add variable y(0) read {traceAppend third}
@@ -1204,7 +1203,7 @@ test trace-16.22 {unsets cancelling traces} {
test trace-17.1 {trace doesn't prevent unset errors} {
unset -nocomplain x
- set info ""
+ set info {}
trace add variable x unset {traceProc}
list [catch {unset x} msg] $msg $info
} {1 {can't unset "x": no such variable} {x {} unset}}
@@ -1216,7 +1215,7 @@ test trace-17.2 {traced variables must survive procedure exits} {
} {{write traceProc}}
test trace-17.3 {traced variables must survive procedure exits} {
unset -nocomplain x
- set info ""
+ set info {}
proc p1 {} {global x; trace add variable x write traceProc}
p1
set x 44
@@ -1228,8 +1227,8 @@ test trace-17.3 {traced variables must survive procedure exits} {
test trace-18.1 {unset traces on procedure returns} {
proc p1 {x y} {set a 44; p2 14}
- proc p2 {z} {trace add variable z unset {traceCheck {lsort [uplevel {info vars}]}}}
- set info ""
+ proc p2 {z} {trace add variable z unset {traceCheck {lsort [uplevel 1 {info vars}]}}}
+ set info {}
p1 foo bar
set info
} {0 {a x y}}
@@ -1259,9 +1258,9 @@ test trace-18.4 {namespace delete / trace vdelete combo, Bug \#1338280} {
global info
append info [catch {set ::$vtraced}][llength [info vars ::ref::*]]
}
- set info ""
+ set info {}
namespace delete ::ref
- rename doTrace ""
+ rename doTrace {}
set info
} 1110
@@ -1279,16 +1278,17 @@ test trace-19.0.2 {trace add command (command existence in ns)} {
list [catch {trace add command nosuchns::nosuchname rename traceCommand} msg] $msg
} {1 {unknown command "nosuchns::nosuchname"}}
+
test trace-19.1 {trace add command (rename option)} {
proc foo {} {}
- catch {rename bar ""}
+ catch {rename bar {}}
trace add command foo rename traceCommand
rename foo bar
set info
} {::foo ::bar rename}
test trace-19.2 {traces stick with renamed commands} {
proc foo {} {}
- catch {rename bar ""}
+ catch {rename bar {}}
trace add command foo rename traceCommand
rename foo bar
rename bar foo
@@ -1301,14 +1301,14 @@ test trace-19.2.1 {trace add command rename trace exists} {
} {{rename traceCommand}}
test trace-19.3 {command rename traces don't fire on command deletion} {
proc foo {} {}
- set info ""
+ set info {}
trace add command foo rename traceCommand
- rename foo ""
+ rename foo {}
set info
} {}
test trace-19.4 {trace add command rename doesn't trace recreated commands} {
proc foo {} {}
- catch {rename bar ""}
+ catch {rename bar {}}
trace add command foo rename traceCommand
proc foo {} {}
rename foo bar
@@ -1341,17 +1341,17 @@ test trace-19.9 {trace add command rename back into namespace} {
set info
} {::tcbar ::tc::tcfoo rename}
test trace-19.10 {trace add command failed rename doesn't trigger trace} {
- set info ""
+ set info {}
proc foo {} {}
proc bar {} {}
trace add command foo {rename delete} traceCommand
catch {rename foo bar}
set info
} {}
-catch {rename foo ""}
-catch {rename bar ""}
+catch {rename foo {}}
+catch {rename bar {}}
test trace-19.11 {trace add command qualifies when renamed in namespace} {
- set info ""
+ set info {}
namespace eval tc {rename tcfoo tcbar}
set info
} {::tc::tcfoo ::tc::tcbar rename}
@@ -1365,7 +1365,7 @@ test trace-20.1 {trace add command (delete option)} {
set info
} {::foo {} delete}
test trace-20.2 {trace add command delete doesn't trace recreated commands} {
- set info ""
+ set info {}
proc foo {} {}
rename foo ""
set info
@@ -1386,28 +1386,28 @@ test trace-20.3.1 {trace add command delete trace info} {
trace info command foo
} {}
test trace-20.4 {trace add command rename followed by delete} {
- set infotemp ""
+ set infotemp {}
proc foo {} {}
trace add command foo {rename delete} traceCommand
rename foo bar
lappend infotemp $info
- rename bar ""
+ rename bar {}
lappend infotemp $info
set info $infotemp
unset infotemp
set info
} {{::foo ::bar rename} {::bar {} delete}}
-catch {rename foo ""}
-catch {rename bar ""}
+catch {rename foo {}}
+catch {rename bar {}}
test trace-20.5 {trace add command rename and delete} {
- set infotemp ""
- set info ""
+ set infotemp {}
+ set info {}
proc foo {} {}
trace add command foo {rename delete} traceCommand
rename foo bar
lappend infotemp $info
- rename bar ""
+ rename bar {}
lappend infotemp $info
set info $infotemp
unset infotemp
@@ -1420,12 +1420,12 @@ test trace-20.6 {trace add command rename and delete in subinterp} {
$tc eval [list proc $p [info args $p] [info body $p]]
}
$tc eval [list set infotemp {}]
- $tc eval [list set info ""]
+ $tc eval [list set info {}]
$tc eval [list proc foo {} {}]
$tc eval [list trace add command foo {rename delete} traceCommand]
$tc eval [list rename foo bar]
$tc eval {lappend infotemp $info}
- $tc eval [list rename bar ""]
+ $tc eval [list rename bar {}]
$tc eval {lappend infotemp $info}
$tc eval {set info $infotemp}
$tc eval [list unset infotemp]
@@ -1438,7 +1438,7 @@ test trace-20.6 {trace add command rename and delete in subinterp} {
# but interp deletion means there is no interp to evaluate
# the trace in.
test trace-20.7 {trace add command delete in subinterp while being deleted} {
- set info ""
+ set info {}
set tc [interp create]
interp alias $tc traceCommand {} traceCommand
$tc eval [list proc foo {} {}]
@@ -1459,54 +1459,54 @@ proc traceCmddelete {cmd old new op} {
rename $old ""
}
test trace-20.8 {trace delete while trace is active} {
- set info ""
+ set info {}
proc foo {} {}
- catch {rename bar ""}
+ catch {rename bar {}}
trace add command foo {rename delete} [list traceDelete foo]
rename foo bar
list [set info] [trace info command bar]
} {{::foo ::bar rename} {}}
test trace-20.9 {rename trace deletes command} {
- set info ""
+ set info {}
proc foo {} {}
- catch {rename bar ""}
- catch {rename someothername ""}
+ catch {rename bar {}}
+ catch {rename someothername {}}
trace add command foo rename [list traceCmddelete foo]
rename foo bar
list [info commands foo] [info commands bar] [info commands someothername]
} {{} {} {}}
test trace-20.10 {rename trace renames command} {
- set info ""
+ set info {}
proc foo {} {}
- catch {rename bar ""}
- catch {rename someothername ""}
+ catch {rename bar {}}
+ catch {rename someothername {}}
trace add command foo rename [list traceCmdrename foo]
rename foo bar
set info [list [info commands foo] [info commands bar] [info commands someothername]]
- rename someothername ""
+ rename someothername {}
set info
} {{} {} someothername}
test trace-20.11 {delete trace deletes command} {
- set info ""
+ set info {}
proc foo {} {}
- catch {rename bar ""}
- catch {rename someothername ""}
+ catch {rename bar {}}
+ catch {rename someothername {}}
trace add command foo delete [list traceCmddelete foo]
- rename foo ""
+ rename foo {}
list [info commands foo] [info commands bar] [info commands someothername]
} {{} {} {}}
test trace-20.12 {delete trace renames command} {
- set info ""
+ set info {}
proc foo {} {}
- catch {rename bar ""}
- catch {rename someothername ""}
+ catch {rename bar {}}
+ catch {rename someothername {}}
trace add command foo delete [list traceCmdrename foo]
rename foo bar
- rename bar ""
+ rename bar {}
# None of these should exist.
list [info commands foo] [info commands bar] [info commands someothername]
} {{} {} {}}
@@ -1514,37 +1514,38 @@ test trace-20.12 {delete trace renames command} {
test trace-20.13 {rename trace discards result [Bug 1355342]} {
proc foo {} {}
trace add command foo rename {set w Aha!;#}
- list [rename foo bar] [rename bar ""]
+ list [rename foo bar] [rename bar {}]
} {{} {}}
test trace-20.14 {rename trace discards error result [Bug 1355342]} {
proc foo {} {}
trace add command foo rename {error}
- list [rename foo bar] [rename bar ""]
+ list [rename foo bar] [rename bar {}]
} {{} {}}
test trace-20.15 {delete trace discards result [Bug 1355342]} {
proc foo {} {}
trace add command foo delete {set w Aha!;#}
- rename foo ""
+ rename foo {}
} {}
test trace-20.16 {delete trace discards error result [Bug 1355342]} {
proc foo {} {}
trace add command foo delete {error}
- rename foo ""
+ rename foo {}
} {}
+
proc foo {b} { set a $b }
+
# Delete arrays when done, so they can be re-used as scalars
# elsewhere.
-unset -nocomplain x
-unset -nocomplain y
+unset -nocomplain x y
# Delete procedures when done, so we don't clash with other tests
# (e.g. foobar will clash with 'unknown' tests).
-catch {rename foobar ""}
-catch {rename foo ""}
-catch {rename bar ""}
+catch {rename foobar {}}
+catch {rename foo {}}
+catch {rename bar {}}
proc foo {a} {
set b $a
@@ -1556,7 +1557,7 @@ proc traceExecute {args} {
}
test trace-21.1 {trace execution: enter} {
- set info ""
+ set info {}
trace add execution foo enter [list traceExecute foo]
foo 1
trace remove execution foo enter [list traceExecute foo]
@@ -1564,7 +1565,7 @@ test trace-21.1 {trace execution: enter} {
} {{foo {foo 1} enter}}
test trace-21.2 {trace exeuction: leave} {
- set info ""
+ set info {}
trace add execution foo leave [list traceExecute foo]
foo 2
trace remove execution foo leave [list traceExecute foo]
@@ -1572,7 +1573,7 @@ test trace-21.2 {trace exeuction: leave} {
} {{foo {foo 2} 0 2 leave}}
test trace-21.3 {trace exeuction: enter, leave} {
- set info ""
+ set info {}
trace add execution foo {enter leave} [list traceExecute foo]
foo 3
trace remove execution foo {enter leave} [list traceExecute foo]
@@ -1580,7 +1581,7 @@ test trace-21.3 {trace exeuction: enter, leave} {
} {{foo {foo 3} enter} {foo {foo 3} 0 3 leave}}
test trace-21.4 {trace execution: enter, leave, enterstep} {
- set info ""
+ set info {}
trace add execution foo {enter leave enterstep} [list traceExecute foo]
foo 3
trace remove execution foo {enter leave enterstep} [list traceExecute foo]
@@ -1588,7 +1589,7 @@ test trace-21.4 {trace execution: enter, leave, enterstep} {
} {{foo {foo 3} enter} {foo {set b 3} enterstep} {foo {foo 3} 0 3 leave}}
test trace-21.5 {trace execution: enter, leave, enterstep, leavestep} {
- set info ""
+ set info {}
trace add execution foo {enter leave enterstep leavestep} [list traceExecute foo]
foo 3
trace remove execution foo {enter leave enterstep leavestep} [list traceExecute foo]
@@ -1596,7 +1597,7 @@ test trace-21.5 {trace execution: enter, leave, enterstep, leavestep} {
} {{foo {foo 3} enter} {foo {set b 3} enterstep} {foo {set b 3} 0 3 leavestep} {foo {foo 3} 0 3 leave}}
test trace-21.6 {trace execution: enterstep, leavestep} {
- set info ""
+ set info {}
trace add execution foo {enterstep leavestep} [list traceExecute foo]
foo 3
trace remove execution foo {enterstep leavestep} [list traceExecute foo]
@@ -1604,7 +1605,7 @@ test trace-21.6 {trace execution: enterstep, leavestep} {
} {{foo {set b 3} enterstep} {foo {set b 3} 0 3 leavestep}}
test trace-21.7 {trace execution: enterstep} {
- set info ""
+ set info {}
trace add execution foo {enterstep} [list traceExecute foo]
foo 3
trace remove execution foo {enterstep} [list traceExecute foo]
@@ -1612,7 +1613,7 @@ test trace-21.7 {trace execution: enterstep} {
} {{foo {set b 3} enterstep}}
test trace-21.8 {trace execution: leavestep} {
- set info ""
+ set info {}
trace add execution foo {leavestep} [list traceExecute foo]
foo 3
trace remove execution foo {leavestep} [list traceExecute foo]
@@ -1660,22 +1661,22 @@ test trace-21.11 {trace execution and alias} -setup {
} -body {
lappend res [namespace eval ::a y]
trace add execution ::x enter {
- rename ::x ""
+ rename ::x {}
proc ::x {} {return ::}
#}
lappend res [namespace eval ::a y]
} -cleanup {
namespace delete a
- rename ::x ""
+ rename ::x {}
} -result {:: ::}
proc factorial {n} {
- if {$n != 1} { return [expr {$n * [factorial [expr {$n - 1}]]}] }
+ if {$n != 1} { return [expr {$n * [factorial [expr {$n -1 }]]}] }
return 1
}
test trace-22.1 {recursive(1) trace execution: enter} {
- set info ""
+ set info {}
trace add execution factorial {enter} [list traceExecute factorial]
factorial 1
trace remove execution factorial {enter} [list traceExecute factorial]
@@ -1683,7 +1684,7 @@ test trace-22.1 {recursive(1) trace execution: enter} {
} {{factorial {factorial 1} enter}}
test trace-22.2 {recursive(2) trace execution: enter} {
- set info ""
+ set info {}
trace add execution factorial {enter} [list traceExecute factorial]
factorial 2
trace remove execution factorial {enter} [list traceExecute factorial]
@@ -1691,7 +1692,7 @@ test trace-22.2 {recursive(2) trace execution: enter} {
} {{factorial {factorial 2} enter} {factorial {factorial 1} enter}}
test trace-22.3 {recursive(3) trace execution: enter} {
- set info ""
+ set info {}
trace add execution factorial {enter} [list traceExecute factorial]
factorial 3
trace remove execution factorial {enter} [list traceExecute factorial]
@@ -1699,78 +1700,78 @@ test trace-22.3 {recursive(3) trace execution: enter} {
} {{factorial {factorial 3} enter} {factorial {factorial 2} enter} {factorial {factorial 1} enter}}
test trace-23.1 {recursive(1) trace execution: enter, leave, enterstep, leavestep} {
- set info ""
+ set info {}
trace add execution factorial {enter leave enterstep leavestep} [list traceExecute]
factorial 1
trace remove execution factorial {enter leave enterstep leavestep} [list traceExecute]
join $info "\n"
} {{factorial 1} enter
-{if {$n != 1} { return [expr {$n * [factorial [expr {$n - 1}]]}] }} enterstep
-{if {$n != 1} { return [expr {$n * [factorial [expr {$n - 1}]]}] }} 0 {} leavestep
+{if {$n != 1} { return [expr {$n * [factorial [expr {$n -1 }]]}] }} enterstep
+{if {$n != 1} { return [expr {$n * [factorial [expr {$n -1 }]]}] }} 0 {} leavestep
{return 1} enterstep
{return 1} 2 1 leavestep
{factorial 1} 0 1 leave}
test trace-23.2 {recursive(2) trace execution: enter, leave, enterstep, leavestep} {
- set info ""
+ set info {}
trace add execution factorial {enter leave enterstep leavestep} [list traceExecute]
factorial 2
trace remove execution factorial {enter leave enterstep leavestep} [list traceExecute]
join $info "\n"
} {{factorial 2} enter
-{if {$n != 1} { return [expr {$n * [factorial [expr {$n - 1}]]}] }} enterstep
-{expr {$n * [factorial [expr {$n - 1}]]}} enterstep
-{expr {$n - 1}} enterstep
-{expr {$n - 1}} 0 1 leavestep
+{if {$n != 1} { return [expr {$n * [factorial [expr {$n -1 }]]}] }} enterstep
+{expr {$n * [factorial [expr {$n -1 }]]}} enterstep
+{expr {$n -1 }} enterstep
+{expr {$n -1 }} 0 1 leavestep
{factorial 1} enterstep
{factorial 1} enter
-{if {$n != 1} { return [expr {$n * [factorial [expr {$n - 1}]]}] }} enterstep
-{if {$n != 1} { return [expr {$n * [factorial [expr {$n - 1}]]}] }} 0 {} leavestep
+{if {$n != 1} { return [expr {$n * [factorial [expr {$n -1 }]]}] }} enterstep
+{if {$n != 1} { return [expr {$n * [factorial [expr {$n -1 }]]}] }} 0 {} leavestep
{return 1} enterstep
{return 1} 2 1 leavestep
{factorial 1} 0 1 leave
{factorial 1} 0 1 leavestep
-{expr {$n * [factorial [expr {$n - 1}]]}} 0 2 leavestep
+{expr {$n * [factorial [expr {$n -1 }]]}} 0 2 leavestep
{return 2} enterstep
{return 2} 2 2 leavestep
-{if {$n != 1} { return [expr {$n * [factorial [expr {$n - 1}]]}] }} 2 2 leavestep
+{if {$n != 1} { return [expr {$n * [factorial [expr {$n -1 }]]}] }} 2 2 leavestep
{factorial 2} 0 2 leave}
test trace-23.3 {recursive(3) trace execution: enter, leave, enterstep, leavestep} {
- set info ""
+ set info {}
trace add execution factorial {enter leave enterstep leavestep} [list traceExecute]
factorial 3
trace remove execution factorial {enter leave enterstep leavestep} [list traceExecute]
join $info "\n"
} {{factorial 3} enter
-{if {$n != 1} { return [expr {$n * [factorial [expr {$n - 1}]]}] }} enterstep
-{expr {$n * [factorial [expr {$n - 1}]]}} enterstep
-{expr {$n - 1}} enterstep
-{expr {$n - 1}} 0 2 leavestep
+{if {$n != 1} { return [expr {$n * [factorial [expr {$n -1 }]]}] }} enterstep
+{expr {$n * [factorial [expr {$n -1 }]]}} enterstep
+{expr {$n -1 }} enterstep
+{expr {$n -1 }} 0 2 leavestep
{factorial 2} enterstep
{factorial 2} enter
-{if {$n != 1} { return [expr {$n * [factorial [expr {$n - 1}]]}] }} enterstep
-{expr {$n * [factorial [expr {$n - 1}]]}} enterstep
-{expr {$n - 1}} enterstep
-{expr {$n - 1}} 0 1 leavestep
+{if {$n != 1} { return [expr {$n * [factorial [expr {$n -1 }]]}] }} enterstep
+{expr {$n * [factorial [expr {$n -1 }]]}} enterstep
+{expr {$n -1 }} enterstep
+{expr {$n -1 }} 0 1 leavestep
{factorial 1} enterstep
{factorial 1} enter
-{if {$n != 1} { return [expr {$n * [factorial [expr {$n - 1}]]}] }} enterstep
-{if {$n != 1} { return [expr {$n * [factorial [expr {$n - 1}]]}] }} 0 {} leavestep
+{if {$n != 1} { return [expr {$n * [factorial [expr {$n -1 }]]}] }} enterstep
+{if {$n != 1} { return [expr {$n * [factorial [expr {$n -1 }]]}] }} 0 {} leavestep
{return 1} enterstep
{return 1} 2 1 leavestep
{factorial 1} 0 1 leave
{factorial 1} 0 1 leavestep
-{expr {$n * [factorial [expr {$n - 1}]]}} 0 2 leavestep
+{expr {$n * [factorial [expr {$n -1 }]]}} 0 2 leavestep
{return 2} enterstep
{return 2} 2 2 leavestep
-{if {$n != 1} { return [expr {$n * [factorial [expr {$n - 1}]]}] }} 2 2 leavestep
+{if {$n != 1} { return [expr {$n * [factorial [expr {$n -1 }]]}] }} 2 2 leavestep
{factorial 2} 0 2 leave
{factorial 2} 0 2 leavestep
-{expr {$n * [factorial [expr {$n - 1}]]}} 0 6 leavestep
+{expr {$n * [factorial [expr {$n -1 }]]}} 0 6 leavestep
{return 6} enterstep
{return 6} 2 6 leavestep
-{if {$n != 1} { return [expr {$n * [factorial [expr {$n - 1}]]}] }} 2 6 leavestep
+{if {$n != 1} { return [expr {$n * [factorial [expr {$n -1 }]]}] }} 2 6 leavestep
{factorial 3} 0 6 leave}
proc traceDelete {cmd args} {
@@ -1780,42 +1781,42 @@ proc traceDelete {cmd args} {
}
test trace-24.1 {delete trace during enter trace} {
- set info ""
+ set info {}
trace add execution foo enter [list traceDelete foo]
foo 1
list $info [catch {trace info execution foo} res] $res
} {{{foo 1} enter} 0 {}}
test trace-24.2 {delete trace during leave trace} {
- set info ""
+ set info {}
trace add execution foo leave [list traceDelete foo]
foo 1
list $info [catch {trace info execution foo} res] $res
} {{{foo 1} 0 1 leave} 0 {}}
test trace-24.3 {delete trace during enter-leave trace} {
- set info ""
+ set info {}
trace add execution foo {enter leave} [list traceDelete foo]
foo 1
list $info [catch {trace info execution foo} res] $res
} {{{foo 1} enter} 0 {}}
test trace-24.4 {delete trace during all exec traces} {
- set info ""
+ set info {}
trace add execution foo {enter leave enterstep leavestep} [list traceDelete foo]
foo 1
list $info [catch {trace info execution foo} res] $res
} {{{foo 1} enter} 0 {}}
test trace-24.5 {delete trace during all exec traces except enter} {
- set info ""
+ set info {}
trace add execution foo {leave enterstep leavestep} [list traceDelete foo]
foo 1
list $info [catch {trace info execution foo} res] $res
} {{{set b 1} enterstep} 0 {}}
proc traceDelete {cmd args} {
- rename $cmd ""
+ rename $cmd {}
global info
set info $args
}
@@ -1825,7 +1826,7 @@ proc foo {a} {
}
test trace-25.1 {delete command during enter trace} {
- set info ""
+ set info {}
trace add execution foo enter [list traceDelete foo]
catch {foo 1} err
list $err $info [catch {trace info execution foo} res] $res
@@ -1836,7 +1837,7 @@ proc foo {a} {
}
test trace-25.2 {delete command during leave trace} {
- set info ""
+ set info {}
trace add execution foo leave [list traceDelete foo]
foo 1
list $info [catch {trace info execution foo} res] $res
@@ -1847,7 +1848,7 @@ proc foo {a} {
}
test trace-25.3 {delete command during enter then leave trace} {
- set info ""
+ set info {}
trace add execution foo enter [list traceDelete foo]
trace add execution foo leave [list traceDelete foo]
catch {foo 1} err
@@ -1865,7 +1866,7 @@ proc traceExecute2 {args} {
# This shows the peculiar consequences of having two traces
# at the same time: as well as tracing the procedure you want
test trace-25.4 {order dependencies of two enter traces} {
- set info ""
+ set info {}
trace add execution foo enter [list traceExecute traceExecute]
trace add execution foo enter [list traceExecute2 traceExecute2]
catch {foo 1} err
@@ -1878,7 +1879,7 @@ traceExecute {foo 1} enter
}
test trace-25.5 {order dependencies of two step traces} {
- set info ""
+ set info {}
trace add execution foo enterstep [list traceExecute traceExecute]
trace add execution foo enterstep [list traceExecute2 traceExecute2]
catch {foo 1} err
@@ -1902,7 +1903,7 @@ proc tracePostExecute2 {args} {
}
test trace-25.6 {order dependencies of two leave traces} {
- set info ""
+ set info {}
trace add execution foo leave [list tracePostExecute tracePostExecute]
trace add execution foo leave [list tracePostExecute2 tracePostExecute2]
catch {foo 1} err
@@ -1915,7 +1916,7 @@ tracePostExecute2 {foo 1} 0 leave
}
test trace-25.7 {order dependencies of two leavestep traces} {
- set info ""
+ set info {}
trace add execution foo leavestep [list tracePostExecute tracePostExecute]
trace add execution foo leavestep [list tracePostExecute2 tracePostExecute2]
catch {foo 1} err
@@ -1932,13 +1933,13 @@ proc foo {a} {
}
proc traceDelete {cmd args} {
- rename $cmd ""
+ rename $cmd {}
global info
set info $args
}
test trace-25.8 {delete command during enter leave and enter/leave-step traces} {
- set info ""
+ set info {}
trace add execution foo enter [list traceDelete foo]
trace add execution foo leave [list traceDelete foo]
trace add execution foo enterstep [list traceDelete foo]
@@ -1952,7 +1953,7 @@ proc foo {a} {
}
test trace-25.9 {delete command during enter leave and leavestep traces} {
- set info ""
+ set info {}
trace add execution foo enter [list traceDelete foo]
trace add execution foo leave [list traceDelete foo]
trace add execution foo leavestep [list traceDelete foo]
@@ -1965,7 +1966,7 @@ proc foo {a} {
}
test trace-25.10 {delete command during leave and leavestep traces} {
- set info ""
+ set info {}
trace add execution foo leave [list traceDelete foo]
trace add execution foo leavestep [list traceDelete foo]
catch {foo 1} err
@@ -1977,7 +1978,7 @@ proc foo {a} {
}
test trace-25.11 {delete command during enter and enterstep traces} {
- set info ""
+ set info {}
trace add execution foo enter [list traceDelete foo]
trace add execution foo enterstep [list traceDelete foo]
catch {foo 1} err
@@ -1988,7 +1989,7 @@ test trace-26.1 {trace targetCmd when invoked through an alias} {
proc foo {args} {
set b $args
}
- set info ""
+ set info {}
trace add execution foo enter [list traceExecute foo]
interp alias {} bar {} foo 1
bar 2
@@ -1999,7 +2000,7 @@ test trace-26.2 {trace targetCmd when invoked through an alias} {
proc foo {args} {
set b $args
}
- set info ""
+ set info {}
trace add execution foo enter [list traceExecute foo]
interp create child
interp alias child bar {} foo 1
@@ -2010,7 +2011,7 @@ test trace-26.2 {trace targetCmd when invoked through an alias} {
} {{foo {foo 1 2} enter}}
test trace-27.1 {memory leak in rename trace (604609)} {
- catch {rename bar ""}
+ catch {rename bar {}}
proc foo {} {error foo}
trace add command foo rename {rename foo "" ;#}
rename foo bar
@@ -2026,15 +2027,16 @@ test trace-27.3 {command trace info nonsense} {
list [catch {trace info command thisdoesntexist} res] $res
} {1 {unknown command "thisdoesntexist"}}
+
test trace-28.1 {enterstep and leavestep traces with update idletasks (615043)} {
- catch {rename foo ""}
+ catch {rename foo {}}
proc foo {} {
set a 1
update idletasks
set b 1
}
- set info ""
+ set info {}
trace add execution foo {enter enterstep leavestep leave} \
[list traceExecute foo]
update
@@ -2043,7 +2045,7 @@ test trace-28.1 {enterstep and leavestep traces with update idletasks (615043)}
trace remove execution foo {enter enterstep leavestep leave} \
[list traceExecute foo]
- rename foo ""
+ rename foo {}
unset -nocomplain a
join $info "\n"
} {foo foo enter
@@ -2058,7 +2060,7 @@ foo {set b 1} 0 1 leavestep
foo foo 0 1 leave}
test trace-28.2 {exec traces with 'error'} {
- set info ""
+ set info {}
set res {}
proc foo {} {
@@ -2106,7 +2108,7 @@ foo {if {[catch {bar}]} {
foo foo 0 error leave}}
test trace-28.3 {exec traces with 'return -code error'} {
- set info ""
+ set info {}
set res {}
proc foo {} {
@@ -2156,9 +2158,9 @@ foo foo 0 error leave}}
test trace-28.4 {exec traces in slave with 'return -code error'} {
interp create slave
interp alias slave traceExecute {} traceExecute
- set info ""
+ set info {}
set res [interp eval slave {
- set info ""
+ set info {}
set res {}
proc foo {} {
@@ -2209,7 +2211,7 @@ foo {if {[catch {bar}]} {
foo foo 0 error leave}}
test trace-28.5 {exec traces} {
- set info ""
+ set info {}
proc foo {args} { set a 1 }
trace add execution foo {enter enterstep leave leavestep} \
[list traceExecute foo]
@@ -2227,7 +2229,7 @@ foo {set a 1} 0 1 leavestep
foo {foo test-28.4} 0 1 leave}
test trace-28.6 {exec traces firing order} {
- set info ""
+ set info {}
proc enterStep {cmd op} {lappend ::info "enter $cmd/$op"}
proc leaveStep {cmd code result op} {lappend ::info "leave $cmd/$code/$result/$op"}
@@ -2238,7 +2240,7 @@ test trace-28.6 {exec traces firing order} {
trace add execution foo enterstep enterStep
trace add execution foo leavestep leaveStep
foo 42
- rename foo ""
+ rename foo {}
join $info \n
} {enter set b x=42/enterstep
leave set b x=42/0/x=42/leavestep
@@ -2246,7 +2248,7 @@ enter incr x/enterstep
leave incr x/0/43/leavestep}
test trace-28.7 {exec trace information} {
- set info ""
+ set info {}
proc foo x { incr x }
proc bar {args} {}
trace add execution foo {enter leave enterstep leavestep} bar
@@ -2287,8 +2289,8 @@ test trace-29.4 {Tcl_CreateTrace, check that tracing doesn't cause memory faults
}
testcmdtrace tracetest {tracedLoop 0}
} {{tracedLoop 0} {tracedLoop 0} {incr level} {incr level} tracer {tracer} {expr {$level==1 ? {1 2} : {}}} {expr {$level==1 ? {1 2} : {}}} {foreach tracer [expr {$level==1 ? {1 2} : {}}] {tracedLoop $level}} {foreach tracer {1 2} {tracedLoop $level}} {tracedLoop $level} {tracedLoop 1} {incr level} {incr level} tracer {tracer} {expr {$level==1 ? {1 2} : {}}} {expr {$level==1 ? {1 2} : {}}} {foreach tracer [expr {$level==1 ? {1 2} : {}}] {tracedLoop $level}} {foreach tracer {} {tracedLoop $level}} {tracedLoop $level} {tracedLoop 1} {incr level} {incr level} tracer {tracer} {expr {$level==1 ? {1 2} : {}}} {expr {$level==1 ? {1 2} : {}}} {foreach tracer [expr {$level==1 ? {1 2} : {}}] {tracedLoop $level}} {foreach tracer {} {tracedLoop $level}}}
-catch {rename tracer ""}
-catch {rename tracedLoop ""}
+catch {rename tracer {}}
+catch {rename tracedLoop {}}
test trace-29.5 {Tcl_CreateObjTrace, status return TCL_ERROR} {testcmdtrace} {
proc Error { args } { error "Shouldn't get here" }
@@ -2345,7 +2347,7 @@ test trace-31.1 {command and execution traces shared struct} {
set result [trace info command foo]
trace remove command foo delete foo
trace remove execution foo enter foo
- rename foo ""
+ rename foo {}
set result
} [list [list delete foo]]
test trace-31.2 {command and execution traces shared struct} {
@@ -2356,7 +2358,7 @@ test trace-31.2 {command and execution traces shared struct} {
set result [trace info execution foo]
trace remove command foo delete foo
trace remove execution foo enter foo
- rename foo ""
+ rename foo {}
set result
} [list [list enter foo]]
@@ -2368,7 +2370,7 @@ test trace-32.1 {
trace add command foo delete foo
trace add execution foo enter foo
set result [trace info command foo]
- rename foo ""
+ rename foo {}
set result
} [list [list delete foo]]
@@ -2466,11 +2468,11 @@ test trace-34.6 {Bug 1458266} -setup {
expr {($first eq $second) ? "ok" : "\n$first\nand\n\n$second\ndiffer"}
} -cleanup {
unset -nocomplain log first second
- rename dummy ""
- rename stepTraceHandler ""
- rename cmdTraceHandler ""
- rename isTracedInside_1 ""
- rename isTracedInside_2 ""
+ rename dummy {}
+ rename stepTraceHandler {}
+ rename cmdTraceHandler {}
+ rename isTracedInside_1 {}
+ rename isTracedInside_2 {}
} -result ok
test trace-35.1 {527164: Keep -errorinfo of traces} -setup {
@@ -2584,14 +2586,14 @@ test trace-39 {bug #3484621: tracing Bc'ed commands} -setup {
list $::traceCalls | {*}$res
} -cleanup {
unset ::traceLog ::traceCalls ::bar res
- rename dotrace ""
- rename foo ""
+ rename dotrace {}
+ rename foo {}
} -result {3 | 0 1 1}
test trace-39.1 {bug #3485022: tracing Bc'ed commands} -setup {
set ::traceLog 0
set ::traceCalls 0
- set res [list]
+ set res {}
proc dotrace args {
incr ::traceLog
}
@@ -2614,22 +2616,22 @@ test trace-39.1 {bug #3485022: tracing Bc'ed commands} -setup {
list $::traceCalls | {*}$res
} -cleanup {
unset ::traceLog ::traceCalls res
- rename dotrace ""
- rename foo ""
+ rename dotrace {}
+ rename foo {}
} -result {3 | 0 1 1}
# Delete procedures when done, so we don't clash with other tests
# (e.g. foobar will clash with 'unknown' tests).
-catch {rename foobar ""}
-catch {rename foo ""}
-catch {rename bar ""}
-catch {rename untraced ""}
-catch {rename traceproc ""}
-catch {rename runbase ""}
+catch {rename foobar {}}
+catch {rename foo {}}
+catch {rename bar {}}
+catch {rename untraced {}}
+catch {rename traceproc {}}
+catch {rename runbase {}}
# Unset the variable when done
unset -nocomplain info base
# cleanup
-::tcltest::cleanupTests
+cleanupTests
return
diff --git a/tests/unixInit.test b/tests/unixInit.test
index 23249a8..05338ed 100644
--- a/tests/unixInit.test
+++ b/tests/unixInit.test
@@ -11,7 +11,7 @@
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
package require tcltest 2.2
-namespace import -force ::tcltest::*
+namespace import ::tcltest::*
unset -nocomplain path
catch {set oldlang $env(LANG)}
set env(LANG) C
@@ -172,13 +172,13 @@ test unixInit-2.6 {TclpInitLibraryPath: executable relative} -setup {
makeDirectory tmp
makeDirectory [file join tmp sparkly]
makeDirectory [file join tmp sparkly bin]
- file copy [interpreter] [file join [::tcltest::temporaryDirectory] tmp sparkly \
+ file copy [interpreter] [file join [temporaryDirectory] tmp sparkly \
bin tcltest]
makeDirectory [file join tmp sparkly lib]
makeDirectory [file join tmp sparkly lib tcl[info tclversion]]
makeFile {} [file join tmp sparkly lib tcl[info tclversion] init.tcl]
} -body {
- lrange [getlibpath [file join [::tcltest::temporaryDirectory] tmp sparkly \
+ lrange [getlibpath [file join [temporaryDirectory] tmp sparkly \
bin tcltest]] 1 2
} -cleanup {
removeFile [file join tmp sparkly lib tcl[info tclversion] init.tcl]
@@ -192,14 +192,14 @@ test unixInit-2.6 {TclpInitLibraryPath: executable relative} -setup {
set env(TCL_LIBRARY) $oldlibrary
unset oldlibrary
}
-} -result [list [::tcltest::temporaryDirectory]/tmp/sparkly/lib/tcl[info tclversion] [::tcltest::temporaryDirectory]/tmp/lib/tcl[info tclversion]]
+} -result [list [temporaryDirectory]/tmp/sparkly/lib/tcl[info tclversion] [temporaryDirectory]/tmp/lib/tcl[info tclversion]]
test unixInit-2.7 {TclpInitLibraryPath: compiled-in library path} {
# would need test command to get defaultLibDir and compare it to
# [lindex $auto_path end]
} {}
#
# The following two tests write to the directory /tmp/sparkly instead of to
-# [::tcltest::temporaryDirectory]. This is because the failures tested by these tests
+# [temporaryDirectory]. This is because the failures tested by these tests
# need paths near the "root" of the file system to present themselves.
#
test unixInit-2.8 {TclpInitLibraryPath: all absolute pathtype} -setup {
@@ -321,8 +321,8 @@ test unixInit-2.10 {TclpInitLibraryPath: executable relative} -setup {
set env(TCL_LIBRARY) $oldlibrary
unset oldlibrary
}
-} -result [list [file join [::tcltest::temporaryDirectory] tmp sparkly library] \
- [file join [::tcltest::temporaryDirectory] tmp library] ]
+} -result [list [file join [temporaryDirectory] tmp sparkly library] \
+ [file join [temporaryDirectory] tmp library] ]
test unixInit-3.1 {TclpSetInitialEncodings} -constraints {
unix stdio
diff --git a/tests/unknown.test b/tests/unknown.test
index 6f9dcb0..e80d3a6 100644
--- a/tests/unknown.test
+++ b/tests/unknown.test
@@ -11,10 +11,8 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {"::tcltest" ni [namespace children]} {
- package require tcltest
- namespace import -force ::tcltest::*
-}
+package require tcltest 2
+namespace import ::tcltest::*
unset -nocomplain x
catch {rename unknown unknown.old}
@@ -49,7 +47,7 @@ test unknown-3.1 {argument quoting in calls to "unknown"} {
set x
} "foobar \\{ \\} a\\{b {;} \\\\ {\$a} {a\[b} \\]"
-proc unknown {args} {
+proc unknown args {
error "unknown failed"
}
test unknown-4.1 {errors in "unknown" procedure} {
@@ -57,9 +55,9 @@ test unknown-4.1 {errors in "unknown" procedure} {
} {1 {unknown failed} NONE}
# cleanup
-catch {rename unknown ""}
+catch {rename unknown {}}
catch {rename unknown.old unknown}
-::tcltest::cleanupTests
+cleanupTests
return
# Local Variables:
generated by cgit v0.12 at 2024-11-17 14:52:40 (GMT)