396 lines
10 KiB
Plaintext
396 lines
10 KiB
Plaintext
source [file dirname [info script]]/testing.tcl
|
|
|
|
test dict-1.1 "Basic dict" {
|
|
set d [dict create]
|
|
dict set d fruit apple
|
|
dict set d car holden
|
|
#puts "d=$d"
|
|
#puts "d(fruit)=$d(fruit)"
|
|
dict get $d car
|
|
} {holden}
|
|
|
|
catch {unset d}
|
|
|
|
test dict-2.1 "Dict via reference" references {
|
|
set d [dict create]
|
|
dict set d fruit apple
|
|
dict set d car holden
|
|
|
|
# now create a dictionary reference
|
|
set dref [ref $d dict]
|
|
dict get [getref $dref] car
|
|
} {holden}
|
|
|
|
test dict-2.2 "Modify dict via reference" references {
|
|
# Get the value out of the refernence
|
|
set d [getref $dref]
|
|
# Modify it
|
|
dict set d car toyota
|
|
# And put the new value back
|
|
setref $dref $d
|
|
# Finally check it
|
|
dict get [getref $dref] car
|
|
} {toyota}
|
|
|
|
test dict-2.3 "Modify dict via reference - one line" references {
|
|
# Get the value out of the refernence
|
|
set d [getref $dref]
|
|
setref $dref [dict set d car toyota]
|
|
# Finally check it
|
|
dict get [getref $dref] car
|
|
} {toyota}
|
|
|
|
# Sort a dictionary in key order - return a list
|
|
proc dictsort {dict} {
|
|
set result {}
|
|
foreach k [lsort [dict keys $dict]] {
|
|
lappend result $k [dict get $dict $k]
|
|
}
|
|
return $result
|
|
}
|
|
|
|
set a [dict create a 1 b 2]
|
|
set b [dict create b 3 c 4]
|
|
test dict-3.1 {Merge} {
|
|
dict merge
|
|
} {}
|
|
test dict-3.2 {Merge} {
|
|
dictsort [dict merge $a]
|
|
} {a 1 b 2}
|
|
test dict-3.3 {Merge} {
|
|
dictsort [dict merge $b]
|
|
} {b 3 c 4}
|
|
test dict-3.4 {Merge} {
|
|
dictsort [dict merge $a $b]
|
|
} {a 1 b 3 c 4}
|
|
test dict-3.5 {Merge} {
|
|
dictsort [dict merge $b $a]
|
|
} {a 1 b 2 c 4}
|
|
test dict-3.6 {Merge} {
|
|
dictsort [dict merge $b $a {a 5}]
|
|
} {a 5 b 2 c 4}
|
|
test dict-3.7 {Merge} {
|
|
dictsort [dict merge {a 5} $b $a]
|
|
} {a 1 b 2 c 4}
|
|
test dict-3.8 {Merge} {
|
|
catch {dict merge 1 $b $a}
|
|
} 1
|
|
test dict-3.9 {Merge} {
|
|
catch {dict merge $b 1 $a}
|
|
} 1
|
|
test dict-3.10 {Merge} {
|
|
catch {dict merge $b $a 1}
|
|
} 1
|
|
test dict-3.11 {Merge} {
|
|
catch {dict merge 1}
|
|
} 1
|
|
|
|
test dict-4.1 {Dict size} {
|
|
dict size {a b}
|
|
} 1
|
|
test dict-4.2 {Dict size} {
|
|
dict size {a b c d}
|
|
} 2
|
|
|
|
test dict-5.1 {Dict with} {
|
|
proc a {} {
|
|
set x [dict create a b c d]
|
|
dict with x {
|
|
set a B
|
|
unset c
|
|
}
|
|
set x
|
|
}
|
|
dictsort [a]
|
|
} {a B}
|
|
test dict-5.2 {Dict with} {
|
|
proc a {} {
|
|
set x [dict create a b c d]
|
|
dict with x {
|
|
set a B
|
|
unset c
|
|
}
|
|
set x
|
|
}
|
|
dictsort [a]
|
|
} {a B}
|
|
|
|
test dict-22.1 {dict with command} {
|
|
list [catch {dict with} msg] $msg
|
|
} {1 {wrong # args: should be "dict with dictVar ?key ...? script"}}
|
|
test dict-22.2 {dict with command} {
|
|
list [catch {dict with v} msg] $msg
|
|
} {1 {wrong # args: should be "dict with dictVar ?key ...? script"}}
|
|
test dict-22.3 {dict with command} {
|
|
unset -nocomplain v
|
|
list [catch {dict with v {error "in body"}} msg] $msg
|
|
} {1 {can't read "v": no such variable}}
|
|
test dict-22.4 {dict with command} {
|
|
set a {b c d e}
|
|
unset -nocomplain 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
|
|
}
|
|
dictsort $a
|
|
} {b e d c}
|
|
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
|
|
}
|
|
dictsort $a
|
|
} {b c d e}
|
|
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}}
|
|
test dict-22.10 {dict with command: result handling tricky case} {
|
|
set a {b {c d}}
|
|
foreach i {0 1} {
|
|
if {$i} break
|
|
dict with a b {
|
|
set a {}
|
|
# We're checking to see if we lose this break
|
|
break
|
|
}
|
|
}
|
|
list $i $a
|
|
} {0 {}}
|
|
test dict-22.11 {dict with command: no recursive structures [Bug 1786481]} {
|
|
set foo {t {t {t {inner 1}}}}
|
|
dict with foo {
|
|
dict with t {
|
|
dict with t {
|
|
dict with t {
|
|
incr inner
|
|
}
|
|
}
|
|
}
|
|
}
|
|
string range [append foo OK] end-1 end
|
|
} OK
|
|
|
|
test dict-23.1 {dict unset missing last level} {
|
|
set a {b c d e}
|
|
dict unset a xyz
|
|
dict size $a
|
|
} 2
|
|
|
|
test dict-23.2 {dict unset command} -returnCodes error -body {
|
|
set dictVar a
|
|
dict unset dictVar a
|
|
} -cleanup {
|
|
unset dictVar
|
|
} -result {missing value to go with key}
|
|
|
|
test dict-23.3 {dict unset command} -setup {
|
|
unset -nocomplain dictVar
|
|
} -body {
|
|
list [info exists dictVar] [dict unset dictVar a] [info exists dictVar]
|
|
} -cleanup {
|
|
unset dictVar
|
|
} -result {0 {} 1}
|
|
|
|
test dict-23.4 {dict unset command: write failure} -setup {
|
|
unset -nocomplain dictVar
|
|
} -body {
|
|
set dictVar 1
|
|
dict unset dictVar a
|
|
} -returnCodes error -cleanup {
|
|
unset dictVar
|
|
} -result {missing value to go with key}
|
|
|
|
test dict-24.1 {dict/list shimmering - Bug 3004007} {set l [list p 1 p 2 q 3];dict get $l q;set l} {p 1 p 2 q 3}
|
|
test dict-24.2 {dict/list shimmering - Bug 3004007} {set l [list p 1 p 2 q 3];dict get $l q;llength $l} 6
|
|
|
|
test dict-24.3 {dict/list shimmering with embedded nulls} {
|
|
# Must be a string containing embedded nulls that would be double quoted in string form
|
|
set binary_value 1\000\\
|
|
set dictVar [dict create value $binary_value]
|
|
lassign $dictVar k v
|
|
string length $v
|
|
} {3}
|
|
test dict-24.4 {dict/list shimmering with lappend and foreach} {
|
|
set a [list 1 2 3 4]
|
|
|
|
foreach b $a {
|
|
# convert to dict
|
|
dict size $a
|
|
# append to list
|
|
lappend a x y
|
|
}
|
|
llength $a
|
|
} 12
|
|
|
|
# As of 0.79, dicts maintain insertion order
|
|
test dict-25.1 {dict ordering} {
|
|
dict keys {a x 0 y}
|
|
} {a 0}
|
|
|
|
test dict-25.2 {dict ordering} {
|
|
dict keys {0 x a y}
|
|
} {0 a}
|
|
|
|
test dict-25.3 {dict ordering} {
|
|
set d [dict create a y 0 x 2 z]
|
|
dict set d 1 w
|
|
dict keys $d
|
|
} {a 0 2 1}
|
|
|
|
test dict-25.3 {dict ordering} {
|
|
set d [dict create a y 0 x 2 z]
|
|
dict set d 0 w
|
|
dict keys $d
|
|
} {a 0 2}
|
|
|
|
test dict-25.4 {removal of keys that hash earlier} {
|
|
set parsed {formPost {text {This is text.} {text file} Hello. {image file} abc}}
|
|
|
|
dict unset parsed formPost text
|
|
dict unset parsed formPost {image file}
|
|
dict get $parsed formPost {text file}
|
|
} Hello.
|
|
|
|
test dict-25.5 {list to dict, duplicate keys} {
|
|
set l [list a 1 a 2 a 3]
|
|
# make sure there is no string rep
|
|
lappend l b 4
|
|
dict get $l a
|
|
} {3}
|
|
|
|
# Follow Tcl, to force interpretation, not compilation.
|
|
# No effect in Jim
|
|
set dict dict
|
|
test dict-26.1 {dict getdef command} -body {
|
|
dict getdef {a b} a c
|
|
} -result b
|
|
test dict-26.2 {dict getdef command} -body {
|
|
dict getdef {a b} b c
|
|
} -result c
|
|
test dict-26.3 {dict getdef command} -body {
|
|
dict getdef {a {b c}} a b d
|
|
} -result c
|
|
test dict-26.4 {dict getdef command} -body {
|
|
dict getdef {a {b c}} a c d
|
|
} -result d
|
|
test dict-26.5 {dict getdef command} -body {
|
|
dict getdef {a {b c}} b c d
|
|
} -result d
|
|
test dict-26.6 {dict getdef command} -returnCodes error -body {
|
|
dict getdef {a {b c d}} a b d
|
|
} -result {missing value to go with key}
|
|
test dict-26.7 {dict getdef command} -returnCodes error -body {
|
|
dict getdef
|
|
} -result {wrong # args: should be "dict getdef dictionary ?key ...? key default"}
|
|
test dict-26.8 {dict getdef command} -returnCodes error -body {
|
|
dict getdef {}
|
|
} -result {wrong # args: should be "dict getdef dictionary ?key ...? key default"}
|
|
test dict-26.9 {dict getdef command} -returnCodes error -body {
|
|
dict getdef {} {}
|
|
} -result {wrong # args: should be "dict getdef dictionary ?key ...? key default"}
|
|
test dict-26.10 {dict getdef command} -returnCodes error -body {
|
|
dict getdef {a b c} d e
|
|
} -result {missing value to go with key}
|
|
test dict-26.11 {dict getdef command} -body {
|
|
$dict getdef {a b} a c
|
|
} -result b
|
|
test dict-26.12 {dict getdef command} -body {
|
|
$dict getdef {a b} b c
|
|
} -result c
|
|
test dict-26.13 {dict getdef command} -body {
|
|
$dict getdef {a {b c}} a b d
|
|
} -result c
|
|
test dict-26.14 {dict getdef command} -body {
|
|
$dict getdef {a {b c}} a c d
|
|
} -result d
|
|
test dict-26.15 {dict getdef command} -body {
|
|
$dict getdef {a {b c}} b c d
|
|
} -result d
|
|
test dict-26.16 {dict getdef command} -returnCodes error -body {
|
|
$dict getdef {a {b c d}} a b d
|
|
} -result {missing value to go with key}
|
|
test dict-26.17 {dict getdef command} -returnCodes error -body {
|
|
$dict getdef {a b c} d e
|
|
} -result {missing value to go with key}
|
|
|
|
test dict-27.1 {dict getwithdefault command} -body {
|
|
dict getwithdefault {a b} a c
|
|
} -result b
|
|
test dict-27.2 {dict getwithdefault command} -body {
|
|
dict getwithdefault {a b} b c
|
|
} -result c
|
|
test dict-27.3 {dict getwithdefault command} -body {
|
|
dict getwithdefault {a {b c}} a b d
|
|
} -result c
|
|
test dict-27.4 {dict getwithdefault command} -body {
|
|
dict getwithdefault {a {b c}} a c d
|
|
} -result d
|
|
test dict-27.5 {dict getwithdefault command} -body {
|
|
dict getwithdefault {a {b c}} b c d
|
|
} -result d
|
|
test dict-27.6 {dict getwithdefault command} -returnCodes error -body {
|
|
dict getwithdefault {a {b c d}} a b d
|
|
} -result {missing value to go with key}
|
|
test dict-27.7 {dict getwithdefault command} -returnCodes error -body {
|
|
dict getwithdefault
|
|
} -result {wrong # args: should be "dict getwithdefault dictionary ?key ...? key default"}
|
|
test dict-27.8 {dict getwithdefault command} -returnCodes error -body {
|
|
dict getwithdefault {}
|
|
} -result {wrong # args: should be "dict getwithdefault dictionary ?key ...? key default"}
|
|
test dict-27.9 {dict getwithdefault command} -returnCodes error -body {
|
|
dict getwithdefault {} {}
|
|
} -result {wrong # args: should be "dict getwithdefault dictionary ?key ...? key default"}
|
|
test dict-27.10 {dict getdef command} -returnCodes error -body {
|
|
dict getwithdefault {a b c} d e
|
|
} -result {missing value to go with key}
|
|
test dict-27.11 {dict getwithdefault command} -body {
|
|
$dict getwithdefault {a b} a c
|
|
} -result b
|
|
test dict-27.12 {dict getwithdefault command} -body {
|
|
$dict getwithdefault {a b} b c
|
|
} -result c
|
|
test dict-27.13 {dict getwithdefault command} -body {
|
|
$dict getwithdefault {a {b c}} a b d
|
|
} -result c
|
|
test dict-27.14 {dict getwithdefault command} -body {
|
|
$dict getwithdefault {a {b c}} a c d
|
|
} -result d
|
|
test dict-27.15 {dict getwithdefault command} -body {
|
|
$dict getwithdefault {a {b c}} b c d
|
|
} -result d
|
|
test dict-27.16 {dict getwithdefault command} -returnCodes error -body {
|
|
$dict getwithdefault {a {b c d}} a b d
|
|
} -result {missing value to go with key}
|
|
test dict-27.17 {dict getdef command} -returnCodes error -body {
|
|
$dict getwithdefault {a b c} d e
|
|
} -result {missing value to go with key}
|
|
|
|
testreport
|