Improvements to tailcall

Add tests and documentation
Make tailcall work within 'try'
Fix tailcall interaction with uplevel
Use tailcall for dispatch in tree.tcl
Also some related improvements in tree.tcl

Signed-off-by: Steve Bennett <steveb@workware.net.au>

2 files changed, 57 insertions, 6 deletions

diff --git a/tests/tailcall.test b/tests/tailcall.test
new file mode 100644
index 0000000..eb097e5
--- /dev/null
+++ b/tests/tailcall.test
@@ -0,0 +1,50 @@
+source testing.tcl
+
+test tailcall-1.1 {Basic tailcall} {
+	# Demo -- a tail-recursive factorial function
+	proc fac {x {val 1}} {
+		if {$x <= 2} {
+			expr {$x * $val}
+		} else {
+			tailcall fac [expr {$x -1}] [expr {$x * $val}]
+		}
+	}
+	fac 10
+} {3628800}
+
+test tailcall-1.2 {Tailcall in try} {
+	set x 0
+	proc a {} { upvar x x; incr x }
+	proc b {} { upvar x x; incr x 4; try { tailcall a } finally { incr x 8 }}
+	b
+	set x
+} {13}
+
+test tailcall-1.3 {Tailcall does return} {
+	set x 0
+	proc a {} { upvar x x; incr x }
+	proc b {} { upvar x x; incr x 4; tailcall a; incr x 8}
+	b
+	set x
+} {5}
+
+test tailcall-1.4 {uplevel tailcall} {
+	proc a {} { set ::y [info level] }
+	proc b {} { set ::x [info level]; uplevel 1 tailcall a}
+	b
+	list $x $y
+} {1 1}
+
+test tailcall-1.5 {interaction of uplevel and tailcall} {
+	proc a {cmd} {
+		tailcall $cmd
+	}
+	proc b {} {
+		lappend result [uplevel 1 a c]
+		lappend result [uplevel 1 a c]
+	}
+	proc c {} {
+		return c
+	}
+	a b
+} {c c}
diff --git a/tests/tree.test b/tests/tree.test
index e5b539a..d9aa389 100644
--- a/tests/tree.test
+++ b/tests/tree.test
@@ -3,6 +3,10 @@ package require tree
 
 section "tree"
 
+proc dputs {msg} {
+	#puts $msg
+}
+
 test tree-1.1 "Create tree" {
 	tree create pt
 	return 1
@@ -76,15 +80,15 @@ test tree-2.0 "Add more nodes" {
 
 test tree-2.1 "walk dfs" {
 	set result {}
-	#puts ""
+	dputs ""
 	pt walk root dfs {action n} {
 		set indent [string repeat "  " [pt depth $n]]
 		if {$action == "enter"} {
 			lappend result [pt get $n name]
-			#puts "$indent[pt get $n name]"
+			dputs "$indent[pt get $n name]"
 		}
 	}
-	#puts ""
+	dputs ""
 	set result
 } {rootnode childnode1 childnode2 n.c4 n.c5 n.c5.c6 root.c2 root.c3}
 
@@ -109,6 +113,3 @@ test tree-2.3 "walk bfs" {
 } {rootnode childnode1 root.c2 root.c3 childnode2 n.c4 n.c5 n.c5.c6}
 
 tree destroy pt
-
-collect
-#pt set root name value