diff options
| -rw-r--r-- | ChangeLog | 5 | ||||
| -rw-r--r-- | tests/dict.test | 134 | ||||
| -rw-r--r-- | tests/expr.test | 19 |
3 files changed, 156 insertions, 2 deletions
@@ -1,5 +1,10 @@ 2004-10-08 Donal K. Fellows <donal.k.fellows@man.ac.uk> + * tests/expr.test: Basic tests of 'in' and 'ni' behaviour. + + * tests/dict.test (dict-21.*,dict-22.*): Tests for [dict update] + and [dict with]. + * generic/tclExecute.c (TclExecuteByteCode): Implementation of the INST_LIST_IN and INST_LIST_NOT_IN bytecodes. * generic/tclParseExpr.c (GetLexeme): Parse the 'in' and 'ni' diff --git a/tests/dict.test b/tests/dict.test index bdb4531..b8ad05d 100644 --- a/tests/dict.test +++ b/tests/dict.test @@ -9,7 +9,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: dict.test,v 1.9 2004/10/08 16:28:03 dgp Exp $ +# RCS: @(#) $Id: dict.test,v 1.10 2004/10/08 21:10:36 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -894,6 +894,138 @@ test dict-20.10 {dict merge command} { getOrder [dict merge {a b c d e f} {a x 1 2 3 4} {a - 1 -}] a c e 1 3 } {a - c d e f 1 - 3 4 5} +test dict-21.1 {dict update command} -body { + dict update +} -returnCodes 1 -result {wrong # args: should be "dict update varName key varName ?key varName ...? script"} +test dict-21.2 {dict update command} -body { + dict update v +} -returnCodes 1 -result {wrong # args: should be "dict update varName key varName ?key varName ...? script"} +test dict-21.3 {dict update command} -body { + dict update v k +} -returnCodes 1 -result {wrong # args: should be "dict update varName key varName ?key varName ...? script"} +test dict-21.4 {dict update command} -body { + dict update v k v +} -returnCodes 1 -result {wrong # args: should be "dict update varName key varName ?key varName ...? script"} +test dict-21.5 {dict update command} { + set a {b c} + set result {} + set bb {} + dict update a b bb { + lappend result $a $bb + } + lappend result $a +} {{b c} c {b c}} +test dict-21.6 {dict update command} { + set a {b c} + set result {} + set bb {} + dict update a b bb { + lappend result $a $bb [set bb d] + } + lappend result $a +} {{b c} c d {b d}} +test dict-21.7 {dict update command} { + set a {b c} + set result {} + set bb {} + dict update a b bb { + lappend result $a $bb [unset bb] + } + lappend result $a +} {{b c} c {} {}} +test dict-21.8 {dict update command} { + set a {b c d e} + dict update a b v1 d v2 { + lassign "$v1 $v2" v2 v1 + } + getOrder $a b d +} {b e d c 2} +test dict-21.9 {dict update command} { + set a {b c d e} + dict update a b v1 d v2 {unset a} + info exist a +} 0 +test dict-21.10 {dict update command} { + set a {b {c d}} + dict update a b v1 { + dict update v1 c v2 { + set v2 foo + } + } + set a +} {b {c foo}} +test dict-21.11 {dict update command} { + set a {b c d e} + dict update a b v1 d v2 { + dict set a f g + } + getOrder a b d f +} {b c d e f g 3} +test dict-21.12 {dict update command} { + set a {b c d e} + dict update a b v1 d v2 f v3 { + set v3 g + } + getOrder a b d f +} {b c d e f g 3} + +test dict-22.1 {dict with command} -body { + dict with +} -returnCodes 1 -result {wrong # args: should be "dict with dictVar ?key ...? script"} +test dict-22.2 {dict with command} -body { + dict with v +} -returnCodes 1 -result {wrong # args: should be "dict with dictVar ?key ...? script"} +test dict-22.3 {dict with command} -body { + catch {unset v} + dict with v {error "in body"} +} -returnCodes 1 -result {can't read "v": no such variable} +test dict-22.4 {dict with command} { + set a {b c d e} + catch {unset b d} + set result [list [info exist b] [info exist d]] + dict with a { + lappend result [info exist b] [info exist d] $b $d + } + set result +} {0 0 1 1 c e} +test dict-22.5 {dict with command} { + set a {b c d e} + dict with a { + lassign "$b $d" d b + } + getOrder $a b d +} {b e d c 2} +test dict-22.6 {dict with command} { + set a {b c d e} + dict with a { + unset b + # This *won't* go into the dict... + set f g + } + set a +} {d e} +test dict-22.7 {dict with command} { + set a {b c d e} + dict with a { + dict unset a b + } + getOrder a b d +} {b c d e 2} +test dict-22.8 {dict with command} { + set a [dict create b c] + dict with a { + set b $a + } + set a +} {b {b c}} +test dict-22.9 {dict with command} { + set a {b {c d}} + dict with a b { + set c $c$c + } + set a +} {b {c dd}} + # cleanup ::tcltest::cleanupTests return diff --git a/tests/expr.test b/tests/expr.test index 4cc644e..9e70447 100644 --- a/tests/expr.test +++ b/tests/expr.test @@ -10,7 +10,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: expr.test,v 1.28 2004/10/04 13:56:37 dkf Exp $ +# RCS: @(#) $Id: expr.test,v 1.29 2004/10/08 21:10:36 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -875,6 +875,23 @@ test expr-24.7 {expr edge cases; shifting} {expr wide(5)<<32} 21474836480 test expr-24.8 {expr edge cases; shifting} {expr wide(10)<<63} 0 test expr-24.9 {expr edge cases; shifting} {expr 5>>32} 0 +# List membership tests +test expr-25.1 {'in' operator} {expr {"a" in "a b c"}} 1 +test expr-25.2 {'in' operator} {expr {"a" in "b a c"}} 1 +test expr-25.3 {'in' operator} {expr {"a" in "b c a"}} 1 +test expr-25.4 {'in' operator} {expr {"a" in ""}} 0 +test expr-25.5 {'in' operator} {expr {"" in {a b c ""}}} 1 +test expr-25.6 {'in' operator} {expr {"" in "a b c"}} 0 +test expr-25.7 {'in' operator} {expr {"" in ""}} 0 + +test expr-26.1 {'ni' operator} {expr {"a" ni "a b c"}} 0 +test expr-26.2 {'ni' operator} {expr {"a" ni "b a c"}} 0 +test expr-26.3 {'ni' operator} {expr {"a" ni "b c a"}} 0 +test expr-26.4 {'ni' operator} {expr {"a" ni ""}} 1 +test expr-26.5 {'ni' operator} {expr {"" ni {a b c ""}}} 0 +test expr-26.6 {'ni' operator} {expr {"" ni "a b c"}} 1 +test expr-26.7 {'ni' operator} {expr {"" ni ""}} 1 + # cleanup if {[info exists a]} { unset a |