Basic tests for TIPs #201 and #212

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