summaryrefslogtreecommitdiffstats
path: root/tests/interp.test
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)
commit489da2848ebc51a5f56d080a52f5c1a0c4ecdfdf (patch)
treece38d69f9ab51ef0a83d6e83b49177e042a74a31 /tests/interp.test
parente6194d69361ea15a381a0b5e9f8da21bd9e21309 (diff)
downloadtcl-489da2848ebc51a5f56d080a52f5c1a0c4ecdfdf.zip
tcl-489da2848ebc51a5f56d080a52f5c1a0c4ecdfdf.tar.gz
tcl-489da2848ebc51a5f56d080a52f5c1a0c4ecdfdf.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/interp.test')
-rw-r--r--tests/interp.test328
1 files changed, 151 insertions, 177 deletions
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
}