Full bytecode compilation for [lassign]

FossilOrigin-Name: 9a1a37c9ae8a0c2d9d0ec664e9850a5c7e944a12

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: