#! /bin/env tclsh
package require {ycl test}
proc suite_main {} {
namespace import [yclprefix]
package require {ycl proc}
[yclprefix] proc alias alias [yclprefix] proc alias
package require {ycl ns}
package require {ycl ns local}
alias rename [yclprefix] ns local rename
package require {ycl list}
alias sl [yclprefix] list sl
[yclprefix] test init
rename test {}
alias test [yclprefix] test test
alias cleanup1 [yclprefix] test cleanup1
lappend setup1 [list set ::auto_path $::auto_path]
lappend setup1 {
namespace eval :: {
namespace ensemble create
namespace export *
}
package require {ycl proc}
[yclprefix] proc alias [yclprefix]::proc::alias
alias aliases [yclprefix] proc aliases
package require {ycl list}
package require {ycl list list}
alias which [yclprefix] list which
alias dedent_exact [yclprefix] list dedent_exact
alias lappend [yclprefix] list lappend
alias lappend* [yclprefix] list lappend*
alias lindex [yclprefix] list lindex
alias linsert [yclprefix] list linsert
alias llength [yclprefix] list llength
alias lmap [yclprefix] list lmap
alias lrange [yclprefix] list lrange
alias lreplace [yclprefix] list lreplace
alias lreverse [yclprefix] list lreverse
alias lobject [yclprefix] list new
alias lsort [yclprefix] list lsort
alias order [yclprefix] list order
alias pick [yclprefix] list pick
alias pop [yclprefix] list pop
alias prefix [yclprefix] list prefix
alias prepend [yclprefix] list prepend
alias randindex [yclprefix] list randindex
alias rlindex [yclprefix] list rlindex
alias slwild [yclprefix] list slwild
alias split [yclprefix] list split
alias subset [yclprefix] list subset
alias tail [yclprefix] list tail
alias take [yclprefix] list take
alias transpose [yclprefix] list transpose
alias trim [yclprefix] list trim
alias unique [yclprefix] list unique
alias unpackvar [yclprefix] list unpackvar
alias unset [yclprefix] list unset
alias zip [yclprefix] list zip
rename unset lunset
namespace import [yclprefix]
package require {ycl test data}
alias data [yclprefix] test data
set res {}
set list1 [data list1]
}
set setup1 [join $setup1 \n]
set setup2 [string cat $setup1 {
set res {}
[lobject list1] .init list {one two three}
}]
set add_setup [join [list $setup1 {
alias add [yclprefix] list add
}] \n]
test add {} -setup $add_setup -body {
set list {banana kiwi {star fruit}}
add list banana orange {star fruit}
add list apple orange {star fruit}
add list apple orange {star fruit} {a pear}
} -cleanup [cleanup1] -result [sl {
banana kiwi {star fruit} orange apple {a pear}
}]
set addp_setup [join [list $setup1 {
alias addp [yclprefix] list addp
}] \n]
test addp {} -setup $addp_setup -body {
set list {banana kiwi {star fruit}}
addp list banana orange {star fruit}
addp list apple orange {star fruit}
addp list apple orange {star fruit} {a pear}
} -cleanup [cleanup1] -result [sl {
{a pear} apple orange banana kiwi {star fruit}
}]
set all_setup [join [list $setup1 {
alias all [yclprefix] list all
}] \n]
test all {} -setup $all_setup -body {
all {banana kiwi {star fruit}} [list apply [list x {
expr {$x in [data fruits]}} [namespace current]]]
} -cleanup [cleanup1] -result {1}
test all2 {} -setup $all_setup -body {
all {{star fruit} cookies banana} [list apply [list x {
expr {$x in [data fruits]}} [namespace current]]]
} -cleanup [cleanup1] -result {0}
test all_in {} -setup $all_setup -body {
all {banana kiwi {star fruit}} in [data fruits]
} -cleanup [cleanup1] -result {1}
test all_in2 {} -setup $all_setup -body {
all {{star fruit} cookies banana} in [data fruits]
} -cleanup [cleanup1] -result {0}
set any_setup [join [list $setup1 {
alias any [yclprefix] list any
}] \n]
test any {} -setup $any_setup -body {
any {cucumbers {star fruit} apple} [list apply [list x {
expr {$x in [data fruits]}} [namespace current]]]
} -cleanup [cleanup1] -result {1}
test any2 {} -setup $any_setup -body {
any {cucumbers {potato chips} spaghetti} [list apply [list x {
expr {$x in [data fruits]}} [namespace current]]]
} -cleanup [cleanup1] -result {0}
test any_in {} -setup $any_setup -body {
any {cucumbers {star fruit} apple} in [data fruits]
} -cleanup [cleanup1] -result {1}
test any_in {} -setup $any_setup -body {
any {cucumbers {potato chips} spaghetti} in [data fruits]
} -cleanup [cleanup1] -result {0}
set are_setup [join [list $setup1 {
alias are [yclprefix] list are
}] \n]
test are {} -setup $are_setup -body {
are {banana kiwi cucumber {star fruit}} [list apply [list x {
expr {$x in [data fruits]}} [namespace current]]]
} -cleanup [cleanup1] -result {1 1 0 1}
test are2 {} -setup $are_setup -body {
are {cookies {star fruit} banana} [list apply [list x {
expr {$x in [data fruits]}} [namespace current]]]
} -cleanup [cleanup1] -result {0 1 1}
test are_in {} -setup $are_setup -body {
are {banana cucumbers {star fruit} kiwi} in [data fruits]
} -cleanup [cleanup1] -result {1 0 1 1}
test are_in2 {} -setup $are_setup -body {
are {cookies {star fruit} banana} in [data fruits]
} -cleanup [cleanup1] -result {0 1 1}
set compare_setup [join [list $setup1 {
alias compare [yclprefix] list compare
}] \n]
test compare {} -setup $compare_setup -body {
set list1 [data fruits]
set list2 $list1
lreplace list2 2 2 grape
compare ::tcl::mathop::== list1 list2
} -cleanup [cleanup1] -result 2
test compare_len {} -setup $compare_setup -body {
set list1 [data fruits]
set list2 $list1
lrange list2 0 3
set comp1 [compare ::tcl::mathop::== list1 list2]
set comp2 [compare ::tcl::mathop::== list2 list1]
lappend res comp1 comp2
return $res
} -cleanup [cleanup1] -result {4 4}
set complement_setup [join [list $setup1 {
alias complement [yclprefix] list complement
}] \n]
test complement {} -setup $complement_setup -body {
set list2 $list1
lreplace list2 3 3
set complement [complement list2 list1]
lappend res complement
set complement [complement list1 list2]
lappend res complement
return $res
} -cleanup [cleanup1] -result [sl {
{} {\{\"\ }
}]
set consume_setup [join [list $setup1 {
alias consume [yclprefix] list consume
}] \n]
test consume {} -setup $consume_setup -body {
set list {one {two three} four five}
set res {}
consume item list {
lappend res item
break
}
::lappend res break
consume item list {
lappend res item
}
return $res
} -cleanup [cleanup1] -result [sl {
one break {two three} four five
}]
test consume_break {} -setup $consume_setup -body {
set list {one {two three} four five}
set res {}
consume item list {
if {$item eq {four}} break
lappend res item
}
return $res
} -cleanup [cleanup1] -result [sl {
one {two three}
}]
test consume_continue {} -setup $consume_setup -body {
set res {}
consume item list1 {
if {$item eq {kaks kolm}} continue
lappend res item
}
return $res
} -cleanup [cleanup1] -result [sl {
üks 020 "\{\" " neli " \t\n " 20 010 10 viis 001 01
}]
test consume_return {} -setup $consume_setup -body {
consume item list1 {
if {$item eq {viis}} {
return $res
}
lappend res item
}
return bleep
} -cleanup [cleanup1] -result [sl {
üks {kaks kolm} 020 "\{\" " neli " \t\n " 20 010 10
}]
test consume_inplace {
modifying a list in-place while consuming it
} -setup $consume_setup -body {
set list1 {one two three}
set list2 {üks kaks kolm}
set res {}
set i 0
consume item1 list1 item2 list2 {
incr j
lappend list2 j
incr j
lappend list1 j
if {[incr i] > 100} break
}
list $list1 $list2
} -cleanup [cleanup1] -result [sl {
{198 200 202} {197 199 201}
}]
set dedent_setup [join [list $setup1 {
alias join [yclprefix] list join
alias split [yclprefix] list split
alias dedent [yclprefix] list dedent
}] \n]
test dedent {} -setup $dedent_setup -body {
set text [data indented1]
split text \n
set res $text
dedent res
join res \n
} -cleanup [cleanup1] -result {
snode1
node1.1
node1.2
node2
node1.2
node3
node1.2
}
test dedent_nocommon {} -setup $dedent_setup -body {
set text "\n\t\tcriticks\n\t\tFagel\nFagel\n\t\tother people\n\t\n\t\t"
split text \n
dedent text
return $text
} -cleanup [cleanup1] -result [sl {
{} \t\tcriticks \t\tFagel Fagel "\t\tother people" \t \t\t
}]
test dedent_firstfive {} -setup $dedent_setup -body {
set original [data indented2]
split original \n
lrange original 1 3
set res $original
dedent res
lindex original 0
lindex res 0
expr {[string length $original] - [string length $res]}
} -cleanup [cleanup1] -result 5
test dedent_exact {} -setup $dedent_setup -body {
set original [data indented2]
split original \n
set res $original
dedent_exact res
lindex original 1
lindex res 1
expr {[string length $original] - [string length $res]}
} -cleanup [cleanup1] -result 3
test dedent3 {first line is not indented} -setup $dedent_setup -body {
set original [data indented1]
split original \n
linsert original 0 {hello there}
set res $original
dedent res
expr {$res eq $original}
} -cleanup [cleanup1] -result 1
set filter_setup [join [list $setup1 {
alias are [yclprefix] list are
alias filter [yclprefix] list filter
}] \n]
test filter {} -setup $filter_setup -body {
set list {banana cucumbers {star fruit} kiwi}
filter list [are $list in [data fruits]]
return $list
} -cleanup [cleanup1] -result [sl {
banana {star fruit} kiwi
}]
set head_setup [join [list $setup1 {
alias are [yclprefix] list are
alias head [yclprefix] list head
}] \n]
test head {} -setup $head_setup -body {
head list1 {viis 001 01}
return $list1
} -cleanup [cleanup1] -result [sl {
üks {kaks kolm} 020 "\{\" " neli " \t\n " 20 010 10
}]
test head_longsuffix {} -setup $head_setup -body {
set list {one {two three} four {five six}}
catch {head list {one {two three} four {five six} eight}} cres copts
lappend res cres
return $res
} -cleanup [cleanup1] -result [sl {
{{tail longer than list}}
}]
set join_setup [join [list $setup1 {
alias join [yclprefix] list join
}] \n]
test join {} -setup $join_setup -body {
set list {{one two} {three four}}
join list
return $list
} -cleanup [cleanup1] -result [sl {
one two three four
}]
test lappend* {} -setup $setup1 -body {
lappend* res list1
llength res
list $len $res
} -cleanup [cleanup1] -result [sl {
12 [list üks {kaks kolm} 020 "\{\" " neli " \t\n " 20 010 10 viis \
001 01]
}]
set lindex_setup [join [list $setup1 {
alias lappend [yclprefix] list lappend
alias lindex [yclprefix] list lindex
}] \n]
test lindex {} -setup $lindex_setup -body {
# returns nothing
set res1 [lindex list1 3]
lappend res res1
lappend res list1
return $res
} -cleanup [cleanup1] -result [sl {
{} "\{\" "
}]
test lindex_deep {} -setup $lindex_setup -body {
set list {{one thirteen} {two {three four {five six seven eight} nine } ten} eleven twelve}
set item $list
lindex item 1 1 2 3
lappend res item
set item $list
lindex item {1 1 2 3}
lappend res item
set item $list
lindex item 0 1
lappend res item
return $res
} -cleanup [cleanup1] -result [sl {
eight
eight
thirteen
}]
test lindex_beyond {} -setup $setup1 -body {
catch {
lindex list1 12
} cres copts
lappend res cres
return $res
} -cleanup [cleanup1] -result [sl {
{{index out of range} 12}
}]
test lindex_end {} -setup $setup1 -body {
foreach expr {
0
end
end-1
end-11
end-12
{ end+0 }
end+1
} {
set item $list1
if {[catch {
lindex item $expr
} cres]} {
set item $cres
}
lappend res expr item
}
return $res
} -cleanup [cleanup1] -result [sl {
0 üks
end 01
end-1 001
end-11 üks
end-12 {{index out of range} -1}
{ end+0 } 01
end+1 {{index out of range} 12}
}]
test lindex_noargs {} -setup $setup1 -body {
lindex list1
} -cleanup [cleanup1] -result {}
test linsert {} -setup $setup1 -body {
linsert list1 0 zero {a b}
linsert list1 3 one {kuus seitse}
linsert list1 end kaheksa
return $list1
} -cleanup [cleanup1] -result [sl {
zero {a b} üks one {kuus seitse} {kaks kolm} 020 "\{\" " neli " \t\n " 20
010 10 viis 001 01 kaheksa
}]
test list {} -setup $setup2 -body {
set res1 {}
while 1 {
set next [list1 next]
lappend res1 next
}
lappend res res1
set has [list1 has two]
:: lappend res has
lappend res has
:: lappend res {has not}
set has [list1 has nothing]
lappend res has
return $res
} -cleanup [cleanup1] -result [sl {
{one two three}
has 1
{has not} 0
}]
test lmap {} -setup $setup1 -body {
set list2 {zero one two three four five six seven eight nine ten eleven}
set list3 {a b c d e f g h i j k l}
lmap item1 list1 item2 list2 item3 list3 {
list $item1 $item2 $item3
}
return $list1
} -cleanup [cleanup1] -result [sl {
{üks zero a} {{kaks kolm} one b} {020 two c}
[list "\{\" " three d] {neli four e}
[list " \t\n " five f] {20 six g} {010 seven h} {10 eight i} {viis nine j}
{001 ten k} {01 eleven l}
}]
test lreplace {} -setup $setup1 -body {
lreplace list1 0 0 zero {a b}
return $list1
} -cleanup [cleanup1] -result [sl {
zero {a b} {kaks kolm} 020 "\{\" " neli " \t\n " 20 010 10 viis 001
01
}]
test lreverse {} -setup $setup1 -body {
lreverse list1
return $list1
} -cleanup [cleanup1] -result [sl {
01 001 viis 10 010 20 " \t\n " neli "\{\" " 020 {kaks kolm} üks
}]
test lsort {} -setup $setup1 -body {
lsort list1 -dictionary
return $list1
} -cleanup [cleanup1] -result [sl {
" \t\n " 01 001 10 010 20 020 {kaks kolm} neli viis \{\"\ üks
}]
test order {} -setup $setup1 -body {
set order {1 5 3 11 2 7 6 8 0 9 10 10 4 1}
order list1 order
return $list1
} -cleanup [cleanup1] -result [sl {
{kaks kolm} " \t\n " "\{\" " 01 020 010 20 10 üks viis 001 001 neli
{kaks kolm}
}]
test order_deep {} -setup $setup1 -body {
set list1 {one {{two {three five} seven} four} six}
set order {2 {1 1 {0 {1 1 0} 0 2}} 0}
order list1 order
return $list1
} -cleanup [cleanup1] -result [sl {
six {four {{five three} two seven}} one
}]
test pick {} -setup $setup1 -body {
:: lappend res [pick list1 0]
:: lappend res [pick list1 1 3]
:: lappend res [pick list1 1 3 {4 end}]
:: lappend res [pick list1 {end end}]
:: lappend res [pick list1 4 end-1 1]
#::lappend res [pick list1 {0 3 -1}]
} -cleanup [cleanup1] -result [sl {
üks
[list {kaks kolm} "\{\" "]
[list {kaks kolm} "\{\" " neli " \t\n " 20 010 10 viis 001 01]
01
{neli 001 {kaks kolm}}
}]
test pop {} -setup $setup1 -body {
:: lappend res [pop list1]
pop list1 var1 var2
lappend res var1 var2
lappend res list1
} -cleanup [cleanup1] -result [sl {
01
viis 001
[list üks {kaks kolm} 020 "\{\" " neli " \t\n " 20 010 10]
}]
test pop_notenough {} -setup $setup1 -body {
set list {}
pop list
} -cleanup [cleanup1] -returnCodes 1 -result [sl {
{not enough items in list}
}]
test pop_notenough_vars {} -setup $setup1 -body {
set list {one {two three} four five}
pop list var1 var2 var3 var4 var5
} -cleanup [cleanup1] -returnCodes 1 -result [sl {
{not enough items in list}
}]
test prefix {} -setup $setup1 -body {
set list2 $list1
lrange list2 0 4
set prefix $list2
prefix prefix list1
lappend res prefix
set prefix $list1
prefix prefix list2
lappend res prefix
set list2 $list1
lrange list2 0 4
set prefix $list2
prefix list1
lappend res prefix
set prefix $list1
prefix list2
lappend res prefix
return $res
} -cleanup [cleanup1] -result [sl {
1 0 1 0
}]
test prepend {} -setup $setup1 -body {
prepend list1 one {two three} four
return $list1
} -cleanup [cleanup1] -result [sl {
one {two three} four
üks {kaks kolm} 020 "\{\" " neli " \t\n " 20 010 10 viis
001 01
}]
test randindex {} -setup $setup1 -body {
expr srand(10)
for {set i 0} {$i < 4} {incr i} {
::lappend res [randindex list1]
}
return $res
} -cleanup [cleanup1] -result [sl {
"\{\" " 20 010 "\{\" "
}]
test rlindex {} -setup $setup1 -body {
set list {one {two {a b {c d e f}}} four}
set idx {1 1 2 3}
rlindex list idx
lappend res list
return $res
} -cleanup [cleanup1] -result [sl {
f
}]
test slwild {} -setup $setup1 -body {
set a {two three}
set list {
one
"$a\nhello"
}
:: lappend res {*}[slwild $list]
return $res
} -cleanup [cleanup1] -result [sl {
one "two three\nhello"
}]
test split {} -setup $setup1 -body {
set list {one,two,three,four}
split list ,
return $list
} -cleanup [cleanup1] -result [sl {
one two three four
}]
test subset {} -setup $setup1 -body {
set list2 $list1
lreplace list2 3 3
set subset [subset list2 list1]
lappend res subset
set subset [subset list1 list2]
lappend res subset
return $res
} -cleanup [cleanup1] -result [sl {
1 0
}]
test tail {} -setup $setup1 -body {
set list {one {two three} four {five six}}
tail list {one {two three}}
return $list
} -cleanup [cleanup1] -result [sl {
four {five six}
}]
test tail_onearg {} -setup $setup1 -body {
set tail {one {two three} four {five six}}
tail {one {two three}}
return $tail
} -cleanup [cleanup1] -result [sl {
four {five six}
}]
test tail_shortlist {} -setup $setup1 -body {
set list {one}
catch {tail list {one {two three}}} cres copts
lappend res cres
return $res
} -cleanup [cleanup1] -result [sl {
{{bad prefix}}
}]
test take_noargs {} -setup $setup1 -body {
set list {one {two three} four five}
take list
return $list
} -cleanup [cleanup1] -result [sl {
{two three} four five
}]
test take_args {} -setup $setup1 -body {
set list {one two three four}
take list var1 var2
lappend res var1 var2 list
return $res
} -cleanup [cleanup1] -result [sl {
one two {three four}
}]
test take_emptylist {} -setup $setup1 -body {
set res {}
set list {}
catch {take list} cres copts
lappend res cres
return $res
} -cleanup [cleanup1] -result [sl {
{{not enough items in the list} needed 1}
}]
test take_toofewitems {} -setup $setup1 -body {
set res {}
set list {uno dos}
catch {take list one two three} cres copts
lappend res cres
return $res
} -cleanup [cleanup1] -result [sl {
{{not enough items in the list} need 3 have 2}
}]
test transpose {} -setup $setup1 -body {
set matrix [[yclprefix] test data matrix1]
transpose matrix
return $matrix
} -cleanup [cleanup1] -result [sl {
kkk
}]
test trim {} -setup $setup1 -body {
set list [list " one " "\t two\t\n" "\nthree four\n"]
trim list
:: lappend res {*}$list
return $res
} -cleanup [cleanup1] -result [sl {
one two {three four}
}]
test unique {} -setup $setup1 -body {
set list {one \{ three \{ \" four \" one}
unique list
return $list
} -cleanup [cleanup1] -result [sl {
one \{ three \" four
}]
test unpackvar {} -setup $setup1 -body {
set list [list {value 1}]
unpackvar list var1
lappend res var1
} -cleanup [cleanup1] -result [sl {
{value 1}
}]
test unpackvar {} -setup $setup1 -body {
set list [list {value 1}]
unpackvar list var1
lappend res var1
} -cleanup [cleanup1] -result [sl {
{value 1}
}]
test unset {} -setup $setup1 -body {
set var1 [[yclprefix] test data dirtree]
lunset var1 0 1 1 1
lindex var1 0 1 1
return $var1
} -cleanup [cleanup1] -result [sl {
one two goodbye three cabbage four cabbage
}]
test unset_nonexisting {} -setup $setup1 -body {
set var1 [[yclprefix] test data dirtree]
catch {lunset var1 0 0 1} cres copts
lappend res cres
return $res
} -cleanup [cleanup1] -result [sl {
{{index out of range}}
}]
test which {} -setup $setup1 -body {
which {banana cucumbers {star fruit} kiwi} [list apply [list x {
expr {$x in [data fruits]}} [namespace current]]]
} -cleanup [cleanup1] -result {0 2 3}
test which2 {} -setup $setup1 -body {
which {cookies {star fruit} banana} [list apply [list x {
expr {$x in [data fruits]}} [namespace current]]]
} -cleanup [cleanup1] -result {1 2}
test which_in {} -setup $setup1 -body {
which {banana cucumbers kiwi {star fruit}} in [data fruits]
} -cleanup [cleanup1] -result {0 2 3}
test which_in2 {} -setup $setup1 -body {
which {cookies banana {star fruit}} in [data fruits]
} -cleanup [cleanup1] -result {1 2}
test zip {} -setup $setup1 -body {
set res {}
set list1 {Üks {viis kuus}}
set list2 {{kaks kolm} seitse}
set list3 {neli {kaheksa üheksa}}
:: lappend res [zip list1 list2 list3]
lappend res list1
return $res
} -cleanup [cleanup1] -result [sl {
{} {Üks {kaks kolm} neli {viis kuus} seitse {kaheksa üheksa}}
}]
cleanupTests
}