diff options
| -rw-r--r-- | doc/jim_tcl.txt | 15 | ||||
| -rw-r--r-- | tcl6.tcl | 20 | ||||
| -rw-r--r-- | tests/testing.tcl | 16 |
3 files changed, 35 insertions, 16 deletions
diff --git a/doc/jim_tcl.txt b/doc/jim_tcl.txt index ebac242..eb07e84 100644 --- a/doc/jim_tcl.txt +++ b/doc/jim_tcl.txt @@ -43,7 +43,7 @@ The major differences are: 6. Builtin dictionary type (dict) 7. file mkdir, file rename, file tempfile (Tcl 7.x, 8.x) 8. env command to access environment variables -9. List: lmap, lset, lreverse (Tcl 8.x) +9. List: lmap, lset, lreverse, lassign (Tcl 8.x) 10. os.fork, os.wait, rand 11. \{*\}/\{expand\} 12. string map (Tcl 7.x) @@ -2032,6 +2032,19 @@ For example, 'lappend a $b' is much more efficient than when '$a' is long. +lassign +~~~~~~~ ++*lassign* 'list varName ?varName? ...'+ + +This command treats the value *list* as a list and assigns successive elements from that list to +the variables given by the *varName* arguments in order. If there are more variable names than +list elements, the remaining variables are set to the empty string. If there are more list ele- +ments than variables, a list of unassigned elements is returned. + + jim> lassign {1 2 3} a b; puts a=$a,b=$b + 3 + a=1,b=2 + lindex ~~~~~~ +*lindex* 'list index'+ @@ -20,6 +20,12 @@ proc lsearch {list value} { return -1 } +# Tcl 8.5 lassign +proc lassign {list args} { + uplevel 1 [list foreach $args [concat $list {}] break] + lrange $list [llength $args] end +} + # Internal function to match a value agains a list of patterns proc _case_search_patterns {patterns value} { set i 0 @@ -70,19 +76,19 @@ proc case {var args} { # Optional argument is a glob pattern proc parray {arrayname {pattern *}} { - upvar $arrayname a + upvar $arrayname a set max 0 - foreach name [array names a $pattern]] { + foreach name [array names a $pattern]] { if {[string length $name] > $max} { set max [string length $name] } - } - incr max [string length $arrayname] - incr max 2 - foreach name [lsort [array names a $pattern]] { + } + incr max [string length $arrayname] + incr max 2 + foreach name [lsort [array names a $pattern]] { puts [format "%-${max}s = %s" $arrayname\($name\) $a($name)] - } + } } # Sort of replacement for $::errorInfo diff --git a/tests/testing.tcl b/tests/testing.tcl index 2adacdd..4956450 100644 --- a/tests/testing.tcl +++ b/tests/testing.tcl @@ -4,7 +4,7 @@ # e.g. bio copy [autoopen infile] [autoopen outfile w]; collect # proc autoopen {filename {mode r}} { - set ref [ref [open.old $filename $mode] aio lambdaFinalizer] + set ref [ref [open $filename $mode] aio lambdaFinalizer] rename [getref $ref] $ref return $ref } @@ -22,19 +22,19 @@ proc section {name} { array set testresults {numfail 0 numpass 0 failed {}} proc test {id descr script expected} { - puts -nonewline "$id " - set rc [catch {uplevel 1 $script} result] + puts -nonewline "$id " + set rc [catch {uplevel 1 $script} result] # Note that rc=2 is return - if {($rc == 0 || $rc == 2) && $result eq $expected} { + if {($rc == 0 || $rc == 2) && $result eq $expected} { puts "OK $descr" incr ::testresults(numpass) - } else { + } else { puts "ERR $descr" puts "Expected: '$expected'" - puts "Got : '$result'" + puts "Got : '$result'" incr ::testresults(numfail) - lappend ::testresults(failed) [list $id $descr $script $expected $result] - } + lappend ::testresults(failed) [list $id $descr $script $expected $result] + } } proc testreport {} { |