summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2010-12-09 15:09:07 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2010-12-09 15:09:07 (GMT)
commitee6985ab9eed245164bf1078496d5b7efbabdd9c (patch)
treece38d69f9ab51ef0a83d6e83b49177e042a74a31 /tests
parent04d3371ea6033290def691a38224ba78356f0a9a (diff)
downloadtcl-ee6985ab9eed245164bf1078496d5b7efbabdd9c.zip
tcl-ee6985ab9eed245164bf1078496d5b7efbabdd9c.tar.gz
tcl-ee6985ab9eed245164bf1078496d5b7efbabdd9c.tar.bz2
* generic/tclCmdAH.c (TclInitFileCmd, TclMakeFileCommandSafe, ...):
Break up [file] into an ensemble. Note that the ensemble is safe in itself, but the majority of its subcommands are not. * generic/tclFCmd.c (FileCopyRename,TclFileDeleteCmd,TclFileAttrsCmd) (TclFileMakeDirsCmd): Adjust these subcommand implementations to work inside an ensemble. (TclFileLinkCmd, TclFileReadLinkCmd, TclFileTemporaryCmd): Move these subcommand implementations from tclCmdAH.c, where they didn't really belong. * generic/tclIOCmd.c (TclChannelNamesCmd): Move to more appropriate source file. * generic/tclEnsemble.c (TclMakeEnsemble): Start of code to make partially-safe ensembles. Currently does not function as expected due to various shortcomings in how safe interpreters are constructed. * tests/cmdAH.test, tests/fCmd.test, tests/interp.test: Test updates to take into account systematization of error messages.
Diffstat (limited to 'tests')
-rw-r--r--tests/cmdAH.test24
-rw-r--r--tests/fCmd.test8
-rw-r--r--tests/fileSystem.test4
-rw-r--r--tests/interp.test328
4 files changed, 169 insertions, 195 deletions
diff --git a/tests/cmdAH.test b/tests/cmdAH.test
index f7ba584..ab388b9 100644
--- a/tests/cmdAH.test
+++ b/tests/cmdAH.test
@@ -10,7 +10,7 @@
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: cmdAH.test,v 1.68 2010/02/05 14:33:09 dkf Exp $
+# RCS: @(#) $Id: cmdAH.test,v 1.69 2010/12/09 15:09:08 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2.1
@@ -218,10 +218,10 @@ test cmdAH-4.13 {Tcl_EncodingObjCmd} -setup {
test cmdAH-5.1 {Tcl_FileObjCmd} -returnCodes error -body {
file
-} -result {wrong # args: should be "file option ?arg ...?"}
+} -result {wrong # args: should be "file subcommand ?arg ...?"}
test cmdAH-5.2 {Tcl_FileObjCmd} -returnCodes error -body {
file x
-} -result {bad option "x": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, link, lstat, mtime, mkdir, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, tempfile, type, volumes, or writable}
+} -result {unknown or ambiguous subcommand "x": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, link, lstat, mkdir, mtime, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, tempfile, type, volumes, or writable}
test cmdAH-5.3 {Tcl_FileObjCmd} -returnCodes error -body {
file exists
} -result {wrong # args: should be "file exists name"}
@@ -242,7 +242,7 @@ test cmdAH-6.3 {Tcl_FileObjCmd: volumes} {unix} {
} {0}
test cmdAH-6.4 {Tcl_FileObjCmd: volumes} win {
set volumeList [string tolower [file volumes]]
- list [catch {lsearch $volumeList "c:/"} element] [expr $element != -1] [catch {list glob -nocomplain [lindex $volumeList $element]*}]
+ list [catch {lsearch $volumeList "c:/"} element] [expr {$element != -1}] [catch {list glob -nocomplain [lindex $volumeList $element]*}]
} {0 1 0}
# attributes
@@ -1415,25 +1415,25 @@ test cmdAH-29.5 {Tcl_FileObjCmd: type} {
# Error conditions
test cmdAH-30.1 {Tcl_FileObjCmd: error conditions} -returnCodes error -body {
file gorp x
-} -result {bad option "gorp": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, link, lstat, mtime, mkdir, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, tempfile, type, volumes, or writable}
+} -result {unknown or ambiguous subcommand "gorp": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, link, lstat, mkdir, mtime, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, tempfile, type, volumes, or writable}
test cmdAH-30.2 {Tcl_FileObjCmd: error conditions} -returnCodes error -body {
file ex x
-} -match glob -result {ambiguous option "ex": must be *}
+} -match glob -result {unknown or ambiguous subcommand "ex": must be *}
test cmdAH-30.3 {Tcl_FileObjCmd: error conditions} -returnCodes error -body {
file is x
-} -match glob -result {ambiguous option "is": must be *}
+} -match glob -result {unknown or ambiguous subcommand "is": must be *}
test cmdAH-30.4 {Tcl_FileObjCmd: error conditions} -returnCodes error -body {
file z x
-} -match glob -result {bad option "z": must be *}
+} -match glob -result {unknown or ambiguous subcommand "z": must be *}
test cmdAH-30.5 {Tcl_FileObjCmd: error conditions} -returnCodes error -body {
file read x
-} -match glob -result {ambiguous option "read": must be *}
+} -match glob -result {unknown or ambiguous subcommand "read": must be *}
test cmdAH-30.6 {Tcl_FileObjCmd: error conditions} -returnCodes error -body {
file s x
-} -match glob -result {ambiguous option "s": must be *}
+} -match glob -result {unknown or ambiguous subcommand "s": must be *}
test cmdAH-30.7 {Tcl_FileObjCmd: error conditions} -returnCodes error -body {
file t x
-} -match glob -result {ambiguous option "t": must be *}
+} -match glob -result {unknown or ambiguous subcommand "t": must be *}
test cmdAH-30.8 {Tcl_FileObjCmd: error conditions} -returnCodes error -body {
file dirname ~woohgy
} -result {user "woohgy" doesn't exist}
@@ -1445,7 +1445,7 @@ test cmdAH-30.8 {Tcl_FileObjCmd: error conditions} -returnCodes error -body {
interp create simpleInterp
interp create -safe safeInterp
interp create
-safeInterp expose file file
+catch {safeInterp expose file file}
test cmdAH-31.1 {Tcl_FileObjCmd: channels, too many args} -body {
file channels a b
diff --git a/tests/fCmd.test b/tests/fCmd.test
index 4057cd0..960844c 100644
--- a/tests/fCmd.test
+++ b/tests/fCmd.test
@@ -10,7 +10,7 @@
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: fCmd.test,v 1.71 2010/12/07 16:32:06 dkf Exp $
+# RCS: @(#) $Id: fCmd.test,v 1.72 2010/12/09 15:09:08 dkf Exp $
#
if {"::tcltest" ni [namespace children]} {
@@ -195,7 +195,7 @@ test fCmd-2.1 {TclFileCopyCmd} -constraints {notRoot} -setup {
test fCmd-3.1 {FileCopyRename: FileForceOption fails} -constraints {notRoot} -body {
file rename -xyz
-} -returnCodes error -result {bad option "-xyz": should be -force or --}
+} -returnCodes error -result {bad option "-xyz": must be -force or --}
test fCmd-3.2 {FileCopyRename: not enough args} -constraints {notRoot} -body {
file rename xyz
} -returnCodes error -result {wrong # args: should be "file rename ?-option value ...? source ?source ...? target"}
@@ -393,7 +393,7 @@ test fCmd-4.16 {TclFileMakeDirsCmd: TclpCreateDirectory succeeds} -setup {
test fCmd-5.1 {TclFileDeleteCmd: FileForceOption fails} -constraints {notRoot} -body {
file delete -xyz
-} -returnCodes error -result {bad option "-xyz": should be -force or --}
+} -returnCodes error -result {bad option "-xyz": must be -force or --}
test fCmd-5.2 {TclFileDeleteCmd: accept 0 files (TIP 323)} -body {
file delete -force -force
} -result {}
@@ -740,7 +740,7 @@ test fCmd-7.4 {FileForceOption: bad option} -constraints {notRoot} -setup {
file delete -tf1
} -returnCodes error -cleanup {
file delete -- -tf1
-} -result {bad option "-tf1": should be -force or --}
+} -result {bad option "-tf1": must be -force or --}
test fCmd-7.5 {FileForceOption: multiple times through loop} -setup {
cleanup
} -constraints {notRoot} -returnCodes error -body {
diff --git a/tests/fileSystem.test b/tests/fileSystem.test
index 2fe13d7..1691eb5 100644
--- a/tests/fileSystem.test
+++ b/tests/fileSystem.test
@@ -600,14 +600,14 @@ test filesystem-6.25 {empty file name} -returnCodes error -body {
test filesystem-6.26 {empty file name} {file rootname ""} {}
test filesystem-6.27 {empty file name} -returnCodes error -body {
file separator ""
-} -result {Unrecognised path}
+} -result {unrecognised path}
test filesystem-6.28 {empty file name} -returnCodes error -body {
file size ""
} -result {could not read "": no such file or directory}
test filesystem-6.29 {empty file name} {file split ""} {}
test filesystem-6.30 {empty file name} -returnCodes error -body {
file system ""
-} -result {Unrecognised path}
+} -result {unrecognised path}
test filesystem-6.31 {empty file name} {file tail ""} {}
test filesystem-6.32 {empty file name} -returnCodes error -body {
file type ""
diff --git a/tests/interp.test b/tests/interp.test
index f73fe49..6df8f31e 100644
--- a/tests/interp.test
+++ b/tests/interp.test
@@ -10,7 +10,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: interp.test,v 1.69 2010/11/15 21:34:54 andreas_kupries Exp $
+# RCS: @(#) $Id: interp.test,v 1.70 2010/12/09 15:09:08 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2.1
@@ -19,7 +19,7 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
testConstraint testinterpdelete [llength [info commands testinterpdelete]]
-set hidden_cmds {cd encoding exec exit fconfigure file glob load open pwd socket source unload}
+set hidden_cmds {cd encoding exec exit fconfigure glob load open pwd socket source tcl:file:atime tcl:file:attributes tcl:file:copy tcl:file:delete tcl:file:dirname tcl:file:executable tcl:file:exists tcl:file:extension tcl:file:isdirectory tcl:file:isfile tcl:file:link tcl:file:lstat tcl:file:mkdir tcl:file:mtime tcl:file:nativename tcl:file:normalize tcl:file:owned tcl:file:readable tcl:file:readlink tcl:file:rename tcl:file:rootname tcl:file:size tcl:file:stat tcl:file:tail tcl:file:tempfile tcl:file:type tcl:file:volumes tcl:file:writable unload}
foreach i [interp slaves] {
interp delete $i
@@ -1607,67 +1607,73 @@ test interp-21.1 {interp hidden} {
test interp-21.2 {interp hidden} {
interp hidden
} ""
-test interp-21.3 {interp hidden vs interp hide, interp expose} {
+test interp-21.3 {interp hidden vs interp hide, interp expose} -setup {
set l ""
+} -body {
lappend l [interp hidden]
interp hide {} pwd
lappend l [interp hidden]
interp expose {} pwd
lappend l [interp hidden]
- set l
-} {{} pwd {}}
-test interp-21.4 {interp hidden} {
+} -result {{} pwd {}}
+test interp-21.4 {interp hidden} -setup {
catch {interp delete a}
+} -body {
interp create a
- set l [interp hidden a]
+ interp hidden a
+} -cleanup {
interp delete a
- set l
-} ""
-test interp-21.5 {interp hidden} {
+} -result ""
+test interp-21.5 {interp hidden} -setup {
catch {interp delete a}
+} -body {
interp create -safe a
- set l [lsort [interp hidden a]]
+ lsort [interp hidden a]
+} -cleanup {
interp delete a
- set l
-} $hidden_cmds
-test interp-21.6 {interp hidden vs interp hide, interp expose} {
+} -result $hidden_cmds
+test interp-21.6 {interp hidden vs interp hide, interp expose} -setup {
catch {interp delete a}
- interp create a
set l ""
+} -body {
+ interp create a
lappend l [interp hidden a]
interp hide a pwd
lappend l [interp hidden a]
interp expose a pwd
lappend l [interp hidden a]
+} -cleanup {
interp delete a
- set l
-} {{} pwd {}}
-test interp-21.7 {interp hidden} {
+} -result {{} pwd {}}
+test interp-21.7 {interp hidden} -setup {
catch {interp delete a}
+} -body {
interp create a
- set l [a hidden]
+ a hidden
+} -cleanup {
interp delete a
- set l
-} ""
-test interp-21.8 {interp hidden} {
+} -result ""
+test interp-21.8 {interp hidden} -setup {
catch {interp delete a}
+} -body {
interp create a -safe
- set l [lsort [a hidden]]
+ lsort [a hidden]
+} -cleanup {
interp delete a
- set l
-} $hidden_cmds
-test interp-21.9 {interp hidden vs interp hide, interp expose} {
+} -result $hidden_cmds
+test interp-21.9 {interp hidden vs interp hide, interp expose} -setup {
catch {interp delete a}
- interp create a
set l ""
+} -body {
+ interp create a
lappend l [a hidden]
a hide pwd
lappend l [a hidden]
a expose pwd
lappend l [a hidden]
+} -cleanup {
interp delete a
- set l
-} {{} pwd {}}
+} -result {{} pwd {}}
test interp-22.1 {testing interp marktrusted} {
catch {interp delete a}
@@ -1767,183 +1773,161 @@ test interp-22.9 {testing interp marktrusted} {
set l
} {1 1 1 0 0}
-test interp-23.1 {testing hiding vs aliases} {
+test interp-23.1 {testing hiding vs aliases: unsafe interp} -setup {
catch {interp delete a}
- interp create a
set l ""
+} -body {
+ interp create a
lappend l [interp hidden a]
a alias bar bar
- lappend l [interp aliases a]
- lappend l [interp hidden a]
+ lappend l [interp aliases a] [interp hidden a]
a hide bar
- lappend l [interp aliases a]
- lappend l [interp hidden a]
+ lappend l [interp aliases a] [interp hidden a]
a alias bar {}
- lappend l [interp aliases a]
- lappend l [interp hidden a]
+ lappend l [interp aliases a] [interp hidden a]
+} -cleanup {
interp delete a
- set l
-} {{} bar {} bar bar {} {}}
-test interp-23.2 {testing hiding vs aliases} {unixOrPc} {
+} -result {{} bar {} bar bar {} {}}
+test interp-23.2 {testing hiding vs aliases: safe interp} -setup {
catch {interp delete a}
- interp create a -safe
set l ""
+} -constraints {unixOrPc} -body {
+ interp create a -safe
lappend l [lsort [interp hidden a]]
a alias bar bar
- lappend l [lsort [interp aliases a]]
- lappend l [lsort [interp hidden a]]
+ lappend l [lsort [interp aliases a]] [lsort [interp hidden a]]
a hide bar
- lappend l [lsort [interp aliases a]]
- lappend l [lsort [interp hidden a]]
+ lappend l [lsort [interp aliases a]] [lsort [interp hidden a]]
a alias bar {}
- lappend l [lsort [interp aliases a]]
- lappend l [lsort [interp hidden a]]
+ lappend l [lsort [interp aliases a]] [lsort [interp hidden a]]
+} -cleanup {
interp delete a
- set l
-} {{cd encoding exec exit fconfigure file glob load open pwd socket source unload} {::tcl::mathfunc::max ::tcl::mathfunc::min bar clock} {cd encoding exec exit fconfigure file glob load open pwd socket source unload} {::tcl::mathfunc::max ::tcl::mathfunc::min bar clock} {bar cd encoding exec exit fconfigure file glob load open pwd socket source unload} {::tcl::mathfunc::max ::tcl::mathfunc::min clock} {cd encoding exec exit fconfigure file glob load open pwd socket source unload}}
+} -result [list $hidden_cmds {::tcl::mathfunc::max ::tcl::mathfunc::min bar clock} $hidden_cmds {::tcl::mathfunc::max ::tcl::mathfunc::min bar clock} [lsort [concat $hidden_cmds bar]] {::tcl::mathfunc::max ::tcl::mathfunc::min clock} $hidden_cmds]
-test interp-24.1 {result resetting on error} {
+test interp-24.1 {result resetting on error} -setup {
catch {interp delete a}
+} -body {
interp create a
- proc foo args {error $args}
- interp alias a foo {} foo
- set l [interp eval a {
- set l {}
- lappend l [catch {foo 1 2 3} msg]
- lappend l $msg
- lappend l [catch {foo 3 4 5} msg]
- lappend l $msg
- set l
- }]
+ interp alias a foo {} apply {args {error $args}}
+ interp eval a {
+ lappend l [catch {foo 1 2 3} msg] $msg
+ lappend l [catch {foo 3 4 5} msg] $msg
+ }
+} -cleanup {
interp delete a
- rename foo {}
- set l
-} {1 {1 2 3} 1 {3 4 5}}
-test interp-24.2 {result resetting on error} {
+} -result {1 {1 2 3} 1 {3 4 5}}
+test interp-24.2 {result resetting on error} -setup {
catch {interp delete a}
+} -body {
interp create a -safe
- proc foo args {error $args}
- interp alias a foo {} foo
- set l [interp eval a {
- set l {}
- lappend l [catch {foo 1 2 3} msg]
- lappend l $msg
- lappend l [catch {foo 3 4 5} msg]
- lappend l $msg
- set l
- }]
+ interp alias a foo {} apply {args {error $args}}
+ interp eval a {
+ lappend l [catch {foo 1 2 3} msg] $msg
+ lappend l [catch {foo 3 4 5} msg] $msg
+ }
+} -cleanup {
interp delete a
- rename foo {}
- set l
-} {1 {1 2 3} 1 {3 4 5}}
-test interp-24.3 {result resetting on error} {
+} -result {1 {1 2 3} 1 {3 4 5}}
+test interp-24.3 {result resetting on error} -setup {
catch {interp delete a}
+} -body {
interp create a
interp create {a b}
interp eval a {
proc foo args {error $args}
}
interp alias {a b} foo a foo
- set l [interp eval {a b} {
- set l {}
- lappend l [catch {foo 1 2 3} msg]
- lappend l $msg
- lappend l [catch {foo 3 4 5} msg]
- lappend l $msg
- set l
- }]
+ interp eval {a b} {
+ lappend l [catch {foo 1 2 3} msg] $msg
+ lappend l [catch {foo 3 4 5} msg] $msg
+ }
+} -cleanup {
interp delete a
- set l
-} {1 {1 2 3} 1 {3 4 5}}
-test interp-24.4 {result resetting on error} {
+} -result {1 {1 2 3} 1 {3 4 5}}
+test interp-24.4 {result resetting on error} -setup {
catch {interp delete a}
+} -body {
interp create a -safe
interp create {a b}
interp eval a {
proc foo args {error $args}
}
interp alias {a b} foo a foo
- set l [interp eval {a b} {
- set l {}
+ interp eval {a b} {
lappend l [catch {foo 1 2 3} msg]
lappend l $msg
lappend l [catch {foo 3 4 5} msg]
lappend l $msg
- set l
- }]
+ }
+} -cleanup {
interp delete a
- set l
-} {1 {1 2 3} 1 {3 4 5}}
-test interp-24.5 {result resetting on error} {
+} -result {1 {1 2 3} 1 {3 4 5}}
+test interp-24.5 {result resetting on error} -setup {
catch {interp delete a}
catch {interp delete b}
+} -body {
interp create a
interp create b
interp eval a {
proc foo args {error $args}
}
interp alias b foo a foo
- set l [interp eval b {
- set l {}
- lappend l [catch {foo 1 2 3} msg]
- lappend l $msg
- lappend l [catch {foo 3 4 5} msg]
- lappend l $msg
- set l
- }]
+ interp eval b {
+ lappend l [catch {foo 1 2 3} msg] $msg
+ lappend l [catch {foo 3 4 5} msg] $msg
+ }
+} -cleanup {
interp delete a
- set l
-} {1 {1 2 3} 1 {3 4 5}}
-test interp-24.6 {result resetting on error} {
+ interp delete b
+} -result {1 {1 2 3} 1 {3 4 5}}
+test interp-24.6 {result resetting on error} -setup {
catch {interp delete a}
catch {interp delete b}
+} -body {
interp create a -safe
interp create b -safe
interp eval a {
proc foo args {error $args}
}
interp alias b foo a foo
- set l [interp eval b {
- set l {}
- lappend l [catch {foo 1 2 3} msg]
- lappend l $msg
- lappend l [catch {foo 3 4 5} msg]
- lappend l $msg
- set l
- }]
+ interp eval b {
+ lappend l [catch {foo 1 2 3} msg] $msg
+ lappend l [catch {foo 3 4 5} msg] $msg
+ }
+} -cleanup {
interp delete a
- set l
-} {1 {1 2 3} 1 {3 4 5}}
-test interp-24.7 {result resetting on error} {
+ interp delete b
+} -result {1 {1 2 3} 1 {3 4 5}}
+test interp-24.7 {result resetting on error} -setup {
catch {interp delete a}
+ set l {}
+} -body {
interp create a
interp eval a {
proc foo args {error $args}
}
- set l {}
- lappend l [catch {interp eval a foo 1 2 3} msg]
- lappend l $msg
- lappend l [catch {interp eval a foo 3 4 5} msg]
- lappend l $msg
+ lappend l [catch {interp eval a foo 1 2 3} msg] $msg
+ lappend l [catch {interp eval a foo 3 4 5} msg] $msg
+} -cleanup {
interp delete a
- set l
-} {1 {1 2 3} 1 {3 4 5}}
-test interp-24.8 {result resetting on error} {
+} -result {1 {1 2 3} 1 {3 4 5}}
+test interp-24.8 {result resetting on error} -setup {
catch {interp delete a}
+ set l {}
+} -body {
interp create a -safe
interp eval a {
proc foo args {error $args}
}
- set l {}
- lappend l [catch {interp eval a foo 1 2 3} msg]
- lappend l $msg
- lappend l [catch {interp eval a foo 3 4 5} msg]
- lappend l $msg
+ lappend l [catch {interp eval a foo 1 2 3} msg] $msg
+ lappend l [catch {interp eval a foo 3 4 5} msg] $msg
+} -cleanup {
interp delete a
- set l
-} {1 {1 2 3} 1 {3 4 5}}
-test interp-24.9 {result resetting on error} {
+} -result {1 {1 2 3} 1 {3 4 5}}
+test interp-24.9 {result resetting on error} -setup {
catch {interp delete a}
+ set l {}
+} -body {
interp create a
interp create {a b}
interp eval {a b} {
@@ -1954,16 +1938,15 @@ test interp-24.9 {result resetting on error} {
eval interp eval b foo $args
}
}
- set l {}
- lappend l [catch {interp eval a foo 1 2 3} msg]
- lappend l $msg
- lappend l [catch {interp eval a foo 3 4 5} msg]
- lappend l $msg
+ lappend l [catch {interp eval a foo 1 2 3} msg] $msg
+ lappend l [catch {interp eval a foo 3 4 5} msg] $msg
+} -cleanup {
interp delete a
- set l
-} {1 {1 2 3} 1 {3 4 5}}
-test interp-24.10 {result resetting on error} {
+} -result {1 {1 2 3} 1 {3 4 5}}
+test interp-24.10 {result resetting on error} -setup {
catch {interp delete a}
+ set l {}
+} -body {
interp create a -safe
interp create {a b}
interp eval {a b} {
@@ -1974,16 +1957,14 @@ test interp-24.10 {result resetting on error} {
eval interp eval b foo $args
}
}
- set l {}
- lappend l [catch {interp eval a foo 1 2 3} msg]
- lappend l $msg
- lappend l [catch {interp eval a foo 3 4 5} msg]
- lappend l $msg
+ lappend l [catch {interp eval a foo 1 2 3} msg] $msg
+ lappend l [catch {interp eval a foo 3 4 5} msg] $msg
+} -cleanup {
interp delete a
- set l
-} {1 {1 2 3} 1 {3 4 5}}
-test interp-24.11 {result resetting on error} {
+} -result {1 {1 2 3} 1 {3 4 5}}
+test interp-24.11 {result resetting on error} -setup {
catch {interp delete a}
+} -body {
interp create a
interp create {a b}
interp eval {a b} {
@@ -1991,20 +1972,17 @@ test interp-24.11 {result resetting on error} {
}
interp eval a {
proc foo args {
- set l {}
- lappend l [catch {eval interp eval b foo $args} msg]
- lappend l $msg
- lappend l [catch {eval interp eval b foo $args} msg]
- lappend l $msg
- set l
+ lappend l [catch {eval interp eval b foo $args} msg] $msg
+ lappend l [catch {eval interp eval b foo $args} msg] $msg
}
}
- set l [interp eval a foo 1 2 3]
+ interp eval a foo 1 2 3
+} -cleanup {
interp delete a
- set l
-} {1 {1 2 3} 1 {1 2 3}}
-test interp-24.12 {result resetting on error} {
+} -result {1 {1 2 3} 1 {1 2 3}}
+test interp-24.12 {result resetting on error} -setup {
catch {interp delete a}
+} -body {
interp create a -safe
interp create {a b}
interp eval {a b} {
@@ -2012,27 +1990,22 @@ test interp-24.12 {result resetting on error} {
}
interp eval a {
proc foo args {
- set l {}
- lappend l [catch {eval interp eval b foo $args} msg]
- lappend l $msg
- lappend l [catch {eval interp eval b foo $args} msg]
- lappend l $msg
- set l
+ lappend l [catch {eval interp eval b foo $args} msg] $msg
+ lappend l [catch {eval interp eval b foo $args} msg] $msg
}
}
- set l [interp eval a foo 1 2 3]
+ interp eval a foo 1 2 3
+} -cleanup {
interp delete a
- set l
-} {1 {1 2 3} 1 {1 2 3}}
+} -result {1 {1 2 3} 1 {1 2 3}}
-unset hidden_cmds
-
-test interp-25.1 {testing aliasing of string commands} {
+test interp-25.1 {testing aliasing of string commands} -setup {
catch {interp delete a}
+} -body {
interp create a
a alias exec foo ;# Relies on exec being a string command!
interp delete a
-} ""
+} -result ""
#
# Interps result transmission
@@ -3058,7 +3031,7 @@ test interp-31.1 {alias invocation scope} {
myNewSet a $value
return $a
}
- catch {unset a}
+ unset -nocomplain a
set result [testMyNewSet "ok"]
rename testMyNewSet {}
rename mySet {}
@@ -3580,7 +3553,7 @@ test interp-36.7 {SlaveBgerror sets error handler of slave [1999035]} -setup {
set result
} -cleanup {
variable result {}
- unset result
+ unset -nocomplain result
interp delete slave
} -result foo
@@ -3593,7 +3566,7 @@ test interp-37.1 {safe interps and min() and max(): Bug 2895741} -setup {
lappend result [interp eval a {expr min(5,2,3)*max(7,13,11)}]
lappend result [interp eval {a b} {expr min(5,2,3)*max(7,13,11)}]
} -cleanup {
- unset result
+ unset -nocomplain result
interp delete a
} -result {26 26}
@@ -3614,7 +3587,7 @@ test interp-38.2 {interp debug env var} -setup {
} -body {
interp debug a
} -cleanup {
- unset ::env(TCL_INTERP_DEBUG_FRAME)
+ unset -nocomplain ::env(TCL_INTERP_DEBUG_FRAME)
interp delete a
} -result {-frame 1}
test interp-38.3 {interp debug wrong args} -body {
@@ -3642,6 +3615,7 @@ test interp-38.8 {interp debug basic setup} -body {
# cleanup
+unset -nocomplain hidden_cmds
foreach i [interp slaves] {
interp delete $i
}