diff options
Diffstat (limited to 'tests/cmdIL.test')
| -rw-r--r-- | tests/cmdIL.test | 311 |
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: |