path: root/tests/dict.test

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-5.3 {Dict with return value} {
	proc a {} {
		set x [dict create a b c d]
		dict with x {
			set a B
			unset c
			# dict with should return the script return value
			set retvalue ok
		}
	}
	a
} {ok}

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