ycl

Artifact [4437263a0e]
Login

Artifact [4437263a0e]

Artifact 4437263a0e94ce6ba8a6bdd42d973eb3496ca5a1:


#! /bin/env tclsh

package require {ycl test}

proc suite_main {} {
	package require {ycl list}
	namespace import [yclprefix]
	interp alias {} [namespace current]::any {} [yclprefix] list any
	interp alias {} [namespace current]::all {} [yclprefix] list all 
	interp alias {} [namespace current]::are {} [yclprefix] list are 
	interp alias {} [namespace current]::which {} [yclprefix] list which 
	namespace import [yclprefix]::list::filter
	namespace import [yclprefix]::list::foreach
	namespace import [yclprefix]::list::join
	namespace import [yclprefix]::list::linsert
	namespace import [yclprefix]::list::lreplace
	namespace import [yclprefix]::list::lreverse
	namespace import [yclprefix]::list::pick
	namespace import [yclprefix]::list::pop
	namespace import [yclprefix]::list::sl
	namespace import [yclprefix]::list::split
	namespace import [yclprefix]::list::take
	namespace import [yclprefix]::list::unpackvar
	namespace import [yclprefix]::list::unset
	rename unset lunset
	namespace import [yclprefix]

	[yclprefix]::test::init
	namespace import [yclprefix]::test::cleanup1
	package require {ycl test data}
	namespace import [yclprefix]::test::data


	test dedent {} -body {
		set text [::split [data indented1] \n]
		::join [ycl list dedent $text] \n
	} -cleanup [cleanup1] -result {
snode1
    node1.1
	     node1.2
	 	 node2
			
	     node1.2
			 node3
								node1.2
}


	test dedent_nocommon {} -body {
		set text [::split \
			"\n\t\tcriticks\n\t\tFagel\nFagel\n\t\tother people\n\t\n\t\t" \n]
		set res [ycl list dedent $text]
		return $res
	} -cleanup [cleanup1] -result [sl {
		{} \t\tcriticks \t\tFagel Fagel "\t\tother people" \t \t\t
	}]


	test dedent_firstfive {} -body {
		set original [::split [data indented2] \n]
		set original [lrange $original 1 3]
		set res [ycl list dedent $original]
		set origline1 [lindex $original 0]
		set resline1 [lindex $res 0]
		expr {[string length $origline1] - [string length $resline1]}
	} -cleanup [cleanup1] -result 5


	test dedent_exact {} -body {
		set original [::split [data indented2] \n]
		set res [ycl list dedent_exact $original]
		set origline1 [lindex $original 1]
		set resline1 [lindex $res 1]
		expr {[string length $origline1] - [string length $resline1]}
	} -cleanup [cleanup1] -result 3


	test dedent3 {first line is not indented} -body {
		set original [::split [data indented1] \n]
		linsert original 0 {hello there}
		set res [ycl list dedent $original]
		expr {$res eq $original}
	} -cleanup [cleanup1] -result 1


	test all {} -body {
		all {banana kiwi {star fruit}} [list apply [list x {
			expr {$x in [data fruits]}} [namespace current]]]
	} -cleanup [cleanup1] -result {1}


	test all2 {} -body {
		all {{star fruit} cookies banana} [list apply [list x {
			expr {$x in [data fruits]}} [namespace current]]]
	} -cleanup [cleanup1] -result {0}


	test all_in {} -body {
		all {banana kiwi {star fruit}} in [data fruits]
	} -cleanup [cleanup1] -result {1}


	test all_in2 {} -body {
		all {{star fruit} cookies banana} in [data fruits]
	} -cleanup [cleanup1] -result {0}


	test any {} -body {
		any {cucumbers {star fruit} apple} [list apply [list x {
			expr {$x in [data fruits]}} [namespace current]]]
	} -cleanup [cleanup1] -result {1}


	test any2 {} -body {
		any {cucumbers {potato chips} spaghetti} [list apply [list x {
			expr {$x in [data fruits]}} [namespace current]]]
	} -cleanup [cleanup1] -result {0}


	test any_in {} -body {
		any {cucumbers {star fruit} apple} in [data fruits]
	} -cleanup [cleanup1] -result {1}


	test any_in {} -body {
		any {cucumbers {potato chips} spaghetti} in [data fruits]
	} -cleanup [cleanup1] -result {0}


	test are {} -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 {} -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 {} -body {
		are {banana cucumbers {star fruit}  kiwi} in [data fruits]
	} -cleanup [cleanup1] -result {1 0 1 1}


	test are_in2 {} -body {
		are {cookies {star fruit} banana} in [data fruits]
	} -cleanup [cleanup1] -result {0 1 1}


	test filter {} -body {
		set list {banana cucumbers {star fruit} kiwi}
		filter $list [are $list in [data fruits]]
	} -cleanup [cleanup1] -result [sl {
		banana {star fruit} kiwi
	}]


	test foreach {} -body {
		set list {one {two three} four five}
		set res {}
		foreach item list {
			lappend res $item
			break
		}
		lappend res break
		foreach item list {
			lappend res $item
		}
		return $res
	} -cleanup [cleanup1] -result [sl {
		one break {two three} four five
	}]


	test join {} -body {
		set list {{one two} {three four}}
		join list
		return $list
	} -cleanup [cleanup1] -result [sl {
		one two three four
	}]


	test linsert {} -body {
		set list {{one two} {three four}}
		linsert list 0 zero {a b}
		return $list
	} -cleanup [cleanup1] -result [sl {
		zero {a b} {one two} {three four}
	}]


	test lreplace {} -body {
		set list {{one two} {three four}}
		lreplace list 0 0 zero {a b}
		return $list
	} -cleanup [cleanup1] -result [sl {
		zero {a b} {three four}
	}]


	test lreverse {} -body {
		set list {{one two} {three four}}
		lreverse list
		return $list
	} -cleanup [cleanup1] -result [sl {
		{three four} {one two}
	}]

	test pick {} -body {
		set list {apple banana cucumber {star fruit} kiwi pear orange}
		lappend res [pick $list 0]
		lappend res [pick $list 1 3]
		lappend res [pick $list 1 3 {4 end}]
		lappend res [pick $list {end end}]
		lappend res [pick $list 4 end-1 1]
		lappend res [pick $list {0 3 -1}]

	} -cleanup [cleanup1] -result [sl {
		apple
		{banana {star fruit}}
		{banana {star fruit} kiwi pear orange}
		orange
		{kiwi pear banana}
		{{star fruit} cucumber banana apple}
	}]


	test pop {} -body {
		set list {one {two three} four five}
		::list [pop list] $list
	} -cleanup [cleanup1] -result [sl {
		five {one {two three} four}
	}]


	test pop_args {} -body {
		set list {one {two three} four five}
		pop list var1 var2
		list $var1 $var2 $list
	} -cleanup [cleanup1] -result [sl {
		four five {one {two three}}
	}]


	test split {} -body {
		set list {one,two,three,four}
		split list ,
		return $list
	} -cleanup [cleanup1] -result [sl {
		one two three four
	}]


	test take_noargs {} -body {
		set list {one {two three} four five}
		take list 
		return $list
	} -cleanup [cleanup1] -result [sl {
		{two three} four five
	}]

	test take_args {} -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 {} -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 {} -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} needed 3}
	}]


	test unpackvar {} -body {
		set list [list {value 1}]
		unpackvar list var1
		lappend res $var1
	} -cleanup [cleanup1] -result [sl {
		{value 1}
	}]


	test unset {} -body {
		set var1 [set [yclprefix]::test::data::dirtree]
		lunset var1 0 1 1 1 
		lappend res [lindex $var1 0 1 1]
		return $res
	} -cleanup [cleanup1] -result [sl {
		{one two goodbye three cabbage four cabbage}
	}]


	test unset_nonexisting {} -body {
		set var1 [set [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 {} -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 {} -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 {} -body {
		which {banana cucumbers kiwi {star fruit}} in [data fruits]
	} -cleanup [cleanup1] -result {0 2 3}

	test which_in2 {} -body {
		which {cookies banana {star fruit}} in [data fruits]
	} -cleanup [cleanup1] -result {1 2}


	cleanupTests
}