Artifact ed73d8cf78f18bd1d872320fd58d5655f23a98c8:

• File packages/dict/lib/dict.test.tcl — part of check-in [fccab64d80] at 2019-12-09 23:32:23 on branch trunk — dict new routines

  dict routine

  new implementation of an object interface for a dictionary

  test

  new command [test]

  various packages reworked to use [test]

  rework various packages to avoid use of "::" (user: pooryorick size: 4116)

#! /bin/env tclsh

proc suite_main {} {
	package require {ycl proc}
	[yclprefix] proc alias alias [yclprefix] proc alias
	alias aliases [yclprefix] proc aliases

	aliases {
		{ycl ns local} {
			rename
		}
	}

	package require {ycl test}
	[yclprefix] test init
	rename test {}

	aliases {
		{ycl list} {
			join
			sl
		}
		{ycl test} {
			test
			cleanup1
		}
	}

	lappend setup1 [list set auto_path $::auto_path]
	lappend setup1 {
		package require {ycl proc}
		[yclprefix] proc alias alias [yclprefix] proc alias
		alias aliases [yclprefix] proc aliases

		package require {ycl test data}
		aliases {
			{ycl ns} {
				nsjoin join
			}
		}
		alias [nsjoin [yclprefix] test data]
		package require {ycl dict}
		alias ydict [nsjoin [yclprefix] dict]
	}

	join setup1 \n

	lappend setup2 $setup1
	lappend setup2 {
		set d1 [data languages]
	}
	join setup2 \n


	test append {} -setup $setup1 -body {
		ydict append dict {one {two three}} üks
		ydict append dict {one {two three}} {kaks kolm} 
		lappend res [dict get $dict one {two three}]
	} -cleanup [cleanup1] -result [sl {
		{ükskaks kolm}
	}]


	test append_path {} -setup $setup2 -body {
		ydict append d1 {languages German} üks kaks
		ydict append d1 {languages German} {kolm neli} viis
		ydict append d1 German {kolm neli} 
		ydict get res1 d1 languages German
		lappend res $res1 
		return $res
	} -cleanup [cleanup1] -result [sl {
		{ükskakskolm neliviis}
	}]


	test keys {} -setup $setup1 -body {
		set dict [data languages] 
		ydict keys keys dict languages
		lappend res $keys
		return $res
	} -cleanup [cleanup1] -result [sl {
		{English Estonian}
	}]


	test lappend {} -setup $setup1 -body {
		set dict [data languages] 
		ydict lappend dict {languages English countries x y} Morocco hello
		lappend res [dict get $dict languages English countries x y Morocco]
	} -cleanup [cleanup1] -result [sl {
		hello
	}]



	test merge {} -setup $setup1 -body {
		set dict [data languages] 
		ydict merge {dict languages} {English {countries Wales}} {German {countries Austria}}
		set languages [dict get $dict languages]
		lappend res [dict keys $languages]

		ydict get res1 dict languages English countries
		lappend res $res1
		return $res
	} -cleanup [cleanup1] -result [sl {
		{English Estonian German}
		Wales
	}]


	test remove {} -setup $setup1 -body {
		set dict [data languages] 
		ydict get languages dict languages 
		ydict remove languages Estonian
		ydict keys var1 languages
		lappend res $var1
		return $res
	} -cleanup [cleanup1] -result [sl {
		English
	}]


	test request {basic test of request} -setup $setup1 -body {
		set res [list]
		set dict {one uno two dos three tres}
		lappend res [ydict request $dict {res2 quatro} four]
		lappend res $res2
		ydict request $dict res2 two
		lappend res $res2
		lappend res [ydict request $dict res2 three]
		set res2 cinco
		ydict request $dict res2 five
		lappend res $res2
	} -cleanup [cleanup1] -result [sl {
		quatro quatro dos tres cinco
	}]


	test setl {} -setup $setup1 -body {
		set dict {a 1 b 1 a 2 b 2 c 1 c 2} 
		ydict setl dict c 3
	} -cleanup [cleanup1] -result [sl {
		a 1 b 1 a 2 b 2 c 3
	}]

	test setl_noexist {} -setup $setup1 -body {
		ydict setl dict c 3
	} -cleanup [cleanup1] -result [sl {
		c 3
	}]


	test setl_recursive {} -setup $setup1 -body {
		set dict {a 1 b 1 a 2 b {d 1 d 2 e 1 e 2} c 1 c 2} 
		ydict setl dict b d 3
	} -cleanup [cleanup1] -result [sl {
		a 1 a 2 b {d 3 e 1 e 2} c 1 c 2
	}]


	test var {} -setup $setup1 -body {
		set dict {a 1 b {c 3 d {e 5 f 6 g 7}}}
		ydict var v1 dict b d e
		set v1 7
		ydict var v2 dict b d g
		lappend res [dict exists $dict b d g]
		unset v2
		lappend res [dict exists $dict b d g]
		ydict hvar v3 dict b d g
		lappend res $v3
		unset v3
		lappend res [dict exists $dict b d g]
		lappend res $dict
		return $res
	} -cleanup [cleanup1] -result [sl {
		1 1 7 0
		{a 1 b {c 3 d {e 7 f 6}}}
	}]


	test unsetl {} -setup $setup1 -body {
		set dict {a 1 b 1 a 2 b {d 1 d 2 e 1 e 2} c 1 c 2} 
		ydict unsetl dict a
		return $dict
	} -cleanup [cleanup1] -result [sl {
		b 1 b {d 1 d 2 e 1 e 2} c 1 c 2
	}]


	cleanupTests
}