summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2004-01-18 16:19:03 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2004-01-18 16:19:03 (GMT)
commit4d5446b2dadf9bbe0dfc6c385e6c235a529251c5 (patch)
treefa948ad9dd4df78fe41cf6e4a405ece09de5eabe /tests
parent2dbb65a3ede972c2fa6b8527eb2ce3a0ca0bfddc (diff)
downloadtcl-4d5446b2dadf9bbe0dfc6c385e6c235a529251c5.zip
tcl-4d5446b2dadf9bbe0dfc6c385e6c235a529251c5.tar.gz
tcl-4d5446b2dadf9bbe0dfc6c385e6c235a529251c5.tar.bz2
Full bytecode compilation for [lassign]
Diffstat (limited to 'tests')
-rw-r--r--tests/cmdIL.test311
1 files changed, 262 insertions, 49 deletions
diff --git a/tests/cmdIL.test b/tests/cmdIL.test
index c7a8b65..e9b1432 100644
--- a/tests/cmdIL.test
+++ b/tests/cmdIL.test
@@ -8,7 +8,7 @@
# 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.21 2004/01/17 00:52:18 dkf Exp $
+# RCS: @(#) $Id: cmdIL.test,v 1.22 2004/01/18 16:19:06 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -420,59 +420,111 @@ test cmdIL-5.5 {lsort with list style index and sharing} -body {
rename test_lsort ""
}
+# Compiled version
test cmdIL-6.1 {lassign command syntax} -body {
- lassign
-} -returnCodes 1 -result {wrong # args: should be "lassign list varname ?varname ...?"}
+ proc testLassign {} {
+ lassign
+ }
+ testLassign
+} -returnCodes 1 -cleanup {
+ rename testLassign {}
+} -result {wrong # args: should be "lassign list varname ?varname ...?"}
test cmdIL-6.2 {lassign command syntax} -body {
- lassign x
-} -returnCodes 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}
+ proc testLassign {} {
+ lassign x
+ }
+ testLassign
+} -returnCodes 1 -cleanup {
+ rename testLassign {}
+} -result {wrong # args: should be "lassign list varname ?varname ...?"}
+test cmdIL-6.3 {lassign command} -body {
+ proc testLassign {} {
+ set x FAIL
+ list [lassign a x] $x
+ }
+ testLassign
+} -result {{} a} -cleanup {
+ rename testLassign {}
+}
+test cmdIL-6.4 {lassign command} -body {
+ proc testLassign {} {
+ set x FAIL
+ set y FAIL
+ list [lassign a x y] $x $y
+ }
+ testLassign
+} -result {{} a {}} -cleanup {
+ rename testLassign {}
+}
+test cmdIL-6.5 {lassign command} -body {
+ proc testLassign {} {
+ set x FAIL
+ set y FAIL
+ list [lassign {a b} x y] $x $y
+ }
+ testLassign
+} -result {{} a b} -cleanup {
+ rename testLassign {}
+}
+test cmdIL-6.6 {lassign command} -body {
+ proc testLassign {} {
+ set x FAIL
+ set y FAIL
+ list [lassign {a b c} x y] $x $y
+ }
+ testLassign
+} -result {c a b} -cleanup {
+ rename testLassign {}
+}
+test cmdIL-6.7 {lassign command} -body {
+ proc testLassign {} {
+ set x FAIL
+ set y FAIL
+ list [lassign {a b c d} x y] $x $y
+ }
+ testLassign
+} -result {{c d} a b} -cleanup {
+ rename testLassign {}
+}
+test cmdIL-6.8 {lassign command - list format error} -body {
+ proc testLassign {} {
+ set x FAIL
+ set y FAIL
+ list [catch {lassign {a {b}c d} x y} msg] $msg $x $y
+ }
+ testLassign
+} -result {1 {list element in braces followed by "c" instead of space} FAIL FAIL} -cleanup {
+ rename testLassign {}
+}
+test cmdIL-6.9 {lassign command - assignment to arrays} -body {
+ proc testLassign {} {
+ list [lassign {a b} x(x)] $x(x)
+ }
+ testLassign
+} -result {b a} -cleanup {
+ rename testLassign {}
+}
test cmdIL-6.10 {lassign command - variable update error} -body {
- set x(x) {}
- lassign a x
+ proc testLassign {} {
+ set x(x) {}
+ lassign a x
+ }
+ testLassign
} -returnCodes 1 -result {can't set "x": variable is array} -cleanup {
- unset x
+ rename testLassign {}
}
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
+ proc testLassign {} {
+ set x(x) {}
+ set y FAIL
+ list [catch {lassign a y x} msg] $msg $y
+ }
+ testLassign
} -result {1 {can't set "x": variable is array} a} -cleanup {
- unset x
+ rename testLassign {}
}
test cmdIL-6.12 {lassign command - memory leak testing} -setup {
+ unset -nocomplain x y
set x(x) {}
set y FAIL
proc getbytes {} {
@@ -498,11 +550,172 @@ test cmdIL-6.12 {lassign command - memory leak testing} -setup {
rename getbytes {}
rename stress {}
}
-test cmdIL-6.13 {lassign command - shimmering protection} {
- set x {a b c}
- list [lassign $x $x y] $x [set $x] $y
-} {c {a b c} a b}
+# Force non-compiled version
+test cmdIL-6.13 {lassign command syntax} -body {
+ proc testLassign {} {
+ set lassign lassign
+ $lassign
+ }
+ testLassign
+} -returnCodes 1 -cleanup {
+ rename testLassign {}
+} -result {wrong # args: should be "lassign list varname ?varname ...?"}
+test cmdIL-6.14 {lassign command syntax} -body {
+ proc testLassign {} {
+ set lassign lassign
+ $lassign x
+ }
+ testLassign
+} -returnCodes 1 -cleanup {
+ rename testLassign {}
+} -result {wrong # args: should be "lassign list varname ?varname ...?"}
+test cmdIL-6.15 {lassign command} -body {
+ proc testLassign {} {
+ set lassign lassign
+ set x FAIL
+ list [$lassign a x] $x
+ }
+ testLassign
+} -result {{} a} -cleanup {
+ rename testLassign {}
+}
+test cmdIL-6.16 {lassign command} -body {
+ proc testLassign {} {
+ set lassign lassign
+ set x FAIL
+ set y FAIL
+ list [$lassign a x y] $x $y
+ }
+ testLassign
+} -result {{} a {}} -cleanup {
+ rename testLassign {}
+}
+test cmdIL-6.17 {lassign command} -body {
+ proc testLassign {} {
+ set lassign lassign
+ set x FAIL
+ set y FAIL
+ list [$lassign {a b} x y] $x $y
+ }
+ testLassign
+} -result {{} a b} -cleanup {
+ rename testLassign {}
+}
+test cmdIL-6.18 {lassign command} -body {
+ proc testLassign {} {
+ set lassign lassign
+ set x FAIL
+ set y FAIL
+ list [$lassign {a b c} x y] $x $y
+ }
+ testLassign
+} -result {c a b} -cleanup {
+ rename testLassign {}
+}
+test cmdIL-6.19 {lassign command} -body {
+ proc testLassign {} {
+ set lassign lassign
+ set x FAIL
+ set y FAIL
+ list [$lassign {a b c d} x y] $x $y
+ }
+ testLassign
+} -result {{c d} a b} -cleanup {
+ rename testLassign {}
+}
+test cmdIL-6.20 {lassign command - list format error} -body {
+ proc testLassign {} {
+ set lassign lassign
+ set x FAIL
+ set y FAIL
+ list [catch {$lassign {a {b}c d} x y} msg] $msg $x $y
+ }
+ testLassign
+} -result {1 {list element in braces followed by "c" instead of space} FAIL FAIL} -cleanup {
+ rename testLassign {}
+}
+test cmdIL-6.21 {lassign command - assignment to arrays} -body {
+ proc testLassign {} {
+ set lassign lassign
+ list [$lassign {a b} x(x)] $x(x)
+ }
+ testLassign
+} -result {b a} -cleanup {
+ rename testLassign {}
+}
+test cmdIL-6.22 {lassign command - variable update error} -body {
+ proc testLassign {} {
+ set lassign lassign
+ set x(x) {}
+ $lassign a x
+ }
+ testLassign
+} -returnCodes 1 -result {can't set "x": variable is array} -cleanup {
+ rename testLassign {}
+}
+test cmdIL-6.23 {lassign command - variable update error} -body {
+ proc testLassign {} {
+ set lassign lassign
+ set x(x) {}
+ set y FAIL
+ list [catch {$lassign a y x} msg] $msg $y
+ }
+ testLassign
+} -result {1 {can't set "x": variable is array} a} -cleanup {
+ rename testLassign {}
+}
+test cmdIL-6.24 {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
+ set lassign lassign
+ $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 {}
+}
+# Assorted shimmering problems
+test cmdIL-6.25 {lassign command - shimmering protection} -body {
+ proc testLassign {} {
+ set x {a b c}
+ list [lassign $x $x y] $x [set $x] $y
+ }
+ testLassign
+} -result {c {a b c} a b} -cleanup {
+ rename testLassign {}
+}
+test cmdIL-6.26 {lassign command - shimmering protection} -body {
+ proc testLassign {} {
+ set x {a b c}
+ set lassign lassign
+ list [$lassign $x $x y] $x [set $x] $y
+ }
+ testLassign
+} -result {c {a b c} a b} -cleanup {
+ rename testLassign {}
+}
# cleanup
::tcltest::cleanupTests
return
+
+# Local Variables:
+# mode: tcl
+# End: