summaryrefslogtreecommitdiffstats
path: root/tests/cmdIL.test
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2004-01-17 00:28:07 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2004-01-17 00:28:07 (GMT)
commit09472fab726b19e26a46d7b05426356a1ceff8cd (patch)
tree400fb6a62c9934846c003b2748698b373c84358b /tests/cmdIL.test
parentadba9fe738d1390234b5d5bbb461df81d094ea7e (diff)
downloadtcl-09472fab726b19e26a46d7b05426356a1ceff8cd.zip
tcl-09472fab726b19e26a46d7b05426356a1ceff8cd.tar.gz
tcl-09472fab726b19e26a46d7b05426356a1ceff8cd.tar.bz2
Basic implementation of TIP#57 - TclX's [lassign] command into Tcl core
Not a direct copy * Better use of Tcl object API * More extensive test suite * More extensive documentation
Diffstat (limited to 'tests/cmdIL.test')
-rw-r--r--tests/cmdIL.test84
1 files changed, 83 insertions, 1 deletions
diff --git a/tests/cmdIL.test b/tests/cmdIL.test
index e008dfd..94dd24f 100644
--- a/tests/cmdIL.test
+++ b/tests/cmdIL.test
@@ -8,13 +8,16 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: cmdIL.test,v 1.18 2003/11/10 18:30:41 dkf Exp $
+# RCS: @(#) $Id: cmdIL.test,v 1.19 2004/01/17 00:28:08 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
namespace import -force ::tcltest::*
}
+# Used for constraining memory leak tests
+testConstraint memory [llength [info commands memory]]
+
test cmdIL-1.1 {Tcl_LsortObjCmd procedure} {
list [catch {lsort} msg] $msg
} {1 {wrong # args: should be "lsort ?options? list"}}
@@ -417,6 +420,85 @@ test cmdIL-5.5 {lsort with list style index and sharing} -body {
rename test_lsort ""
}
+test cmdIL-6.1 {lassign command syntax} -body {
+ lassign
+} -code 1 -result {wrong # args: should be "lassign list varname ?varname ...?"}
+test cmdIL-6.2 {lassign command syntax} -body {
+ lassign x
+} -code 1 -result {wrong # args: should be "lassign list varname ?varname ...?"}
+test cmdIL-6.3 {lassign command} {
+ set x FAIL
+ list [lassign a x] $x
+} {{} a}
+test cmdIL-6.4 {lassign command} {
+ set x FAIL
+ set y FAIL
+ list [lassign a x y] $x $y
+} {{} a {}}
+test cmdIL-6.5 {lassign command} {
+ set x FAIL
+ set y FAIL
+ list [lassign {a b} x y] $x $y
+} {{} a b}
+test cmdIL-6.6 {lassign command} {
+ set x FAIL
+ set y FAIL
+ list [lassign {a b c} x y] $x $y
+} {c a b}
+test cmdIL-6.7 {lassign command} {
+ set x FAIL
+ set y FAIL
+ list [lassign {a b c d} x y] $x $y
+} {{c d} a b}
+test cmdIL-6.8 {lassign command - list format error} {
+ set x FAIL
+ set y FAIL
+ list [catch {lassign {a {b}c d} x y} msg] $msg $x $y
+} {1 {list element in braces followed by "c" instead of space} FAIL FAIL}
+catch {unset x y}
+test cmdIL-6.9 {lassign command - assignment to arrays} {
+ list [lassign {a b} x(x)] $x(x)
+} {b a}
+test cmdIL-6.10 {lassign command - variable update error} -body {
+ set x(x) {}
+ lassign a x
+} -code 1 -result {can't set "x": variable is array} -cleanup {
+ unset x
+}
+test cmdIL-6.11 {lassign command - variable update error} -body {
+ set x(x) {}
+ set y FAIL
+ list [catch {lassign a y x} msg] $msg $y
+} -result {1 {can't set "x": variable is array} a} -cleanup {
+ unset x
+}
+test cmdIL-6.12 {lassign command - memory leak testing} -setup {
+ set x(x) {}
+ set y FAIL
+ proc getbytes {} {
+ set lines [split [memory info] "\n"]
+ lindex [lindex $lines 3] 3
+ }
+ proc stress {} {
+ global x y
+ lassign {} y y y y y y y y y y y y y y y y y y y y y y y y y y y y y y
+ catch {lassign {} y y y y y y y y y y y y y y y y y y y y y y y y y x}
+ catch {lassign {} x}
+ }
+} -constraints memory -body {
+ set end [getbytes]
+ for {set i 0} {$i < 5} {incr i} {
+ stress
+ set tmp $end
+ set end [getbytes]
+ }
+ expr {$end - $tmp}
+} -result 0 -cleanup {
+ unset -nocomplain x y i tmp end
+ rename getbytes {}
+ rename stress {}
+}
+
# cleanup
::tcltest::cleanupTests
return