#! /usr/bin/env tclsh
proc suite_main {} {
package require {ycl proc}
[yclprefix] proc alias [yclprefix]::proc::alias
package require {ycl dict deep}
alias [yclprefix]::dict::deep
package require {ycl list}
alias [yclprefix]::list::sl
package require {ycl string}
alias [yclprefix]::string::dedent
alias [yclprefix]::string::regsub
alias [yclprefix]::string::trim
package require {ycl test}
alias [yclprefix]::test::cleanup1
[yclprefix]::test::init
set setup1 {
set dict1 [sl {
dicta [sl {
dicta1 val1
dictb1 {{dictb1a val1}}
}]
}]
set dict2 [sl {
dicta [sl {
dictb3 val3
dictb1 {{dictb1a val2}}
}]
dictb {}
}]
}
test get_nokey {
basic test of deep
} -setup $setup1 -body {
deep get dict1
return $dict1
} -cleanup [cleanup1] -result [sl {
dicta {dicta1 val1 dictb1 {{dictb1a val1}}}
}]
test get_onekey {
one key
} -setup $setup1 -body {
deep get dict1 dicta
return $dict1
} -cleanup [cleanup1] -result [sl {
dicta1 val1 dictb1 {{dictb1a val1}}
}]
test get_onekey_notadict {
basic test of deep
} -body {
set dict1 üks
catch {deep get dict1 dicta} cres
return $cres
} -cleanup [cleanup1] -result [sl {
missing value to go with key
}]
test merge {
} -setup $setup1 -body {
set bad $dict2
lappend bad dictc
catch {deep merge dict1 bad} cres
lappend res $cres
set dict1_orig $dict1
deep merge dict1 dict2
lappend res length [dict size $dict1]
# duplicate keys are retained for values
lappend res dict1 $dict1
set res1 $dict1
deep get res1 dicta dictb3
lappend res {merged dicta dictb3} $res1
set res1 $dict1
deep get res1 dicta dictb1
lappend res {dict1 dicta dictb1} {dictb1a val1}
return $res
} -cleanup [cleanup1] -result [sl {
{missing value to go with key}
length 2
dict1 [sl {
dicta [sl {
dicta1 val1
dictb1 {{dictb1a val1}}
dictb3 val3
dictb1 {{dictb1a val2}}
}]
dictb {}
}]
{merged dicta dictb3} val3
{dict1 dicta dictb1} {dictb1a val1}
}]
test pretty {
} -setup $setup1 -body {
set dict {
one {
two three
four {
five six
seven
{{
eight nine
}}
}
}
}
set indentexpr {\n\t+}
regsub dict -all $indentexpr { }
deep pretty dict indent \t
set expected {
one {
two three
four {
five six
seven {{ eight nine }}
}
}
}
dedent expected
trim expected
if {[expr {$dict eq $expected}]} {
set res passed
} else {
set res "expected\n$expected\ngot\n$dict"
}
return $res
} -cleanup [cleanup1] -result passed
test set {
} -setup $setup1 -body {
lappend res [deep set dict1 dictb {one two}]
set dictb $dict1
deep get dictb dictb
lappend res $dictb
} -cleanup [cleanup1] -result [sl {
{one two}
{one two}
}]
cleanupTests
}