summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog5
-rw-r--r--tests/dict.test134
-rw-r--r--tests/expr.test19
3 files changed, 156 insertions, 2 deletions
diff --git a/ChangeLog b/ChangeLog
index 203ee3b..a3030ba 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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