Artifact 6e6c06f9f12adbf973aeae03059d951637a263d1:

• File packages/struct/lib/tree/tree.test.tcl — part of check-in [cc1dc6fed2] at 2020-05-11 20:14:30 on branch trunk — file

  code cleanup

  printable

  handle carriage return more specifically

  tree

  new routines

  node_dest

  node_next

  node_under

  (user: pooryorick size: 45955)

#! /bin/env tclsh

package require {ycl test}


proc suite_main {} {
	package require sqlite3

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

	aliases {
		{ycl dict deep}
		{ycl eval} {
			block
		}
		{ycl list} {
			sl
		}
		{ycl parser interp} {
			parse
		}
		{ycl test data} {
			bytes
			startrek
		}
	}

	namespace import [yclprefix]::db::sqlite::util::explain_pretty

	package require {ycl string chan}
	if {[namespace which [namespace current]::schan] eq {}} {
		namespace import [yclprefix]::string::chan
		rename chan schan
	}


	namespace import [yclprefix]::struct::tree

	namespace import [yclprefix]::test::cleanup1
	[yclprefix]::test::init

	set tprefix tree1

	set setup1 {
		variable tree1
		[tree .new tree1] .init dbitemprefix $tprefix
	}

	set setup2 $setup1
	append setup2 {
		tree1 node tree {} $tree1
		tree1 node forge {} one seven
	}

	set setup3 $setup1
	append setup3 {
		tree1 read [startrek]
	}

	set setup4 $setup1
	append setup4 {
		set res {}
		set n1 [tree1 node new {} n1]
		set n1a [tree1 node new $n1 n1a]
		set n1b [tree1 node new $n1 n1b]
	}

	set setup5 $setup1
	append setup5 {
		set one [tree1 node new {} one]
		lappend res {one is top} [expr {[tree1 node up& $one] eq {}}]

		set two [tree1 node new {} two]
		lappend res {two is top} [expr {[tree1 node up& $two] eq {}}]

		set three [tree1 node new $one three]
		lappend res {three parent is one} [expr {$one == [tree1 node up& $three]}]
		set three2 [tree1 node pivot $one three]
		lappend res {pivot from one to three is three} [expr {$three == $three2}] 

		set four [tree1 node link $three $two] 
	}

	variable tree1 {
		one {}
		two {}
		three {
			four {}
			five {}
		}
	}


	test dbconn {} -setup {} -body {
		sqlite3 db1 :memory:
		db1 eval {
			create table t1 (
				c1
				, c2
			)
			; insert into t1 values ("value 1" ,"value 2")
		}
		[tree .new tree1] .init dbconn db1
		tree1 node tree {} $tree1  
		set node [tree1 node pivot {} three]
		lappend res [tree1 node last $node]
		lappend res [db1 eval {select c1 ,c2 from t1}]
		return $res
	} -cleanup [cleanup1] -result [sl {
		five
		{{value 1} {value 2}}
	}]


	test descendants_refs {} -setup $setup3 -body {
		set res {}
		set node [tree1 node pivot {} name]
		set namenode [tree1 node pivot {} name]
		tree1 descendants refs $namenode {
			upvar res res
			lappend res [tree1 node val $node]
		}

		return $res
	} -cleanup [cleanup1] -result [sl {
		name name name name name name name
	}]


	test forge {} -setup $setup1 -body {
		set res {}
		lassign [tree1 node forge {} one two] node created
		lappend res $created [tree1 node val $node]
		return $res
	} -cleanup [cleanup1] -result [sl {
		2 two 
	}]


	test forge_deep {} -setup $setup1 -body {
		set res {}
		set node [tree1 node new {} 0]
		set start $node
		lappend path 0
		for {set i 0} {$i < 100} {incr i} {
			set node [tree1 node new $node $i]
			lappend path $i
		}
		set pathlist [tree1 node path $node]
		lappend res [expr {[tree1 node path $node] eq $path}]
		set deep [tree1 node pivot $start {*}[lrange $path 1 end]]
		return $res
	} -cleanup [cleanup1] -result [sl {
		1
	}]


	test forge_node {} -setup $setup1 -body {
		set res {}
		lassign [tree1 node forge {} one two three] three created
		lappend res $created [tree1 node last {} one]
		lappend res [tree1 node val $three]

		set one [tree1 node pivot {} one]
		set two [tree1 node pivot {} one two]

		lassign [tree1 node forge $one two three four] four created
		lappend res $created [tree1 node last $two] [tree1 node val $four]

		return $res
	} -cleanup [cleanup1] -result [sl {
		3 two three
		1 three four
	}]


	test forge_node_childmatchesparent {} -setup $setup1 -body {
		set res {}
		lassign [tree1 node forge {} one] one created
		lappend res $created [tree1 node val $one]

		lassign [tree1 node forge $one one] oneone created
		lappend res $created [tree1 node val $oneone]

		return $res
	} -cleanup [cleanup1] -result [sl {
		1 one
		1 one
	}]


	test forge_novals {} -setup $setup2 -body {
		set res {}
		lassign [tree1 node forge {}] node created
		lappend res $node $created
		return $res
	} -cleanup [cleanup1] -result [sl {
		{} 0
	}]


	test forge_top {} -setup $setup1 -body {
		set res {}
		lassign [tree1 node forge {} one two] node created
		lappend res [expr {$node >= 0}]  $created
		return $res
	} -cleanup [cleanup1] -result [sl {
		1 2
	}]

	
	test clear {} -setup $setup3 -body {
		set enterprise [tree1 node pivot {} {U.S.S. Enterprise}]
		set children [tree1 node ls $enterprise]
		lappend res [llength $children]
		tree1 node clear $enterprise
		set enterprise [tree1 node pivot {} {U.S.S. Enterprise}]
		set children [tree1 node ls $enterprise]
		lappend res [llength $children]
		return $res
	} -cleanup [cleanup1] -result [sl {
		1 0
	}]


	test node_appears {} -setup $setup3 -body {
		set st [tree1 node pivot {} {Star Trek}]
		set captain [tree1 node pivot {} {captain}]
		set link1 [tree1 node link {} $captain]
		set link2 [tree1 node link $st $link1]
		set res1 {}
		tree1 node appears& $st $captain {
			upvar res1 res1
			lappend res1 [tree1 node path $node]
		}
		lappend res $res1
		return $res
	} -cleanup [cleanup1] -result [sl {
		{{{Star Trek} captain} {{Star Trek} {} roles captain}}
	}]


	test node_converge {} -setup $setup1 -body {
		set res {}
		set onenode [tree1 node new {} one]
		set twonode [tree1 node new {} two ]
		set threenode [tree1 node new $twonode three]
		set fournode [tree1 node new {} four]
		set link1 [tree1 node link $threenode $onenode]
		set link2 [tree1 node link $link1 $fournode]
		set path [tree1 node converge& $link2 $twonode]
		lappend res [expr {
			[lindex $path 0] == $threenode
			&& [lindex $path 1] == $link1
			&& [lindex $path 2] == $link2
		}]
		set path [tree1 node converge $link2 $twonode]
		lappend res $path
		return $res
	} -cleanup [cleanup1] -result [sl {
		1 {three one four}
	}]


	test node_cp {} -setup $setup3 -body {
		set res {}
		set node [tree1 node pivot {} {Star Trek}]
		set node2 [tree1 node pivot {} list]
		set routine [list ::apply [list [list node args] {
			tree1 node walk $node {
				yield [list $node $up $value]
			}
			return -code break
		} [namespace current]]]

		tree1 node cp $node $node2

		coroutine c1 {*}$routine $node
		set down [tree1 node down& $node2]
		coroutine c2 {*}$routine $down
		set matched 1
		while 1 {
			lassign [c1] node1 up value1
			lassign [c2] node2 up value2
			if {[tree1 node islink $node1]} {
				if {![tree1 node islink $node2]} {
					lappend res {value node became link node}
				}
			} else {
				if {[tree1 node islink $node2]} {
					lappend res {link node became value node}
				}
			}
			if {$value2 ne $value1} {
				set matched 0
			}
		}
		lappend res $matched
		return $res
	} -cleanup [cleanup1] -result [sl {
		1
	}]


	test node_ddict {} -setup $setup3 -body {
		set res {}
		set res1 [tree1 node ddict {}]
		lappend res length [llength $res1]

		set res2 $res1
		deep get res2 {Star Trek} name value
		lappend res {Star Trek name value} $res2

		set res2 $res1
		deep get res2 translation kind 
		lappend res {translation kind} $res2

		set res2 $res1
		set status [catch {deep get res2 ownself} cres]
		lappend res ownself $status $cres

		return $res
	} -cleanup [cleanup1] -result [sl {
		length 62
		{Star Trek name value} {Star Trek} 
		{translation kind} {Chinese Russian} 
		ownself 1 empty
	}]


	test node_dest {} -setup $setup1 -body {
		set res {}
		lassign [tree1 node forge {} one] one
		lassign [tree1 node forge $one two three] three
		lassign [tree1 node forge $one four five six] six
		set threea [tree1 node link $six $three]
		set threeb [tree1 node link $six $threea]
		set threec [tree1 node link $six $threeb]
		set dest [tree1 node dest $threec]
		lappend res [expr {$dest == $three}]
		return $res
	} -cleanup [cleanup1] -result [sl {
		1
	}]


	test node_empty {} -setup $setup1 -body {
		set res {}
		lassign [tree1 node forge {} one] one
		lassign [tree1 node forge {} one two] two
		lappend res [tree1 node empty? $two]
		lappend res [tree1 node empty? $one]
		return $res
	} -cleanup [cleanup1] -result [sl {
		1 0
	}]


	test node_exists {} -setup $setup3 -body {
		lappend res [tree1 node exists {} {Star Trek}]
		lappend res [tree1 node exists {} {something fake}]
		set st [tree1 node pivot {} {Star Trek}]
		set fake [tree1 node pivot? $st name value]
		lappend res [tree1 node exists $st name value]
		lappend res [tree1 node exists $st name fake]
		return $res
	} -cleanup [cleanup1] -result [sl {
		1 0 1 0
	}]


	test node_last {} -setup $setup2 -body {
		set res {}
		lappend res [tree1 node last {} three]
		return $res
	} -cleanup [cleanup1] -result [sl {
		five
	}]


	test node_last_bytes {} -setup $setup1 -body {
		set res {}
		set data [bytes]
		lassign [tree1 node forge {} one] one
		set datanode [tree1 node set $one $data {two three}]
		lappend res [tree1 node last $one $data]
		return $res
	} -cleanup [cleanup1] -result [sl {
		{two three}
	}]


	test node_last_root {} -setup $setup2 -body {
		set res {}
		lappend res [tree1 node last]
		return $res
	} -cleanup [cleanup1] -result [sl {
		three
	}]


	test node_last_nolast {} -setup $setup2 -body {
		set res {}
		set status [catch {tree1 node last {} two} cres copts]
		lappend res $status $cres
		return $res
	} -cleanup [cleanup1] -result [sl {
		1 [list {no results}]
	}]


	test node_last& {} -setup $setup2 -body {
		set res {}
		for {set i 0} {$i < 10} {incr i} {
			tree1 node last& {} three
		}
		set three [tree1 node last& {} three]
		lappend res [tree1 node val $three]
		lappend res [tree1 nodelast&cache stats]
		return $res
	} -cleanup [cleanup1] -result [sl {
		five
		{hits 10 misses 1 size 1}
	}]


	test node_last&_root {} -setup $setup2 -body {
		set res {}
		set lastnode [tree1 node last&]
		lappend res [tree1 node val $lastnode]
		return $res
	} -cleanup [cleanup1] -result [sl {
		three
	}]


	test node_last&_nolast {} -setup $setup2 -body {
		set res {}
		set status [catch {tree1 node last& {} two} cres copts]
		lappend res $status $cres
		return $res
	} -cleanup [cleanup1] -result [sl {
		1 [list {no results}]
	}]


	test node_leaves {} -setup $setup1 -body {
		set res {}
		set onenode [tree1 node new {} one]
		set twonode [tree1 node new {} two ]
		set threenode [tree1 node new $twonode three]
		set fournode [tree1 node new $twonode four]
		set fivenode [tree1 node new {} five]
		set link1 [tree1 node link $threenode $onenode]
		set link2 [tree1 node link $link1 $fivenode]
		set leaves [tree1 node leaves& $twonode]
		lappend res [llength $leaves]
		lappend res [expr {[lindex $leaves 0] eq $link2}]
		lappend res [expr {[lindex $leaves 1] eq $fournode}]
		lappend res [tree1 node leaves $twonode]
		return $res
	} -cleanup [cleanup1] -result [sl {
		2 1 1 {five four}
	}]


	test node_link_ls {} -setup $setup5 -body {
		lappend res {four is} [tree1 node val $four]
		lappend res {ls three} [tree1 node ls $three]
		return $res
	} -cleanup [cleanup1] -result [sl {
		{one is top} 1
		{two is top} 1
		{three parent is one} 1
		{pivot from one to three is three} 1
		{four is} two 
		{ls three} two
	}]


	test node_link_ls2 {} -setup $setup3 -body {
		set res {}
		set node [tree1 node pivot {} {Star Trek} name value]
		lappend res [tree1 node val $node]
		lappend res [tree1 node ls $node]
		return $res
	} -cleanup [cleanup1] -result [sl {
		value {Star Trek}
	}]


	test node_link_pivot {} -setup $setup1 -body {
		set res {}
		lassign [tree1 node forge {} one] one
		lassign [tree1 node forge $one two ] two
		lassign [tree1 node forge {} three four] four
		lassign [tree1 node forge {} five six] six
		set link1 [tree1 node link $four $one]
		set link2 [tree1 node link $six $link1]
		set target1 [tree1 node target $link1]
		set target2 [tree1 node target $link2]
		lappend res {link2 references link1} [expr {$target2 eq $link1}]
		return $res
	} -cleanup [cleanup1] -result [sl {
		{link2 references link1} 1 
	}]


	test node_link_top {} -setup $setup2 -body {
		set res {}
		set four [tree1 node pivot {} three four]
		tree1 node forge {} nine
		set four [tree1 node link {} $four]
		lappend res {is link} [tree1 node islink $four]
		lassign [tree1 node forge {} eight] eight
		tree1 node ls {} {
			upvar res res
			lappend res $value
		}
		return $res
	} -cleanup [cleanup1] -result [sl {
		{is link} 1
		. one two three nine four eight
	}]


	test node_link_resolve {} -setup $setup2 -body {
		set res {}
		set four [tree1 node pivot {} three four]
		set two [tree1 node pivot {} two]
		tree1 node link $two $four
		tree1 node ls $two {
			upvar res res
			lappend res $value
		}
		return $res
	} -cleanup [cleanup1] -result [sl {
		four
	}]


	test node_linkval_set {} -setup $setup1 -body {
		set res {}
		lassign [tree1 node forge {} Dryden] dryden
		lassign [tree1 node forge {} William] william
		set node [tree1 node set {} author Dryden]
		set node [tree1 node pivot {} author]
		set author [tree1 node pivot {} author]
		set node [tree1 node linkval {{} author} $william]
		lappend res [tree1 node val $author]
		return $res
	} -cleanup [cleanup1] -result [sl {
		William
	}]


	test node_ls {} -setup $setup3 -body {
		set ls [tree1 node ls {}]
		foreach word {captain 星際爭霸戰} {
			lappend res $word [expr {$word in $ls}]
		}
		return $res
	} -cleanup [cleanup1] -result [sl {
		captain 1 星際爭霸戰 1
	}]

	foreach \
		type {_spec_missing _spec_empty _spec_remap _spec_array} \
		spec [list {} [list {}] [list {value current}] s] \
		varname {value value current s(value)} {

		try [string map [list @type@ $type @spec@ $spec @varname@ $varname] {

			test node_ls_script@type@ {} -setup $setup3 -body {
				set res {}
				tree1 node ls {} @spec@ {
					upvar res res
					if {$@varname@ in {captain 星際爭霸戰}} {
						# also test that there is a local scope that is preserved across
						# iterations
						lappend res [incr i] $@varname@
					}
				}
				return [lsort $res]
			} -cleanup [cleanup1] -result [sl {
				1 2 captain 星際爭霸戰
			}]
		}]
	}


	test node_ls_pivot {} -setup $setup4 -body {
		set res [tree1 node ls [list {} n1]]
		return $res
	} -cleanup [cleanup1] -result [sl {
		n1a n1b
	}]

	foreach \
		type {_spec_missing _spec_empty _spec_param _spec_array} \
		spec [list {} [list {}] [list {value myvalue}] s] \
		varname {value value myvalue s(value)} {

		try [string map [list @type@ $type @spec@ $spec @varname@ $varname] {
			test node_ls_pivot_script@type@ {} -setup $setup4 -body {
				set res2 {}
				tree1 node ls [list {} n1] @spec@ {
					upvar res2 res2
					lappend res2 $@varname@
				}
				lappend res $res2
				return $res
			} -cleanup [cleanup1] -result [sl {
				{n1a n1b}
			}]
		}]
	}


	test node_ls& {} -setup $setup3 -body {
		set nodes [tree1 node ls& {}]
		set novalue {}
		set topnodes [tree1 db eval "
			select node from ${tprefix}tree where node = up and value != '.'
		"]
		set topdict {}
		foreach node $topnodes {
			dict set topdict $node 0
		}
		set values {}
		foreach node $nodes {
			dict incr dict $node -1
			try {tree1 node val $node} on ok val {
				lappend values $val
			} on error {tres copts} {
				lappend novalue $node
			}
		}
		set notseen {}
		set multiple {}
		foreach {key val} $topdict {
			if {$val > 0} {
				lappend notseen $node
			} elseif {$val < 0} {
				lappend multiple $node
			}
		}
		lappend res {not seen} $notseen
		lappend res multiple $multiple
		# the three cyclical links
		lappend res novalue [llength $novalue]
		foreach word {captain 星際爭霸戰} {
			lappend res $word [expr {$word in $values}]
		}
		return $res
	} -cleanup [cleanup1] -result [sl {
		{not seen} {} multiple {} novalue 3 captain 1 星際爭霸戰 1

	}]

	foreach \
		type {_spec_missing _spec_empty _spec_param _spec_array} \
		spec [list {} [list {}] [list {node mynode}] s] \
		varname {node node mynode s(node)} {

		try [string map [list @type@ $type @spec@ $spec @varname@ $varname] {

			test node_ls&_node@type@ {} -setup $setup3 -body {
				set path {{} {Gene Roddenberry}}
				set nodes1 [tree1 node ls& $path]
				set values1 [tree1 node ls $path]

				set nodes2 {}
				set values2 {}
				set novalue {}
				tree1 node ls& $path @spec@ {
					upvar nodes2 nodes2 values2 values2 novalue novalue
					lappend nodes2 $node
					try {tree1 node val $@varname@} on ok val {
						lappend values2 $val
					} on error {tres copts} {
						lappend novalue $node
					}
				}
				lappend res {no value} [llength $novalue]
				lappend res {lengths are equal} [expr {
					[llength $nodes2] == [llength $nodes1]
				}]
				lappend res $values1 $values2
				return $res
			} -cleanup [cleanup1] -result [sl {
				{no value} 0
				{lengths are equal} 1
				{name hypocoristicon {}}
				{name hypocoristicon {}}
			}]


			test node_ls&_script@type@ {} -setup $setup3 -body {
				set novalue {}
				set values {}
				tree1 node ls& {} @spec@ {
					upvar novalue novalue values values
					try {tree1 node val $@varname@} on ok val {
						lappend values $val
					} on error {tres copts} {
						lappend novalue $node
					}
				}
				lappend res {no value} [llength $novalue]
				foreach word {captain 星際爭霸戰} {
					lappend res $word [expr {$word in $values}]
				}
				return $res
			} -cleanup [cleanup1] -result [sl {
				{no value} 3 captain 1 星際爭霸戰 1
			}]

			test node_ls&_pivot_script@type@ {} -setup $setup3 -body {
				set novalue {}
				tree1 node ls& {{} {Gene Roddenberry}} @spec@ {
					upvar novalue novalue values values
					try {tree1 node val $@varname@} on ok val {
						lappend values $val
					} on error {tres copts} {
						lappend novalue $node
					}
				}
				lappend res {no value} [llength $novalue]
				lappend res $values
				return $res
			} -cleanup [cleanup1] -result [sl {
				{no value} 0 {name hypocoristicon {}}
			}]

		}]
	}


	::apply [list {} {
		upvar setup1 setup1 type type tprefix tprefix
		foreach {type path result} [list \
				nopath {} [sl {
					[list {}] name
				}] \
				empty [list {}] [sl {
					[list {}] name
				}]] {
			test node_new_$type {} -setup $setup1 -body {
				set res {}
				set node [tree1 node new {*}$path]
				tree1 node set $node name archibald 
				lappend res [tree1 node path $node]
				tree1 node ls $node {
					upvar res res
					lappend res $value
				}
				return $res
			} -cleanup [cleanup1] -result $result
		}
	} [namespace current]]


	test node_new_badpath {} -setup $setup1 -body {
		set res {}
		catch {tree1 node new {{} one two three}} res1
		lappend res $res1
		return $res
	} -cleanup [cleanup1] -result [sl {
		{{no such path} node {} path {one two three}}
	}]


	test node_forth {
		forth doesn't go down
	} -setup $setup3 -body {
		set res {}
		set node [tree1 node pivot {} name]
		set st [tree1 node pivot {} {Star Trek}]
		set roddenberry [tree1 node forth& $st]
		set val [tree1 node val $roddenberry]
		lappend res $val
		return $res
	} -cleanup [cleanup1] -result [sl {
		{Gene Roddenberry}
	}]


	test node_nonull {} -setup $setup1 -body {
		set node 100
		set parent 100
		# there is no variable named "value"
		catch {
			tree1 db eval [string map [list @@ [tree1 dbitemprefix]] {
				insert into @@tree values (
					$node, $parent, $value
				)
			}]
		} cres copts
		lappend res {not null constraint} [
			string match {NOT NULL constraint failed:*} $cres]
		return $res
	} -cleanup [cleanup1] -result [sl {
		{not null constraint} 1
	}]


	test node_pivot_node {} -setup $setup3 -body {
		set st [tree1 node pivot {} {Star Trek}]
		set val [tree1 node pivot $st name value]
		lappend res [tree1 node last $val]
		return $res
	} -cleanup [cleanup1] -result [sl {
		Trek
	}]


	test node_forge_bad_node {
		An attempt to forge a node starting from a bad node handle fails
	} -setup $setup1 -body {
		tree1 node forge bogus one two three
		return $res
	} -cleanup [cleanup1] -returnCodes 1 -result [sl {
		{no such node} bogus
	}]


	test node_forge_link {
		new nodes are created under the link rather than under the thing the
		link refers to
	} -setup $setup5 -body {
		lappend res {four is} [tree1 node val $four]
		lappend res {ls three} [tree1 node ls $three]
		set topllink [tree1 node link {} $three] 
		lassign [tree1 node forge {} three] toplink2 created
		lappend res {saw top-level link} [expr {$created == 0}]
		lassign [tree1 node forge $three two] twolink created
		lappend res {forge tree two saw the existing link} [expr {$created == 0}]
		lappend res {link to two is different from two} [expr {$two != $twolink}]
		lassign [tree1 node forge $three two five] five created
		lappend res {created under three} $created 
		set nodes [tree1 node ls& $three]
		#lappend res {}
		lassign [tree1 node forge $five six seven] seven created
		lappend res {created under five} $created 
		lappend res {up from five is link to two} [
			expr {[tree1 node up& $five] == $twolink}]
		return $res
	} -cleanup [cleanup1] -result [sl {
		{one is top} 1
		{two is top} 1
		{three parent is one} 1
		{pivot from one to three is three} 1
		{four is} two
		{ls three} two
		{saw top-level link} 1
		{forge tree two saw the existing link} 1
		{link to two is different from two} 1
		{created under three} 1
		{created under five} 2
		{up from five is link to two} 1
	}]


	test node_pivot_node_pivottargetmatchesvalue {} -setup $setup1 -body {
		set res {}
		set zero [tree1 node new {} 0]
		set one [tree1 node pivot? $zero 0]
		lappend res [expr {$one eq {}}]
		return $res
	} -cleanup [cleanup1] -result [sl {
		1
	}]


	test node_pivot_numeric {} -setup $setup1 -body {
		set res {}
		set number 9
		## it shouldn't be necessary to add an internal numeric representation 
		#expr {$number  + 0}
		set set [tree1 node forge {} paths / one $number two]
		set paths [tree1 node pivot {} paths]
		set two [tree1 node pivot $paths / one $number two]
		lappend res [tree1 node val $two]
		return $res
	} -cleanup [cleanup1] -result [sl {
		two
	}]


	test node_refs {} -setup $setup3 -body {
		set res {}
		set node [tree1 node pivot {} name]
		set st [tree1 node pivot {} {Star Trek}]
		set first [tree1 node down& $st]
		set next [tree1 node forth& $first]
		set first1 [tree1 node down& $next]

		# this is a link to a link to $node
		set link1 [tree1 node link $first1 $first]
		set refs {}
		foreach {ref1 up} [tree1 node refs $node] {
			lappend refs $ref1
		}
		lappend res [llength $refs]
		lappend res [expr {$link1 in $refs}]

		set translation [tree1 node pivot {} translation] 
		set referenced [tree1 node referenced? $translation]
		lappend res {translation referenced?} $referenced

		set referenced [tree1 node referenced? $node]
		lappend res {name referenced?} 1

		return $res
	} -cleanup [cleanup1] -result [sl {
		8 1 {translation referenced?} 0 {name referenced?} 1
	}]


	test node_resolve {} -setup $setup3 -body {
		set res {}
		set count1 0
		set vals1 {}
		set links 0
		tree1 node walk {} {
			upvar links links res res 
			if {$value eq {William Shatner}} {
				if {[tree1 node islink $node]} {
					incr links
				}
				lappend res [tree1 node val $node]
			}
		}
		lappend res $links
		return $res
	} -cleanup [cleanup1] -result [sl {
		{William Shatner}
		{William Shatner}
		{William Shatner}
		2
	}]


	test node_rm {} -setup $setup3 -body {
		set res {}
		set ls [tree1 node ls {}]
		set node [tree1 node pivot {} 星際爭霸戰]
		lappend res [expr {$node >= 0}]
		tree1 node rm $node
		lappend res [catch {tree1 node pivot {} 星際爭霸戰} cres copts]
		lappend res $cres

		return $res
	} -cleanup [cleanup1] -result [sl {
		1 1 {{no such path} node {} path 星際爭霸戰}
	}
	]


	test node_rm_pivot {} -setup $setup3 -body {
		set res {}
		set ls [tree1 node ls {}]
		set node [tree1 node pivot {} 星際爭霸戰]
		lappend res [expr {$node >= 0}]
		tree1 node rm {} 星際爭霸戰
		lappend res [catch {tree1 node pivot {} 星際爭霸戰} cres copts]
		lappend res $cres
		return $res
	} -cleanup [cleanup1] -result [sl {
		1 1 {{no such path} node {} path 星際爭霸戰}
	}]


	test node_rm_recurse {
		removing a node removes all its children
	} -setup $setup2 -body {
		set res {}
		set one [tree1 node pivot {} one]
		set seven [tree1 node pivot $one seven] 
		tree1 node ls& $one {
			upvar count count
			incr count
		}
		lappend res {nodes under} $count

		set size [tree1 size]
		tree1 node rm $one
		set size2 [tree1 size]
		lappend res {node one exists} [tree1 node exists $one]
		lappend res {node seven exists} [tree1 node exists $seven]
		lappend res {size decreased by} [expr {$size - $size2}]
		return $res
	} -cleanup [cleanup1] -result [sl {
		{nodes under} 1
		{node one exists} 0
		{node seven exists} 0
		{size decreased by} 2
	}]


	test node_rm_value_remove {} -setup $setup3 -body {
		set res {}
		set count [tree1 values count]
		set node [tree1 node pivot {} 星際爭霸戰]
		tree1 node rm $node
		set count2 [tree1 values count]
		lappend res [expr {$count - 1 == $count2}] 
		return $res
	} -cleanup [cleanup1] -result [sl {
		1
	}]


	test node_path& {} -setup $setup2 -body {
		set res {}
		set five [tree1 node pivot {} three five]
		set path [tree1 node path& $five]
		foreach node $path {
			lappend res [tree1 node val $node]
		}
		return $res
	} -cleanup [cleanup1] -result [sl {
		three five
	}]

	foreach \
		type {spec_missing _spec_empty _spec_param _spec_array} \
		spec [list {} [list {}] [list {node mynode}] s] \
		varname {node node mynode s(node)} {

		try [string map [list @type@ $type @spec@ $spec @varname@ $varname] {
			test node_path&_script@type@ {} -setup $setup2 -body {
				set res {}
				set five [tree1 node pivot {} three five]
				tree1 node path& $five @spec@ {
					upvar res res
					lappend res [tree1 node val $@varname@]
				}
				return $res
			} -cleanup [cleanup1] -result [sl {
				three five
			}]
		}]
	}


	test node_path {} -setup $setup2 -body {
		set res {}
		set node [tree1 node pivot {} three five]
		lappend res [tree1 node path $node]
		return $res
	} -cleanup [cleanup1] -result [sl {
		{three five}
	}]

	foreach \
		type {spec_missing _spec_empty _spec_param _spec_array} \
		spec [list {} [list {}] [list {value myvalue}] s] \
		varname {value value myvalue s(value)} {
	
		try [string map [list @type@ $type @spec@ $spec @varname@ $varname] {

			test node_path_script$type {} -setup $setup2 -body {
				set res {}
				tree1 node path [list {} three five] @spec@ {
					upvar res res
					lappend res $@varname@
				}
				return $res
			} -cleanup [cleanup1] -result [sl {
				three five
			}]
		}]
	}

	test node_pivot_nosuchnode {} -setup $setup2 -body {
		set res {}
		tree1 node pivot 999
	} -cleanup [cleanup1] -returnCodes 1 -result [sl {
		{no such path} node 999 path {}
	}]


	test node_pivot_link {
		pivots to the link
			not to the link target
	} -setup $setup1 -body {
		set res {}
		lassign [tree1 node forge {} one two] twonode
		lassign [tree1 node forge {} three four] fournode
		set linknode [tree1 node link $fournode $twonode]
		set target [tree1 node target $linknode]
		set testnode [tree1 node pivot $fournode two]
		lappend res [expr {$target eq $twonode}]
		lappend res [expr {$testnode eq $linknode}]
		lappend res [expr {$testnode ne $twonode}]
		return $res
	} -cleanup [cleanup1] -result [sl {
		1 1 1
	}]


	test node_pivot_self {} -setup $setup2 -body {
		set res {}
		set node [tree1 node pivot {} two]
		lappend res [tree1 node val $node]
		set node [tree1 node pivot $node]
		lappend res [tree1 node val $node]
		return $res
	} -cleanup [cleanup1] -result [sl {
		two two
	}]


	test node_pretty {} -setup $setup3 -body {
		set res {}
		set count1 0
		set vals1 {}
		set count1 [tree1 db onecolumn {
			select count(*) as count from tree1tree
		}]
		tree1 node walk {} {
			upvar vals1 vals1
			lappend vals1 [string trim [list $node $up $ref $value]]
		}
		set chan [schan open access w+ data {}]
		tree1 node pretty {} chan $chan
		seek $chan 0
		set pretty [read $chan]
		set count2 0 
		set vals2 {}
		parse $pretty ::apply [list args {
			upvar count2 count2 vals2 vals2
			incr count2
			lappend vals2 [string trim $args]
		} [namespace current]]
		lappend res [expr {$count1 == $count2}]
		lappend res [expr {[llength $vals2] == $count1}]

		set matched 1
		foreach val $vals2 {
			if {$val ni $vals1} {
				set matched 0
				break
			}
		}
		lappend res $matched

		return $res
	} -cleanup [cleanup1] -result [sl {
		1 1 1
	}]


	test node_set {} -setup $setup1 -body {
		set res {}
		set node [tree1 node set {} author Dryden]
		lappend res [tree1 node last {} author]
		return $res
	} -cleanup [cleanup1] -result [sl {
		Dryden
	}]


	test node_set_existing {} -setup $setup1 -body {
		set res {}
		set node [tree1 node set {} author Dryden]
		set pivot1 [tree1 node pivot {} author]
		lappend res [tree1 node last {} author]
		set node [tree1 node set {} author William]
		set pivot2 [tree1 node pivot {} author]
		lappend res [tree1 node last {} author]
		lappend res [expr {$pivot1 == $pivot2}]

		return $res
	} -cleanup [cleanup1] -result [sl {
		Dryden William 1
	}]


	foreach \
		type {spec_missing _spec_empty _spec_param _spec_array} \
		spec [list {} [list {}] [list {value myvalue}] s] \
		varname {value value myvalue s(value)} {

		try [string map [list @type@ $type @spec@ $spec @varname@ $varname] {
			test node_traverse_top@type@ {
				traverse a top node
			} -setup $setup2 -body {
				set res {}
				set one [tree1 node pivot {} one]
				tree1 node traverse $one @spec@ {
					upvar res res
					lappend res $@varname@
				}
				return $res
			} -cleanup [cleanup1] -result [sl {
				one seven
			}]
		}]
	}


	test node_under {} -setup $setup2 -body {
		set res {}
		set one [tree1 node pivot {} one]
		lassign [tree1 node forge $one seven nine eleven] eleven
		set level [tree1 node under $eleven $one]
		lappend res $level
		return $res
	} -cleanup [cleanup1] -result [sl {
		3
	}]


	test node_val_set {} -setup $setup1 -body {
		set res {}
		set node [tree1 node set {} author Dryden]
		tree1 node val $node William
		#lappend res [tree1 node val $node]
		#return $res
	} -cleanup [cleanup1] -result [sl {
		William
	}]



	test node_valueid {
		pivots to the link
			not to the link target
	} -setup $setup1 -body {
		set res {}
		lassign [tree1 node forge {} one two] twonode
		lassign [tree1 node forge {} three four] fournode
		set link1 [tree1 node link $fournode $twonode]
		set link2 [tree1 node link $fournode $link1]

		set v1 [tree1 node valueid $twonode]
		set v2 [tree1 node valueid $link1]
		set v3 [tree1 node valueid $link2]
		lappend res [expr {$v1 eq $v2 && $v1 eq $v3}]
		return $res
	} -cleanup [cleanup1] -result [sl {
		1
	}]


	block {
		upvar setup1 setup1 tprefix tprefix tunit tunit
		set tunit [lindex [time {
			for {set i 0} {$i < 100} {incr i} {
				set a $i
			}
		} 1] 0]

		set maketree {
			set res1 [lindex [time {
				set size1 [tree1 size]
				set count 0
				for {set i 0} {$i < 12} {incr i} {
					lassign [tree1 node forge {} $i] node1 created
					if {!$created} {
						error [list {node not created} 1 $i]
					}
					incr count
					for {set j 0} {$j < 11} {incr j} {
						lassign [tree1 node forge $node1 $j] node2 created
						if {!$created} {
							error [list {node not created} 2 $i $j]
						}
						incr count
						for {set k 0} {$k < 10} {incr k} {
							lassign [tree1 node forge $node2 $k] node3 created
							if {!$created} {
								error [list {node not created} 3 $i $j $k]
							}
							incr count
							for {set l 0} {$l < 9} {incr l} {
								lassign [
									tree1 node forge $node3 $l] node4 created
								if {!$created} {
									error [list {node not created} 4 $i $j $k $l]
								}
								incr count
							}
						}
					}
					set targetsize [expr {$size1 + $count}]
					if {[tree1 size] != $targetsize} {
						error [
							list {wrong number nodes} [tree1 size] $targetsize]
					}
				}
			} 1] 0]
			set perform1 [expr {$res1 / $tunit}]
		}

		set maketree2 {
			set res1 [lindex [time {
				set size1 [tree1 size]
				set count 0
				for {set i 0} {$i < 12} {incr i} {
					for {set j 0} {$j < 11} {incr j} {
						for {set k 0} {$k < 10} {incr k} {
							for {set l 0} {$l < 9} {incr l} {
								lassign [
									tree1 node forge {} $i $j $k $l
								] node created
								if {$created} {
									incr count $created
								} else {
									error [
										list {node not created} 4 $i $j $k $l]
								}
							}
						}
					}
					set targetsize [expr {$size1 + $count}]
					if {[tree1 size] != $targetsize} {
						error [
							list {wrong number nodes} [tree1 size] $targetsize]
					}
				}
			} 1] 0]
			set perform1 [expr {$res1 / $tunit}]
		}

		set maketree3 {
			set res1 [lindex [time {
				set size1 [tree1 size]
				set count 0
				for {set i 0} {$i < 2} {incr i} {
					lassign [tree1 node forge {} $i] node created
					incr count $created
					if {!$created} {
						error [list {node not created} 1 $i]
					}
					for {set j 0} {$j < 3} {incr j} {
						for {set k 0} {$k < 4} {incr k} {
							for {set l 0} {$l < 1000} {incr l} {
								lassign [
									tree1 node forge $node $j $k $l
								] node created
								if {$created} {
									incr count $created
								} else {
									error [
										list {node not created} 4 $i $j $k $l]
								}
							}
						}
					}
					set targetsize [expr {$size1 + $count}]
					if {[tree1 size] != $targetsize} {
						error [
							list {wrong number nodes} [tree1 size] $targetsize]
					}
				}
			} 1] 0]
			set perform1 [expr {$res1 / $tunit}]
		}


		variable perform1 {}
		test performance_set {} -setup $setup1 -body {
			set res1 [lindex [time {
				try $maketree
			} 1] 0]


			lappend res [list less than 50000?] [
				expr {$perform1 < 50000 ? 1 : $perform1}]
			lappend res {size is correct?} [
				expr {[tree1 size] == $size1 + $count}]
			return $res
		} -cleanup [cleanup1] -result [sl {
			{less than 50000?} 1
			{size is correct?} 1
		}]


		test performance_node_checkvalue_nomatch {
			checks the performance of the q_check_value and q_pivot_top_simple
			by searching for a nonexisting value under a node having a large
			number of children
		} -setup $setup1 -body {
			lassign [tree1 node forge {} node1] node1
			set res {}
			for {set i 0} {$i < 131072} {incr i} {
				set lastlink [tree1 node new $node1 hello]
			}

			lassign [time {
				for {set i 0} {$i < 262144} {incr i} {
					set found [tree1 checkvalue $node1 goodbye]
				}
			} 1] ms
			set elapsed [expr {$ms / $tunit}]
			lappend res {elapsed time of} $elapsed \
				{is 265000 standard units or less} [expr {$elapsed < 265000}]
			return $res
		} -cleanup [cleanup1] -match glob -result [sl {
			{elapsed time of} * {is 265000 standard units or less} 1
		}]


		test performance_node_forge {
			is node_forge performant enough
		} -setup $setup1 -body {
			set res1 [lindex [time {
				try $maketree2
			} 1] 0]

			lappend res [list less than 50000?] [
				expr {$perform1 < 50000 ? 1 : $perform1}]
			lappend res {size is correct?} [
				expr {[tree1 size] == $size1 + $count}]
			return $res
		} -cleanup [cleanup1] -result [sl {
			{less than 50000?} 1
			{size is correct?} 1
		}]


		test performance_node_forge_wide {
		} -setup $setup1 -body {
			set res1 [lindex [time {
				try $maketree3
			} 1] 0]

			lappend res [list less than 50000?] [
				expr {$perform1 < 50000 ? 1 : $perform1}]
			lappend res {size is correct?} [
				expr {[tree1 size] == $size1 + $count}]
			return $res
		} -cleanup [cleanup1] -result [sl {
			{less than 50000?} 1
			{size is correct?} 1
		}]


		test performance_node_forge_longname {
		} -setup $setup1 -body {
			set size1 [tree1 size]
			set count 10000
			set digit 0123456789
			set alpha abcdefghijklmnopqrstuvwxyz
			set pathname $alpha/$digit/$alpha/$digit/$alpha/$digit\${i}[
				string repeat $alpha$digit 4]
			set len1 [expr {[llength [split $pathname /]] - 1}]
			set res1 [lindex [time [string map [list @pathname@ $pathname] {
				try { 
					lassign [tree1 node forge {} paths] paths
					incr len1
					for {set i 0} {$i < $count} {incr i} {
					   set path [split @pathname@ /]
						tree1 node forge $paths {*}$path
					}
				}
			}] 1] 0]

			lappend res {size is correct?} [expr {
				[tree1 size] == $size1 + $count + $len1 
			}]

			set perform1 [expr {$res1 / $tunit}]
			lappend res [list performance is in the ballpark of 325000?] [
				expr {$perform1 < 325000 ? 1 : $perform1}]
			return $res
		} -cleanup [cleanup1] -result [sl {
			{size is correct?} 1
			{performance is in the ballpark of 325000?} 1
		}]


		test performance_walk_top {} -setup $setup1 -body {
			try $maketree
			set nodecount 0
			set counts {}
			set res2 [lindex [time {tree1 node walk {} {
				upvar counts counts nodecount nodecount 
				dict incr counts $node
				incr nodecount
			}} 1] 0]
			lappend res {each node once} [::tcl::mathfunc::max {*}[
				dict values $counts]]
			lappend res {size is correct?} [expr {[tree1 size] == $size1 + $count}]
			lappend res {performance is good?} [expr {(double($res2) / $res1 ) < .10}]
			return $res
		} -cleanup [cleanup1] -result [sl {
			{each node once} 1 {size is correct?} 1 {performance is good?} 1 
		}]


		test performance_walk_node {} -setup $setup1 -body {
			try $maketree
			set node [tree1 node pivot {} 3]
			set nodecount 0
			set res2 [lindex [time {tree1 node walk $node {
				upvar nodecount nodecount
				incr nodecount
			}} 1] 0]
			lappend res {size is correct?} [expr {
				[tree1 size] == $size1 + $count
			}]
			set targetsize [expr {
					1
					+ 11
					+ (11 * 10)
					+ (11 * 10 * 9)}
			]
			lappend res {walk count is correct} [expr {
				$nodecount == $targetsize
			}]
			lappend res {performance is good?} [
				expr {(double($res2) / $res1) < .01}]
			return $res
		} -cleanup [cleanup1] -result [sl {
			{size is correct?} 1
			{walk count is correct} 1
			{performance is good?} 1
		}]
	}

	
	test performance_pivot_many children -setup $setup1 -body {
		set one [tree1 node new {} one]
		set two [tree1 node new $one two]
		set three [tree1 node new $two three]
		set iterations 65536

		set name [string repeat abcdefghijlmnopqrstuvwxyz 20]

		set db [tree1 .namespace]::db
		$db eval {
			create table test1 (
				node integer primary key
				, value unique
			)
			;create unique index idx_t1 on test1 (
				value
			)
		}
		::apply [list {} {
			upvar db db elapsed0 elapsed0 name name
			upvar iterations iterations
			lassign [time {
				$db transaction {
					for {set i 0} {$i < $iterations} {incr i} {
						set value $name$i
						$db eval {
							insert into test1 values (
								null, $value
							)
						}
					}
				}
			} 1] elapsed0

			lassign [time {
				$db transaction {
					for {set i 0} {$i < $iterations} {incr i} {
						set value $name$i
						set found [$db eval {
							select node from test1 where value = $value
						}]
					}
				}
			} 1] perform0a
		} [namespace current]]

		lassign [time {
			tree1 db transaction {
				for {set i 0} {$i < $iterations} {incr i} {
					tree1 node new $three $name$i
				}
			}
		} 1] elapsed1
		set ratio [expr {$elapsed0 / double($elapsed1)}]
		lappend res {node creation ratio} $ratio > .5 ? [expr {
			$ratio > .5}]


		#tree1 db transaction {
		#	if 0 {
		#		a left join on tree1link is much slower here
		#			as it causes a scan

		#				3 0 0 {SCAN TABLE tree1tree USING COVERING INDEX tree1tree_idx_value}
		#				5 0 0 {SEARCH TABLE tree1values USING INTEGER PRIMARY KEY (rowid=?)}

		#			therefore

		#				use a subselect instead
		#				
		#					which eliminates the scan

		#						3 0 0 {SEARCH TABLE tree1values USING COVERING INDEX sqlite_autoindex_tree1values_1 (value=?)}
		#						8 0 0 {SEARCH TABLE tree1tree USING COVERING INDEX tree1tree_idx_value (value=?)}
		#						12 0 0 {CORRELATED SCALAR SUBQUERY 1}
		#						16 12 0 {SEARCH TABLE tree1link USING INTEGER PRIMARY KEY (rowid=?)}

		#	}
		#	set query {
		#		with recursive
		#		r (node, value) as (
		#			select tree1tree.node ,tree1tree.value
		#			from tree1tree
		#			join tree1link on tree1link.node = tree1tree.node
		#			union all
		#			select tree1tree.node ,tree1tree.value
		#			from tree1tree join r on tree1tree.node = r.value
		#			where exists (select node from tree1link where node = r.node )
		#		)
		#		select tree1tree.node, tree1values.value
		#		from tree1tree
		#		join tree1values on tree1tree.value = tree1values.node
		#		where (
		#			tree1values.value = $value and not exists (
		#				select node from tree1link where tree1link.node = tree1tree.node
		#			) 
		#		)
		#		union all
		#		select r.node ,r.value from r
		#		join tree1values on r.value = tree1values.node
		#		where not exists (select node from tree1link where node = r.node)  
		#	}
		#	lassign [time {
		#		for {set i 0} {$i < $iterations} {incr i}  {
		#			set value $name$i
		#			set node [tree1 db eval $query]
		#			puts [list {looked up value} $node]
		#		}
		#	} 1] elapsed1
		#}
		#set ratio [expr {$elapsed0 / double($elapsed1)}]
		#lappend res {table link value join ratio of} $ratio > .5  ?  [
		#	expr {$ratio > .5}]

		#lassign [time {
		#	tree1 db transaction {
		#		for {set i 0} {$i < $iterations} {incr i}  {
		#			lassign [tree1 node pivot $three $name$i] node
		#			puts [list {pivoted to} $i]
		#		}
		#	}
		#} 1] elapsed1
		set ratio [expr {$elapsed0 / double($elapsed1)}]
		lappend res {node pivot ratio} $ratio > .5 ? [expr {
			$ratio> .5}]

		set iterations2 [expr {$iterations*2}]
		lassign [time {
			tree1 db transaction {
				for {set i $iterations} {$i < $iterations2} {incr i}  {
					tree1 node pivot? $three $name$i
					#puts [list {attempted pivot to} $i]
				}
			}
		} 1] elapsed1
		set ratio [expr {$elapsed0 / double($elapsed1)}]
		lappend res {node pivot attempt ratio} $ratio > .5 ? [expr {
			$ratio> .5}]

		return $res
	} -cleanup [cleanup1] -match glob -result [sl {
		{node creation ratio} * > .5 ? 1
		{node pivot ratio} * > .5 ?  1
		{table link value join ratio of} * > .5 ? 1
		{node pivot ratio} *  > .5 ? 1
		{node pivot attempt ratio} * > .5 ? 1 
	}]


	test up_from_top {
		moving up from the top node
	} -setup $setup1 -body {
		lassign [tree1 node new {} {}] node
		set up [tree1 node up& $node]
		lappend res $up
		return $res
	} -cleanup [cleanup1] -result [sl {
		{}
	}]


	test value_number {} -setup $setup1 -body {
		set res {}
		set node [tree1 node new {} 2.3e5]
		tree1 node val $node
	} -cleanup [cleanup1] -result [sl {
		2.3e5
	}]


	test value_bytes {} -setup $setup1 -body {
		set res {}
		set data [bytes]
		set node [tree1 node new {} $data]
		set data2 [tree1 node val $node]
		lappend res [expr {$data eq $data2}]
		return $res
	} -cleanup [cleanup1] -result [sl {
		1
	}]


	test read {} -setup $setup1 -body {
		set res {}
		tree1 read [startrek]
		set count1 0
		set vals1 {}
		tree1 node walk {} {
			upvar count1 count1 res res vals1 vals1
			incr count1
			lappend vals1 $node
		}
		set count2 [tree1 db onecolumn {select count(*) as count from tree1tree}]
		set vals2 [tree1 db eval {select node from tree1tree}]
		foreach val $vals2 {
			if {$val ni $vals1} {
				puts [list missing $val]
			}
		}
		lappend res [expr {$count1 == $count2}]

		set node [tree1 node pivot {} {Star Trek} {}]

		# record 118 has a value of 4 and would be a valid link if the node
		# value was odd 
		set children [tree1 node ls $node]
		lappend res $children

		return $res
	} -cleanup [cleanup1] -result [sl {
		1
		{4 seasons roles}
	}]



	foreach \
		type {spec_missing spec_empty spec_param spec_array} \
		spec [list {} [list {}] [list {
			level mylevel node mynode up myup ref myref value myvalue}] s] \
		levelname {level level mylevel s(level)} \
		nodename {node node mynode s(node)} \
		up {up up myup s(up)} \
		refname {ref ref myref s(ref)} \
		valuename {value value myvalue s(value)} \
	{
		try [string map [list @type@ $type @spec@ $spec @levelname@ \
			$levelname @nodename@ $nodename @up@ $up \
			@refname@ $refname @valuename@ $valuename] {

			test walk_$type {} -setup $setup2 -body {
				set res {}
				set res2 {}
				set count1 0
				tree1 node ls& {} {
					if {$node == 0} continue
					uplevel 1 [list tree1 node walk $node @spec@ {
						upvar count1 count1 res2 res2
						incr count1

						lappend res2 [list $@levelname@ [
							tree1 node val $@nodename@] [
							tree1 node val $@up@] \
							[tree1 value get $@refname@] $@valuename@]
					}]
				}
				lappend res {*}$res2
				return $res
			} -cleanup [cleanup1] -result [sl {
				{0 one one one one}
				{1 seven one seven seven}
				{0 two two two two}
				{0 three three three three}
				{1 four three four four}
				{1 five three five five}
			}]


			test walk_break@type@ {
				break off the walk
			} -setup $setup2 -body {
				set res {}
				set res2 {}
				set count1 0
				tree1 node ls& {} {
					if {$node == 0} continue
					uplevel 1 [list tree1 node walk $node @spec@ {
						upvar count1 count1 res2 res2
						if {[incr count1] > 3} break
						lappend res2 [list $@levelname@ [
							tree1 node val $@nodename@] [
							tree1 node val $@up@] $@valuename@]
					}]
				}
				lappend res {*}$res2
				return $res
			} -cleanup [cleanup1] -result [sl {
				{0 one one one} {1 seven one seven} {0 two two two}
			}]

			test walk_node@type@ {} -setup $setup2 -body {
				set res {}
				set res2 {}
				set count1 0
				set node [tree1 node pivot {} three]
				tree1 node walk $node @spec@ {
					upvar count1 count1 res2 res2
					incr count1
					lappend res2 [list [
						tree1 node val $@nodename@] $@levelname@ [
							tree1 node val $@up@] $@valuename@]
				}
				set count2 [tree1 db onecolumn {
					select count(*) as count from tree1tree
				}]
				lappend res [expr {$count1 == $count2}]
				lappend res {*}$res2
				return $res
			} -cleanup [cleanup1] -result [sl {
				0 {three 0 three three} {four 1 three four} {five 1 three five}
			}]


		}]
	}


	cleanupTests
}