summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-rw-r--r--tests/assocd.test8
-rw-r--r--tests/basic.test18
-rw-r--r--tests/cmdInfo.test8
-rw-r--r--tests/dcall.test8
-rw-r--r--tests/expr-old.test14
-rw-r--r--tests/main.test26
-rw-r--r--tests/msgcat.test12
-rw-r--r--tests/parse.test27
-rw-r--r--tests/parseExpr.test8
-rw-r--r--tests/parseOld.test22
-rw-r--r--tests/pkgMkIndex.test16
-rw-r--r--tests/platform.test17
-rw-r--r--tests/result.test6
-rw-r--r--tests/stack.test6
-rwxr-xr-xtests/tcltest.test17
-rw-r--r--tests/thread.test22
-rw-r--r--tests/tm.test2
-rw-r--r--tests/trace.test295
-rw-r--r--tests/unixInit.test16
-rw-r--r--tests/unknown.test10
20 files changed, 256 insertions, 302 deletions
diff --git a/tests/assocd.test b/tests/assocd.test
index d1489b3..b543c64 100644
--- a/tests/assocd.test
+++ b/tests/assocd.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 {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
- namespace import -force ::tcltest::*
-}
+package require tcltest 2
+namespace import ::tcltest::*
::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
@@ -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 7435571..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]]
@@ -31,7 +31,7 @@ catch {interp delete test_interp}
catch {rename p ""}
catch {rename q ""}
catch {rename cmd ""}
-catch {unset x}
+unset -nocomplain x
test basic-1.1 {Tcl_CreateInterp, creates interp's global namespace} {
catch {interp delete test_interp}
@@ -302,7 +302,7 @@ test basic-20.1 {Tcl_GetCommandInfo, names for commands created inside namespace
catch {namespace delete {*}[namespace children :: test_ns_*]}
catch {rename p ""}
catch {rename q ""}
- catch {unset x}
+ unset -nocomplain x
set x [namespace eval test_ns_basic::test_ns_basic2 {
# the following creates a cmd in the global namespace
testcmdtoken create p
@@ -355,7 +355,7 @@ test basic-23.1 {Tcl_DeleteCommand} {emptyTest} {
test basic-24.1 {Tcl_DeleteCommandFromToken, invalidate all compiled code if cmd has compile proc} {
catch {interp delete test_interp}
- catch {unset x}
+ unset -nocomplain x
interp create test_interp
interp eval test_interp {
proc useSet {} {
@@ -427,7 +427,7 @@ test basic-26.1 {Tcl_EvalObj: preserve object while evaling it} -setup {
# string would have been freed, leaving garbage bytes for the error
# message.
set f [open $fName w]
- fileevent $f writable "fileevent $f writable {}; error foo"
+ chan event $f writable "chan event $f writable {}; error foo"
set x {}
vwait x
close $f
@@ -547,8 +547,8 @@ test basic-46.1 {Tcl_AllowExceptions: exception return not allowed} {stdio} {
catch {close $f}
set res [catch {
set f [open |[list [interpreter]] w+]
- fconfigure $f -buffering line
- puts $f {fconfigure stdout -buffering line}
+ chan configure $f -buffering line
+ puts $f {chan configure stdout -buffering line}
puts $f continue
puts $f {puts $::errorInfo}
puts $f {puts DONE}
@@ -972,6 +972,6 @@ catch {rename p ""}
catch {rename q ""}
catch {rename cmd ""}
catch {rename value:at: ""}
-catch {unset x}
-::tcltest::cleanupTests
+unset -nocomplain x
+cleanupTests
return
diff --git a/tests/cmdInfo.test b/tests/cmdInfo.test
index 69d7171..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 {[lsearch [namespace children] ::tcltest] == -1} {
- 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]]
@@ -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 3df0ac8..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 {[lsearch [namespace children] ::tcltest] == -1} {
- 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/expr-old.test b/tests/expr-old.test
index ed0f11f..7d6e6f8 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 {[lsearch [namespace children] ::tcltest] == -1} {
- 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]]
@@ -139,7 +137,7 @@ test expr-old-1.50 {integer operators} {expr +36} 36
test expr-old-1.51 {integer operators} {expr +--++36} 36
test expr-old-1.52 {integer operators} {expr +36%+5} 1
test expr-old-1.53 {integer operators} {
- catch {unset x}
+ unset -nocomplain x
set x yes
list [expr {1 && $x}] [expr {$x && 1}] \
[expr {0 || $x}] [expr {$x || 0}]
@@ -447,7 +445,7 @@ test expr-old-23.3 {double quotes} {
test expr-old-23.4 {double quotes} {expr {"11\}\}22"}} 11}}22
test expr-old-23.5 {double quotes} {expr {"\*bc"}} {*bc}
test expr-old-23.6 {double quotes} {
- catch {unset bogus__}
+ unset -nocomplain bogus__
list [catch {expr {"$bogus__"}} msg] $msg
} {1 {can't read "bogus__": no such variable}}
test expr-old-23.7 {double quotes} {
@@ -496,7 +494,7 @@ test expr-old-26.2 {error conditions} -body {
test expr-old-26.3 {error conditions} -body {
expr 2+4*(
} -returnCodes error -match glob -result *
-catch {unset _non_existent_}
+unset -nocomplain _non_existent_
test expr-old-26.4 {error conditions} {
list [catch {expr 2+$_non_existent_} msg] $msg
} {1 {can't read "_non_existent_": no such variable}}
@@ -575,7 +573,7 @@ test expr-old-27.4 {cancelled evaluation} {
expr {1?2:[set a 2]}
set a
} 1
-catch {unset x}
+unset -nocomplain x
test expr-old-27.5 {cancelled evaluation} {
list [catch {expr {[info exists x] && $x}} msg] $msg
} {0 0}
diff --git a/tests/main.test b/tests/main.test
index 7fd9d73..c22d83b 100644
--- a/tests/main.test
+++ b/tests/main.test
@@ -129,7 +129,7 @@ namespace eval ::tcl::test::main {
set script [makeFile {} script]
file delete $script
set f [open $script w]
- fconfigure $f -encoding utf-8
+ chan configure $f -encoding utf-8
puts $f {puts [list $argv0 $argv $tcl_interactive]}
puts -nonewline $f {puts [string equal \u20ac }
puts $f "\u20ac]"
@@ -150,7 +150,7 @@ namespace eval ::tcl::test::main {
set script [makeFile {} script]
file delete $script
set f [open $script w]
- fconfigure $f -encoding utf-8
+ chan configure $f -encoding utf-8
puts $f {puts [list $argv0 $argv $tcl_interactive]}
puts -nonewline $f {puts [string equal \u20ac }
puts $f "\u20ac]"
@@ -171,7 +171,7 @@ namespace eval ::tcl::test::main {
set script [makeFile {} script]
file delete $script
set f [open $script w]
- fconfigure $f -encoding utf-8
+ chan configure $f -encoding utf-8
puts $f {puts [list $argv0 $argv $tcl_interactive]}
puts -nonewline $f {puts [string equal \u20ac }
puts $f "\u20ac]"
@@ -592,7 +592,7 @@ namespace eval ::tcl::test::main {
catch {set f [open "|[list [interpreter]]" w+]}
} -body {
type $f {
- fconfigure stdin -blocking 0
+ chan configure stdin -blocking 0
puts SUCCESS
}
list [catch {gets $f} line] $line
@@ -606,19 +606,19 @@ namespace eval ::tcl::test::main {
exec
} -setup {
catch {set f [open "|[list [interpreter]]" w+]}
- catch {fconfigure $f -blocking 0}
+ catch {chan configure $f -blocking 0}
} -body {
- type $f "fconfigure stdin -eofchar \\032
+ type $f "chan configure stdin -eofchar \\032
if 1 \{\n\032"
variable wait
- fileevent $f readable \
+ chan event $f readable \
[list set [namespace which -variable wait] "child exit"]
set id [after 2000 [list set [namespace which -variable wait] timeout]]
vwait [namespace which -variable wait]
after cancel $id
set wait
} -cleanup {
- if {[string equal timeout $wait] && [testConstraint unix]} {
+ if {$wait eq "timeout" && [testConstraint unix]} {
exec kill [pid $f]
}
close $f
@@ -631,17 +631,17 @@ namespace eval ::tcl::test::main {
} -setup {
set cmd {makeFile "if 1 \{" script}
catch {set f [open "|[list [interpreter]] < [list [eval $cmd]]" r]}
- catch {fconfigure $f -blocking 0}
+ catch {chan configure $f -blocking 0}
} -body {
variable wait
- fileevent $f readable \
+ chan event $f readable \
[list set [namespace which -variable wait] "child exit"]
set id [after 2000 [list set [namespace which -variable wait] timeout]]
vwait [namespace which -variable wait]
after cancel $id
set wait
} -cleanup {
- if {[string equal timeout $wait] && [testConstraint unix]} {
+ if {$wait eq "timeout" && [testConstraint unix]} {
exec kill [pid $f]
}
close $f
@@ -748,7 +748,7 @@ namespace eval ::tcl::test::main {
exec Tcltest
} -setup {
catch {set f [open "|[list [interpreter]]" w+]}
- catch {fconfigure $f -blocking 0}
+ catch {chan configure $f -blocking 0}
} -body {
type $f "testsetmainloop
after 2000 testexitmainloop
@@ -983,7 +983,7 @@ namespace eval ::tcl::test::main {
} -body {
exec [interpreter] << {
testsetmainloop
- fconfigure stdin -blocking 0
+ chan configure stdin -blocking 0
testexitmainloop
} >& result
set f [open result]
diff --git a/tests/msgcat.test b/tests/msgcat.test
index 9fb565b..a065a5c 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,7 +56,7 @@ namespace eval ::msgcat::test {
set result [string tolower \
[msgcat::ConvertLocale $::tcl::mac::locale]]
} else {
- if {([info sharedlibextension] == ".dll")
+ 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
@@ -72,7 +72,7 @@ namespace eval ::msgcat::test {
variable var
foreach var $envVars {
catch {variable $var $::env($var)}
- catch {unset ::env($var)}
+ unset -nocomplain ::env($var)
}
foreach var $setVars {
set ::env($var) $var
@@ -84,13 +84,13 @@ namespace eval ::msgcat::test {
} -cleanup {
interp delete [namespace current]::i
foreach var $envVars {
- catch {unset ::env($var)}
+ unset -nocomplain ::env($var)
catch {set ::env($var) [set [namespace current]::$var]}
}
} -body {i eval msgcat::mclocale} -result $result
incr count
}
- catch {unset result}
+ unset -nocomplain result
# Could add tests of initialization from Windows registry here.
# Use a fake registry package.
@@ -324,7 +324,7 @@ namespace eval ::msgcat::test {
incr count
}
}
- catch {unset result}
+ unset -nocomplain result
# Tests msgcat-4.*: [mcunknown]
diff --git a/tests/parse.test b/tests/parse.test
index bc4107d..b9cfe80 100644
--- a/tests/parse.test
+++ b/tests/parse.test
@@ -439,7 +439,7 @@ test parse-8.12 {Tcl_EvalObjv procedure, TCL_EVAL_INVOKE} {
test parse-9.1 {Tcl_LogCommandInfo, line numbers} testevalex {
- catch {unset x}
+ unset -nocomplain x
list [catch {testevalex {for {} 1 {} {
@@ -480,7 +480,7 @@ test parse-10.3 {Tcl_EvalTokens, nested commands} testevalex {
testevalex {concat [expr 2 + 6]}
} {8}
test parse-10.4 {Tcl_EvalTokens, nested commands} testevalex {
- catch {unset a}
+ unset -nocomplain a
list [catch {testevalex {concat xxx[expr $a]}} msg] $msg
} {1 {can't read "a": no such variable}}
test parse-10.5 {Tcl_EvalTokens, simple variables} testevalex {
@@ -488,21 +488,21 @@ test parse-10.5 {Tcl_EvalTokens, simple variables} testevalex {
testevalex {concat $a}
} {hello}
test parse-10.6 {Tcl_EvalTokens, array variables} testevalex {
- catch {unset a}
+ unset -nocomplain a
set a(12) 46
testevalex {concat $a(12)}
} {46}
test parse-10.7 {Tcl_EvalTokens, array variables} testevalex {
- catch {unset a}
+ unset -nocomplain a
set a(12) 46
testevalex {concat $a(1[expr 3 - 1])}
} {46}
test parse-10.8 {Tcl_EvalTokens, array variables} testevalex {
- catch {unset a}
+ unset -nocomplain a
list [catch {testevalex {concat $x($a)}} msg] $msg
} {1 {can't read "a": no such variable}}
test parse-10.9 {Tcl_EvalTokens, array variables} testevalex {
- catch {unset a}
+ unset -nocomplain a
list [catch {testevalex {concat xyz$a(1)}} msg] $msg
} {1 {can't read "a(1)": no such variable}}
test parse-10.10 {Tcl_EvalTokens, object values} testevalex {
@@ -542,11 +542,11 @@ test parse-11.2 {Tcl_EvalEx, error while parsing} testevalex {
list [catch {testevalex {concat "abc}} msg] $msg
} {1 {missing "}}
test parse-11.3 {Tcl_EvalEx, error while collecting words} testevalex {
- catch {unset a}
+ unset -nocomplain a
list [catch {testevalex {concat xyz $a}} msg] $msg
} {1 {can't read "a": no such variable}}
test parse-11.4 {Tcl_EvalEx, error in Tcl_EvalObjv call} testevalex {
- catch {unset a}
+ unset -nocomplain a
list [catch {testevalex {_bogus_ a b c d}} msg] $msg
} {1 {invalid command name "_bogus_"}}
test parse-11.5 {Tcl_EvalEx, exceptional return} testevalex {
@@ -565,7 +565,7 @@ test parse-11.8 {Tcl_EvalEx, multiple commands in script} testevalex {
}] $a $c
} {d b d}
test parse-11.9 {Tcl_EvalEx, freeing memory after error} testevalex {
- catch {unset a}
+ unset -nocomplain a
list [catch {testevalex {concat a b c d e f g h i j k l m n o p q r s t u v w x y z $a}} msg] $msg
} {1 {can't read "a": no such variable}}
test parse-11.10 {Tcl_EvalTokens, empty commands} testevalex {
@@ -671,11 +671,11 @@ test parse-13.3 {Tcl_ParseVar procedure, no variable name} testparsevar {
testparsevar {$.123}
} {{$} .123}
test parse-13.4 {Tcl_ParseVar procedure, error looking up variable} testparsevar {
- catch {unset abc}
+ unset -nocomplain abc
list [catch {testparsevar {$abc}} msg] $msg
} {1 {can't read "abc": no such variable}}
test parse-13.5 {Tcl_ParseVar procedure, error looking up variable} testparsevar {
- catch {unset abc}
+ unset -nocomplain abc
list [catch {testparsevar {$abc([bogus x y z])}} msg] $msg
} {1 {invalid command name "bogus"}}
@@ -1092,13 +1092,12 @@ test parse-20.12 {TclParseBackslash: truncated escape} testparser {
} {- {\x12X} 1 word {\x12X} 2 backslash {\x12} 0 text X 0 {}}
test parse-21.0 {Bug 1884496} testevent {
- set ::script {set a [p]; return -level 0 $a}
+ set ::script {testevent delete a; set a [p]; set ::done $a}
proc ::p {} {string first s $::script}
testevent queue a head $::script
- update
+ vwait done
} {}
-
cleanupTests
}
diff --git a/tests/parseExpr.test b/tests/parseExpr.test
index d667bf2..9e2af18 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 {[lsearch [namespace children] ::tcltest] == -1} {
- 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]]
@@ -1066,5 +1064,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 0edcbf0..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 {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
- namespace import -force ::tcltest::*
-}
+package require tcltest
+namespace import ::tcltest::*
::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
@@ -166,25 +164,25 @@ test parseOld-5.6 {variable substitution} {
set msg
} {can't read "_non_existent_": no such variable}
test parseOld-5.7 {array variable substitution} {
- catch {unset a}
+ unset -nocomplain a
set a(xyz) 123
set b $a(xyz)foo
set b
} 123foo
test parseOld-5.8 {array variable substitution} {
- catch {unset a}
+ unset -nocomplain a
set "a(x y z)" 123
set b $a(x y z)foo
set b
} 123foo
test parseOld-5.9 {array variable substitution} {
- catch {unset a}; catch {unset qqq}
+ unset -nocomplain a qqq
set "a(x y z)" qqq
set $a([format x]\ y [format z]) foo
set qqq
} foo
test parseOld-5.10 {array variable substitution} {
- catch {unset a}
+ unset -nocomplain a
list [catch {set b $a(22)} msg] $msg
} {1 {can't read "a(22)": no such variable}}
test parseOld-5.11 {array variable substitution} {
@@ -194,9 +192,9 @@ test parseOld-5.11 {array variable substitution} {
test parseOld-5.12 {empty array name support} {
list [catch {set b a$()} msg] $msg
} {1 {can't read "()": no such variable}}
-catch {unset a}
+unset -nocomplain a
test parseOld-5.13 {array variable substitution} {
- catch {unset a}
+ unset -nocomplain a
set long {This is a very long variable, long enough to cause storage \
allocation to occur in Tcl_ParseVar. If that storage isn't getting \
freed up correctly, then a core leak will occur when this test is \
@@ -211,13 +209,13 @@ test parseOld-5.13 {array variable substitution} {
run. This text is probably beginning to sound like drivel, but I've \
run out of things to say and I need more characters still.}}}
test parseOld-5.14 {array variable substitution} {
- catch {unset a}; catch {unset b}; catch {unset a1}
+ unset -nocomplain a b a1
set a1(22) foo
set a(foo) bar
set b $a($a1(22))
set b
} bar
-catch {unset a}; catch {unset a1}
+unset -nocomplain a a1
test parseOld-7.1 {backslash substitution} {
set a "\a\c\n\]\}"
diff --git a/tests/pkgMkIndex.test b/tests/pkgMkIndex.test
index 0fe394e..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 {[lsearch [namespace children] ::tcltest] == -1} {
- 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 {[string compare -load $a] == 0} {
+ if {$a eq "-load"} {
incr iarg
lappend options [lindex $args $iarg]
}
@@ -81,7 +79,7 @@ proc pkgtest::parseIndex { filePath } {
$slave eval {
rename package package_original
proc package { args } {
- if {[string compare [lindex $args 0] ifneeded] == 0} {
+ if {[lindex $args 0] eq "ifneeded"} {
set pkg [lindex $args 1]
set ver [lindex $args 2]
set ::PKGS($pkg:$ver) [lindex $args 3]
@@ -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}
diff --git a/tests/platform.test b/tests/platform.test
index aab7c78..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 {[lsearch [namespace children] ::tcltest] == -1} {
- 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 3391ce1..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 {[lsearch [namespace children] ::tcltest] == -1} {
- 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 873cb08..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 {[lsearch [namespace children] ::tcltest] == -1} {
- 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 86aca6f..ce8d617 100755
--- a/tests/tcltest.test
+++ b/tests/tcltest.test
@@ -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]
@@ -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
}
@@ -716,8 +711,8 @@ test tcltest-8.60 {::workingDirectory} {
# clean up from directory testing
-switch $::tcl_platform(platform) {
- "unix" {
+switch -- $::tcl_platform(platform) {
+ unix {
file attributes $notReadableDir -permissions 777
file attributes $notWriteableDir -permissions 777
}
@@ -727,7 +722,7 @@ switch $::tcl_platform(platform) {
}
}
-file delete -force $notReadableDir $notWriteableDir
+file delete -force -- $notReadableDir $notWriteableDir
removeFile a.tcl
removeFile thisdirectoryisafile
removeDirectory normaldirectory
@@ -1150,7 +1145,7 @@ test tcltest-19.1 {TCLTEST_OPTIONS default} -setup {
} -cleanup {
interp delete slave2
interp delete slave1
- if {$oldoptions == "none"} {
+ if {$oldoptions eq "none"} {
unset ::env(TCLTEST_OPTIONS)
} else {
set ::env(TCLTEST_OPTIONS) $oldoptions
diff --git a/tests/thread.test b/tests/thread.test
index d79f693..f32ef61 100644
--- a/tests/thread.test
+++ b/tests/thread.test
@@ -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
diff --git a/tests/tm.test b/tests/tm.test
index 42352e9..280b058 100644
--- a/tests/tm.test
+++ b/tests/tm.test
@@ -200,7 +200,7 @@ test tm-3.11 {tm: module path management, remove ignores unknown path} -setup {
proc genpaths {base} {
# Normalizing picks up drive letters on windows [Bug 1053568]
set base [file normalize $base]
- foreach {major minor} [split [info tclversion] .] break
+ lassign [split [package present Tcl] .] major minor
set results {}
set base8 [file join $base tcl8]
lappend results [file join $base8 site-tcl]
diff --git a/tests/trace.test b/tests/trace.test
index 0f48dcf..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 {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
- namespace import -force ::tcltest::*
-}
+package require tcltest
+namespace import ::tcltest::*
::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
@@ -32,15 +30,15 @@ proc getbytes {} {
proc traceScalar {name1 name2 op} {
global info
- set info [list $name1 $name2 $op [catch {uplevel set $name1} msg] $msg]
+ set info [list $name1 $name2 $op [catch {uplevel 1 set $name1} msg] $msg]
}
proc traceScalarAppend {name1 name2 op} {
global info
- lappend info $name1 $name2 $op [catch {uplevel set $name1} msg] $msg
+ lappend info $name1 $name2 $op [catch {uplevel 1 set $name1} msg] $msg
}
proc traceArray {name1 name2 op} {
global info
- set info [list $name1 $name2 $op [catch {uplevel set [set name1]($name2)} msg] $msg]
+ set info [list $name1 $name2 $op [catch {uplevel 1 set [set name1]($name2)} msg] $msg]
}
proc traceArray2 {name1 name2 op} {
global info
@@ -62,7 +60,7 @@ proc traceCheck {cmd args} {
set info [list [catch $cmd msg] $msg]
}
proc traceCrtElement {value name1 name2 op} {
- uplevel set ${name1}($name2) $value
+ uplevel 1 set ${name1}($name2) $value
}
proc traceCommand {oldName newName op} {
global info
@@ -72,10 +70,10 @@ proc traceCommand {oldName newName op} {
test trace-0.0 {memory corruption in trace (Tcl Bug 484339)} {
# You may need Purify or Electric Fence to reliably
# see this one fail.
- catch {unset z}
+ unset -nocomplain z
trace add variable z array {set z(foo) 1 ;#}
set res "names: [array names z]"
- catch {unset ::z}
+ unset -nocomplain ::z
trace variable ::z w {unset ::z; error "memory corruption";#}
list [catch {set ::z 1} msg] $msg
} {1 {can't set "::z": memory corruption}}
@@ -83,40 +81,40 @@ test trace-0.0 {memory corruption in trace (Tcl Bug 484339)} {
# Read-tracing on variables
test trace-1.1 {trace variable reads} {
- catch {unset x}
+ unset -nocomplain x
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} {
- catch {unset x}
+ unset -nocomplain x
set x 123
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} {
- catch {unset x}
+ unset -nocomplain x
set info {}
trace add variable x read traceScalar
set x 123
set info
} {}
test trace-1.4 {trace array element reads} {
- catch {unset x}
+ unset -nocomplain x
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} {
- catch {unset x}
+ unset -nocomplain x
set x(2) zzz
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} {
- catch {unset x}
+ unset -nocomplain x
set info {}
trace add variable x read traceArray2
proc p {} {
@@ -127,7 +125,7 @@ test trace-1.6 {trace array element reads} {
list [catch {p} msg] $msg $info
} {0 willi {x 2 read}}
test trace-1.7 {trace array element reads, create element undefined if nonexistant} {
- catch {unset x}
+ unset -nocomplain x
set info {}
trace add variable x read q
proc q {name1 name2 op} {
@@ -144,20 +142,20 @@ test trace-1.7 {trace array element reads, create element undefined if nonexista
list [catch {p} msg] $msg $info
} {0 wolf {x Y read}}
test trace-1.8 {trace reads on whole arrays} {
- catch {unset x}
+ unset -nocomplain x
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} {
- catch {unset x}
+ unset -nocomplain x
set x(2) zzz
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} {
- catch {unset x}
+ unset -nocomplain x
set x 444
set info {}
trace add variable x read traceScalar
@@ -165,28 +163,28 @@ test trace-1.10 {trace variable reads} {
set info
} {}
test trace-1.11 {read traces that modify the array structure} {
- catch {unset x}
+ unset -nocomplain x
set x(bar) 0
trace variable x r {set x(foo) 1 ;#}
trace variable x r {unset -nocomplain x(bar) ;#}
array get x
} {}
test trace-1.12 {read traces that modify the array structure} {
- catch {unset x}
+ unset -nocomplain x
set x(bar) 0
trace variable x r {unset -nocomplain x(bar) ;#}
trace variable x r {set x(foo) 1 ;#}
array get x
} {}
test trace-1.13 {read traces that modify the array structure} {
- catch {unset x}
+ unset -nocomplain x
set x(bar) 0
trace variable x r {set x(foo) 1 ;#}
trace variable x r {unset -nocomplain x;#}
list [catch {array get x} res] $res
} {1 {can't read "x(bar)": no such variable}}
test trace-1.14 {read traces that modify the array structure} {
- catch {unset x}
+ unset -nocomplain x
set x(bar) 0
trace variable x r {unset -nocomplain x;#}
trace variable x r {set x(foo) 1 ;#}
@@ -196,28 +194,28 @@ test trace-1.14 {read traces that modify the array structure} {
# Basic write-tracing on variables
test trace-2.1 {trace variable writes} {
- catch {unset x}
+ unset -nocomplain x
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} {
- catch {unset x}
+ unset -nocomplain x
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} {
- catch {unset x}
+ unset -nocomplain x
set info {}
trace add variable x write traceArray
set x(abc) qq
set info
} {x abc write 0 qq}
test trace-2.4 {trace variable writes} {
- catch {unset x}
+ unset -nocomplain x
set x 1234
set info {}
trace add variable x write traceScalar
@@ -225,7 +223,7 @@ test trace-2.4 {trace variable writes} {
set info
} {}
test trace-2.5 {trace variable writes} {
- catch {unset x}
+ unset -nocomplain x
set x 1234
set info {}
trace add variable x write traceScalar
@@ -238,7 +236,7 @@ test trace-2.6 {trace variable writes on compiled local} {
# arrays [Bug 1770591]. The corresponding function for read traces is
# already indirectly tested in trace-1.7
#
- catch {unset x}
+ unset -nocomplain x
set info {}
proc p {} {
trace add variable x write traceArray
@@ -267,7 +265,7 @@ test trace-2.7 {trace variable writes on errorInfo} -body {
# trace: after appending all arguments to the list.
test trace-3.1 {trace variable read-modify-writes} {
- catch {unset x}
+ unset -nocomplain x
set info {}
trace add variable x read traceScalarAppend
append x 123
@@ -276,7 +274,7 @@ test trace-3.1 {trace variable read-modify-writes} {
set info
} {x {} read 0 123456}
test trace-3.2 {trace variable read-modify-writes} {
- catch {unset x}
+ unset -nocomplain x
set info {}
trace add variable x {read write} traceScalarAppend
append x 123
@@ -287,14 +285,14 @@ test trace-3.2 {trace variable read-modify-writes} {
# Basic unset-tracing on variables
test trace-4.1 {trace variable unsets} {
- catch {unset x}
+ unset -nocomplain x
set info {}
trace add variable x unset traceScalar
- catch {unset x}
+ unset -nocomplain x
set info
} {x {} unset 1 {can't read "x": no such variable}}
test trace-4.2 {variable mustn't exist during unset trace} {
- catch {unset x}
+ unset -nocomplain x
set x 1234
set info {}
trace add variable x unset traceScalar
@@ -302,7 +300,7 @@ test trace-4.2 {variable mustn't exist during unset trace} {
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} {
- catch {unset x}
+ unset -nocomplain x
set info {}
trace add variable x unset traceScalar
set x 44
@@ -310,15 +308,15 @@ test trace-4.3 {unset traces mustn't be called during reads and writes} {
set info
} {}
test trace-4.4 {trace unsets on array elements} {
- catch {unset x}
+ unset -nocomplain x
set x(0) 18
set info {}
trace add variable x(1) unset traceArray
- catch {unset x(1)}
+ unset -nocomplain x(1)
set info
} {x 1 unset 1 {can't read "x(1)": no such element in array}}
test trace-4.5 {trace unsets on array elements} {
- catch {unset x}
+ unset -nocomplain x
set x(1) 18
set info {}
trace add variable x(1) unset traceArray
@@ -326,7 +324,7 @@ test trace-4.5 {trace unsets on array elements} {
set info
} {x 1 unset 1 {can't read "x(1)": no such element in array}}
test trace-4.6 {trace unsets on array elements} {
- catch {unset x}
+ unset -nocomplain x
set x(1) 18
set info {}
trace add variable x(1) unset traceArray
@@ -334,15 +332,15 @@ test trace-4.6 {trace unsets on array elements} {
set info
} {x 1 unset 1 {can't read "x(1)": no such variable}}
test trace-4.7 {trace unsets on whole arrays} {
- catch {unset x}
+ unset -nocomplain x
set x(1) 18
set info {}
trace add variable x unset traceProc
- catch {unset x(0)}
+ unset -nocomplain x(0)
set info
} {}
test trace-4.8 {trace unsets on whole arrays} {
- catch {unset x}
+ unset -nocomplain x
set x(1) 18
set x(2) 144
set x(3) 14
@@ -352,7 +350,7 @@ test trace-4.8 {trace unsets on whole arrays} {
set info
} {x 1 unset}
test trace-4.9 {trace unsets on whole arrays} {
- catch {unset x}
+ unset -nocomplain x
set x(1) 18
set x(2) 144
set x(3) 14
@@ -364,7 +362,7 @@ test trace-4.9 {trace unsets on whole arrays} {
# Array tracing on variables
test trace-5.1 {array traces fire on accesses via [array]} {
- catch {unset x}
+ unset -nocomplain x
set x(b) 2
trace add variable x array traceArray2
set ::info {}
@@ -372,7 +370,7 @@ test trace-5.1 {array traces fire on accesses via [array]} {
set ::info
} {x {} array}
test trace-5.2 {array traces do not fire on normal accesses} {
- catch {unset x}
+ unset -nocomplain x
set x(b) 2
trace add variable x array traceArray2
set ::info {}
@@ -381,7 +379,7 @@ test trace-5.2 {array traces do not fire on normal accesses} {
set ::info
} {}
test trace-5.3 {array traces do not outlive variable} {
- catch {unset x}
+ unset -nocomplain x
trace add variable x array traceArray2
set ::info {}
set x(a) 1
@@ -390,19 +388,19 @@ test trace-5.3 {array traces do not outlive variable} {
set ::info
} {}
test trace-5.4 {array traces properly listed in trace information} {
- catch {unset x}
+ unset -nocomplain x
trace add variable x array traceArray2
set result [trace info variable x]
set result
} [list [list array traceArray2]]
test trace-5.5 {array traces properly listed in trace information} {
- catch {unset x}
+ unset -nocomplain x
trace variable x a traceArray2
set result [trace vinfo x]
set result
} [list [list a traceArray2]]
test trace-5.6 {array traces don't fire on scalar variables} {
- catch {unset x}
+ unset -nocomplain x
set x foo
trace add variable x array traceArray2
set ::info {}
@@ -410,14 +408,14 @@ test trace-5.6 {array traces don't fire on scalar variables} {
set ::info
} {}
test trace-5.7 {array traces fire for undefined variables} {
- catch {unset x}
+ unset -nocomplain x
trace add variable x array traceArray2
set ::info {}
array set x {a 1}
set ::info
} {x {} array}
test trace-5.8 {array traces fire for undefined variables} {
- catch {unset x}
+ unset -nocomplain x
trace add variable x array {set x(foo) 1 ;#}
set res "names: [array names x]"
} {names: foo}
@@ -425,7 +423,7 @@ test trace-5.8 {array traces fire for undefined variables} {
# Trace multiple trace types at once.
test trace-6.1 {multiple ops traced at once} {
- catch {unset x}
+ unset -nocomplain x
set info {}
trace add variable x {read write unset} traceProc
catch {set x}
@@ -436,7 +434,7 @@ test trace-6.1 {multiple ops traced at once} {
set info
} {x {} read x {} write x {} read x {} write x {} unset}
test trace-6.2 {multiple ops traced on array element} {
- catch {unset x}
+ unset -nocomplain x
set info {}
trace add variable x(0) {read write unset} traceProc
catch {set x(0)}
@@ -448,7 +446,7 @@ test trace-6.2 {multiple ops traced on array element} {
set info
} {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} {
- catch {unset x}
+ unset -nocomplain x
set info {}
trace add variable x {read write unset} traceProc
catch {set x(0)}
@@ -463,7 +461,7 @@ test trace-6.3 {multiple ops traced on whole array} {
# Check order of invocation of traces
test trace-7.1 {order of invocation of traces} {
- catch {unset x}
+ unset -nocomplain x
set info {}
trace add variable x read "traceTag 1"
trace add variable x read "traceTag 2"
@@ -474,7 +472,7 @@ test trace-7.1 {order of invocation of traces} {
set info
} {3 2 1 3 2 1}
test trace-7.2 {order of invocation of traces} {
- catch {unset x}
+ unset -nocomplain x
set x(0) 44
set info {}
trace add variable x(0) read "traceTag 1"
@@ -484,7 +482,7 @@ test trace-7.2 {order of invocation of traces} {
set info
} {3 2 1}
test trace-7.3 {order of invocation of traces} {
- catch {unset x}
+ unset -nocomplain x
set x(0) 44
set info {}
trace add variable x(0) read "traceTag 1"
@@ -500,7 +498,7 @@ test trace-7.3 {order of invocation of traces} {
# Check effects of errors in trace procedures
test trace-8.1 {error returns from traces} {
- catch {unset x}
+ unset -nocomplain x
set x 123
set info {}
trace add variable x read "traceTag 1"
@@ -508,7 +506,7 @@ test trace-8.1 {error returns from traces} {
list [catch {set x} msg] $msg $info
} {1 {can't read "x": trace returned error} {}}
test trace-8.2 {error returns from traces} {
- catch {unset x}
+ unset -nocomplain x
set x 123
set info {}
trace add variable x write "traceTag 1"
@@ -516,14 +514,14 @@ test trace-8.2 {error returns from traces} {
list [catch {set x 44} msg] $msg $info
} {1 {can't set "x": trace returned error} {}}
test trace-8.3 {error returns from traces} {
- catch {unset x}
+ unset -nocomplain x
set x 123
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} {
- catch {unset x}
+ unset -nocomplain x
set x 123
set info {}
trace add variable x unset "traceTag 1"
@@ -531,7 +529,7 @@ test trace-8.4 {error returns from traces} {
list [catch {unset x} msg] $msg $info
} {0 {} 1}
test trace-8.5 {error returns from traces} {
- catch {unset x}
+ unset -nocomplain x
set x(0) 123
set info {}
trace add variable x(0) read "traceTag 1"
@@ -541,7 +539,7 @@ test trace-8.5 {error returns from traces} {
list [catch {set x(0)} msg] $msg $info
} {1 {can't read "x(0)": trace returned error} 3}
test trace-8.6 {error returns from traces} {
- catch {unset x}
+ unset -nocomplain x
set x 123
trace add variable x unset traceError
list [catch {unset x} msg] $msg
@@ -550,7 +548,7 @@ test trace-8.7 {error returns from traces} {
# This test just makes sure that the memory for the error message
# gets deallocated correctly when the trace is invoked again or
# when the trace is deleted.
- catch {unset x}
+ unset -nocomplain x
set x 123
trace add variable x read traceError
catch {set x}
@@ -571,7 +569,7 @@ test trace-8.8 {error returns from traces} {
trace add variable ::x write [list foo $::x]
error "foo"
}
- catch {unset ::x ::y}
+ unset -nocomplain ::x ::y
set x junk
trace add variable ::x write [list foo $x]
for {set y 0} {$y<100} {incr y} {
@@ -585,31 +583,31 @@ test trace-8.8 {error returns from traces} {
# a new copy of the variables.
test trace-9.1 {be sure variable is unset before trace is called} {
- catch {unset x}
+ unset -nocomplain x
set x 33
set info {}
- trace add variable x unset {traceCheck {uplevel set x}}
+ 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} {
- catch {unset x}
+ unset -nocomplain x
set x 33
set info {}
- trace add variable x unset {traceCheck {uplevel set x 22}}
+ 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} {
- catch {unset x}
+ unset -nocomplain x
set x 33
set info {}
- trace add variable x unset {traceCheck {uplevel trace info variable x}}
+ 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} {
- catch {unset x}
+ unset -nocomplain x
set x 33
set info {}
trace add variable x unset {traceCheck {global x; trace add variable x unset traceProc}}
@@ -618,23 +616,23 @@ test trace-9.4 {set new trace during unset trace} {
} {0 {} {unset traceProc}}
test trace-10.1 {make sure array elements are unset before traces are called} {
- catch {unset x}
+ unset -nocomplain x
set x(0) 33
set info {}
- trace add variable x(0) unset {traceCheck {uplevel set x(0)}}
+ 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} {
- catch {unset x}
+ unset -nocomplain x
set x(0) 33
set info {}
- trace add variable x(0) unset {traceCheck {uplevel set x(0) zzz}}
+ 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} {
- catch {unset x}
+ unset -nocomplain x
set x(0) 33
set info {}
trace add variable x(0) unset {traceCheck {global x; trace info variable x(0)}}
@@ -642,49 +640,49 @@ test trace-10.3 {array elements are unset before traces are called} {
set info
} {0 {}}
test trace-10.4 {set new array element trace during unset trace} {
- catch {unset x}
+ unset -nocomplain x
set x(0) 33
set info {}
- trace add variable x(0) unset {traceCheck {uplevel {trace add variable x(0) read {}}}}
- catch {unset x(0)}
+ 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 {}}}
test trace-11.1 {make sure arrays are unset before traces are called} {
- catch {unset x}
+ unset -nocomplain x
set x(0) 33
set info {}
- trace add variable x unset {traceCheck {uplevel set x(0)}}
+ 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} {
- catch {unset x}
+ unset -nocomplain x
set x(y) 33
set info {}
- trace add variable x unset {traceCheck {uplevel set x(y) 22}}
+ 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} {
- catch {unset x}
+ unset -nocomplain x
set x(y) 33
set info {}
- trace add variable x unset {traceCheck {uplevel array exists x}}
+ 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} {
- catch {unset x}
+ unset -nocomplain x
set x(y) 33
set info {}
- set cmd {traceCheck {uplevel {trace info variable x}}}
+ set cmd {traceCheck {uplevel 1 {trace info variable x}}}
trace add variable x unset $cmd
unset x
set info
} {0 {}}
test trace-11.5 {set new array trace during unset trace} {
- catch {unset x}
+ unset -nocomplain x
set x(y) 33
set info {}
trace add variable x unset {traceCheck {global x; trace add variable x read {}}}
@@ -692,7 +690,7 @@ test trace-11.5 {set new array trace during unset trace} {
concat $info [trace info variable x]
} {0 {} {read {}}}
test trace-11.6 {create scalar during array unset trace} {
- catch {unset x}
+ unset -nocomplain x
set x(y) 33
set info {}
trace add variable x unset {traceCheck {global x; set x 44}}
@@ -703,52 +701,52 @@ test trace-11.6 {create scalar during array unset trace} {
# Check special conditions (e.g. errors) in Tcl_TraceVar2.
test trace-12.1 {creating array when setting variable traces} {
- catch {unset x}
+ unset -nocomplain x
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} {
- catch {unset x}
+ unset -nocomplain x
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} {
- catch {unset x}
+ unset -nocomplain x
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} {
- catch {unset x}
+ unset -nocomplain x
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} {
- catch {unset x}
+ unset -nocomplain x
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} {
- catch {unset x}
+ unset -nocomplain x
set info {}
trace add variable x write traceProc
set x(0) 22
set info
} {x 0 write}
test trace-12.7 {create array element during read trace} {
- catch {unset x}
+ unset -nocomplain x
set x(2) zzz
trace add variable x read {traceCrtElement xyzzy}
list [catch {set x(3)} msg] $msg
} {0 xyzzy}
test trace-12.8 {errors when setting variable traces} {
- catch {unset x}
+ unset -nocomplain x
set x 44
list [catch {trace add variable x(0) write traceProc} msg] $msg
} {1 {can't trace "x(0)": variable isn't array}}
@@ -762,7 +760,7 @@ test trace-13.1 {delete one trace from another} {
trace remove variable x read {traceTag 3}
trace remove variable x read {traceTag 4}
}
- catch {unset x}
+ unset -nocomplain x
set x 44
set info {}
trace add variable x read {traceTag 1}
@@ -916,13 +914,13 @@ test trace-14.11 {trace command, "trace variable" errors} {
test trace-14.12 {trace command ("remove variable" option)} {
- catch {unset x}
+ unset -nocomplain x
set info {}
trace add variable x write traceProc
trace remove variable x write traceProc
} {}
test trace-14.13 {trace command ("remove variable" option)} {
- catch {unset x}
+ unset -nocomplain x
set info {}
trace add variable x write traceProc
trace remove variable x write traceProc
@@ -930,7 +928,7 @@ test trace-14.13 {trace command ("remove variable" option)} {
set info
} {}
test trace-14.14 {trace command ("remove variable" option)} {
- catch {unset x}
+ unset -nocomplain x
set info {}
trace add variable x write {traceTag 1}
trace add variable x write traceProc
@@ -945,7 +943,7 @@ test trace-14.14 {trace command ("remove variable" option)} {
set info
} {2 x {} write 1 2 1 2}
test trace-14.15 {trace command ("remove variable" option)} {
- catch {unset x}
+ unset -nocomplain x
set info {}
trace add variable x write {traceTag 1}
trace remove variable x write non_existent
@@ -953,27 +951,27 @@ test trace-14.15 {trace command ("remove variable" option)} {
set info
} {1}
test trace-14.16 {trace command ("info variable" option)} {
- catch {unset x}
+ unset -nocomplain x
trace add variable x write {traceTag 1}
trace add variable x write traceProc
trace add variable x write {traceTag 2}
trace info variable x
} {{write {traceTag 2}} {write traceProc} {write {traceTag 1}}}
test trace-14.17 {trace command ("info variable" option)} {
- catch {unset x}
+ unset -nocomplain x
trace info variable x
} {}
test trace-14.18 {trace command ("info variable" option)} {
- catch {unset x}
+ unset -nocomplain x
trace info variable x(0)
} {}
test trace-14.19 {trace command ("info variable" option)} {
- catch {unset x}
+ unset -nocomplain x
set x 44
trace info variable x(0)
} {}
test trace-14.20 {trace command ("info variable" option)} {
- catch {unset x}
+ unset -nocomplain x
set x 44
trace add variable x write {traceTag 1}
proc check {} {global x; trace info variable x}
@@ -983,7 +981,7 @@ test trace-14.20 {trace command ("info variable" option)} {
# Check fancy trace commands (long ones, weird arguments, etc.)
test trace-15.1 {long trace command} {
- catch {unset x}
+ unset -nocomplain x
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 \
@@ -1001,14 +999,14 @@ test trace-15.2 {long trace command result to ignore} {
proc longResult {args} {return "quite a bit of text, designed to
generate a core leak if this command file is invoked over and over again
and memory isn't being recycled correctly"}
- catch {unset x}
+ unset -nocomplain x
trace add variable x write longResult
set x 44
set x 5
set x abcde
} abcde
test trace-15.3 {special list-handling in trace commands} {
- catch {unset "x y z"}
+ unset -nocomplain "x y z"
set "x y z(a\n\{)" 44
set info {}
trace add variable "x y z(a\n\{)" write traceProc
@@ -1020,18 +1018,18 @@ test trace-15.3 {special list-handling in trace commands} {
proc traceUnset {unsetName args} {
global info
- upvar $unsetName x
+ upvar 1 $unsetName x
lappend info [catch {unset x} msg] $msg [catch {set x} msg] $msg
}
proc traceReset {unsetName resetName args} {
global info
- upvar $unsetName x $resetName y
+ upvar 1 $unsetName x $resetName y
lappend info [catch {unset x} msg] $msg [catch {set y xyzzy} msg] $msg
}
proc traceReset2 {unsetName resetName args} {
global info
- lappend info [catch {uplevel unset $unsetName} msg] $msg \
- [catch {uplevel set $resetName xyzzy} msg] $msg
+ lappend info [catch {uplevel 1 unset $unsetName} msg] $msg \
+ [catch {uplevel 1 set $resetName xyzzy} msg] $msg
}
proc traceAppend {string name1 name2 op} {
global info
@@ -1039,7 +1037,7 @@ proc traceAppend {string name1 name2 op} {
}
test trace-16.1 {unsets during read traces} {
- catch {unset y}
+ unset -nocomplain y
set y 1234
set info {}
trace add variable y read {traceUnset y}
@@ -1047,49 +1045,49 @@ test trace-16.1 {unsets during read traces} {
lappend info [catch {set y} msg] $msg
} {unset 0 {} 1 {can't read "x": no such variable} 1 {can't read "y": no such variable}}
test trace-16.2 {unsets during read traces} {
- catch {unset y}
+ unset -nocomplain y
set y(0) 1234
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} {
- catch {unset y}
+ unset -nocomplain y
set y(0) 1234
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} {
- catch {unset y}
+ unset -nocomplain y
set y 1234
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} {
- catch {unset y}
+ unset -nocomplain y
set y(0) 1234
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} {
- catch {unset y}
+ unset -nocomplain y
set y(0) 1234
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} {
- catch {unset y}
+ unset -nocomplain y
set y(0) 1234
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} {
- catch {unset y}
+ unset -nocomplain y
set y 1234
set info {}
trace add variable y write {traceUnset y}
@@ -1097,91 +1095,91 @@ test trace-16.8 {unsets during write traces} {
lappend info [catch {set y xxx} msg] $msg
} {unset 0 {} 1 {can't read "x": no such variable} 0 {}}
test trace-16.9 {unsets during write traces} {
- catch {unset y}
+ unset -nocomplain y
set y(0) 1234
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} {
- catch {unset y}
+ unset -nocomplain y
set y(0) 1234
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} {
- catch {unset y}
+ unset -nocomplain y
set y 1234
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} {
- catch {unset y}
+ unset -nocomplain y
set y(0) 1234
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} {
- catch {unset y}
+ unset -nocomplain y
set y(0) 1234
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} {
- catch {unset y}
+ unset -nocomplain y
set y(0) 1234
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} {
- catch {unset y}
+ unset -nocomplain y
set y 1234
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} {
- catch {unset y}
+ unset -nocomplain y
set y(0) 1234
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} {
- catch {unset y}
+ unset -nocomplain y
set y(0) 1234
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} {
- catch {unset y}
+ unset -nocomplain y
set y 1234
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} {
- catch {unset y}
+ unset -nocomplain y
set y(0) 1234
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} {
- catch {unset y}
+ unset -nocomplain y
set y(0) 1234
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} {
- catch {unset y}
+ unset -nocomplain y
set y 1234
set info {}
trace add variable y read {traceAppend first}
@@ -1191,7 +1189,7 @@ test trace-16.21 {unsets cancelling traces} {
lappend info [catch {set y} msg] $msg
} {third unset 0 {} 1 {can't read "x": no such variable} 1 {can't read "y": no such variable}}
test trace-16.22 {unsets cancelling traces} {
- catch {unset y}
+ unset -nocomplain y
set y(0) 1234
set info {}
trace add variable y(0) read {traceAppend first}
@@ -1204,19 +1202,19 @@ test trace-16.22 {unsets cancelling traces} {
# Check various non-interference between traces and other things.
test trace-17.1 {trace doesn't prevent unset errors} {
- catch {unset x}
+ unset -nocomplain x
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}}
test trace-17.2 {traced variables must survive procedure exits} {
- catch {unset x}
+ unset -nocomplain x
proc p1 {} {global x; trace add variable x write traceProc}
p1
trace info variable x
} {{write traceProc}}
test trace-17.3 {traced variables must survive procedure exits} {
- catch {unset x}
+ unset -nocomplain x
set info {}
proc p1 {} {global x; trace add variable x write traceProc}
p1
@@ -1229,7 +1227,7 @@ 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}]}}}
+ proc p2 {z} {trace add variable z unset {traceCheck {lsort [uplevel 1 {info vars}]}}}
set info {}
p1 foo bar
set info
@@ -1269,8 +1267,7 @@ test trace-18.4 {namespace delete / trace vdelete combo, Bug \#1338280} {
# Delete arrays when done, so they can be re-used as scalars
# elsewhere.
-catch {unset x}
-catch {unset y}
+unset -nocomplain x y
test trace-19.0.1 {trace add command (command existence)} {
# Just in case!
@@ -1542,8 +1539,7 @@ proc foo {b} { set a $b }
# Delete arrays when done, so they can be re-used as scalars
# elsewhere.
-catch {unset x}
-catch {unset 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).
@@ -2050,7 +2046,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 {}
- catch {unset a}
+ unset -nocomplain a
join $info "\n"
} {foo foo enter
foo {set a 1} enterstep
@@ -2634,9 +2630,8 @@ catch {rename traceproc {}}
catch {rename runbase {}}
# Unset the variable when done
-catch {unset info}
-catch {unset base}
+unset -nocomplain info base
# cleanup
-::tcltest::cleanupTests
+cleanupTests
return
diff --git a/tests/unixInit.test b/tests/unixInit.test
index 9ba9c11..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
@@ -44,11 +44,11 @@ test unixInit-1.2 {initialisation: standard channel type deduction} {unix stdio}
set pipe1 [open "|[list [interpreter]]" r+]
puts $pipe1 {
proc accept {channel host port} {
- puts $channel {puts [fconfigure stdin -peername]; exit}
+ puts $channel {puts [chan configure stdin -peername]; exit}
close $channel
exit
}
- puts [fconfigure [socket -server accept -myaddr 127.0.0.1 0] -sockname]
+ puts [chan configure [socket -server accept -myaddr 127.0.0.1 0] -sockname]
vwait forever \
}
# Note the backslash above; this is important to make sure that the whole
@@ -64,8 +64,8 @@ test unixInit-1.2 {initialisation: standard channel type deduction} {unix stdio}
set pipe2 [open "|[list [interpreter] <@$sock]" r]
set result [gets $pipe2]
# Clear any pending data; stops certain kinds of (non-important) errors
- fconfigure $pipe1 -blocking 0; gets $pipe1
- fconfigure $pipe2 -blocking 0; gets $pipe2
+ chan configure $pipe1 -blocking 0; gets $pipe1
+ chan configure $pipe2 -blocking 0; gets $pipe2
# Close the pipes and the socket.
close $pipe2
close $pipe1
@@ -329,7 +329,7 @@ test unixInit-3.1 {TclpSetInitialEncodings} -constraints {
} -body {
set env(LANG) C
set f [open "|[list [interpreter]]" w+]
- fconfigure $f -buffering none
+ chan configure $f -buffering none
puts $f {puts [encoding system]; exit}
set enc [gets $f]
close $f
@@ -344,7 +344,7 @@ test unixInit-3.2 {TclpSetInitialEncodings} -setup {
set env(LANG) japanese
set env(LC_ALL) japanese
set f [open "|[list [interpreter]]" w+]
- fconfigure $f -buffering none
+ chan configure $f -buffering none
puts $f {puts [encoding system]; exit}
set enc [gets $f]
close $f
@@ -390,7 +390,7 @@ test unixInit-7.1 {closed standard channel: Bug 772288} -constraints {
} -returnCodes 0
# cleanup
-catch {unset env(LANG)}
+unset -nocomplain env(LANG)
catch {set env(LANG) $oldlang}
unset -nocomplain path
::tcltest::cleanupTests
diff --git a/tests/unknown.test b/tests/unknown.test
index 40be6602..e80d3a6 100644
--- a/tests/unknown.test
+++ b/tests/unknown.test
@@ -11,12 +11,10 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
- namespace import -force ::tcltest::*
-}
+package require tcltest 2
+namespace import ::tcltest::*
-catch {unset x}
+unset -nocomplain x
catch {rename unknown unknown.old}
test unknown-1.1 {non-existent "unknown" command} {
@@ -59,7 +57,7 @@ test unknown-4.1 {errors in "unknown" procedure} {
# cleanup
catch {rename unknown {}}
catch {rename unknown.old unknown}
-::tcltest::cleanupTests
+cleanupTests
return
# Local Variables:
generated by cgit v0.12 at 2024-08-20 21:33:55 (GMT)