1 files changed, 115 insertions, 0 deletions
diff --git a/tests/tailcall.test b/tests/tailcall.test
new file mode 100644
index 0000000..eaa48cc
--- /dev/null
+++ b/tests/tailcall.test
@@ -0,0 +1,115 @@
+# vim:se syntax=tcl:
+
+source [file dirname [info script]]/testing.tcl
+
+needs cmd tailcall
+needs cmd try tclcompat
+
+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.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}
+
+test tailcall-1.6 {tailcall pass through return} {
+	proc a {script} {
+		# return from $script should pass through back to the caller
+		tailcall foreach i {1 2 3} $script
+	}
+	proc b {} {
+		a {return ok}
+		# Should not get here
+		return bad
+	}
+	b
+} {ok}
+
+test tailcall-1.7 {tailcall with namespaces} jim {
+	proc a::b {} {
+		proc c {} {
+			return 1
+		}
+		set d [local lambda {} { c }]
+		# $d should resolve in namespace 'a', not ""
+		tailcall $d
+	}
+	a::b
+} 1
+
+test tailcall-1.8 {tailcall with local} jim {
+	proc a {} {
+		tailcall [local proc b {} { return c }]
+	}
+	a
+} {c}
+
+test tailcall-1.9 {tailcall with large number of invocations} {
+	proc a {n} {
+		if {$n == 0} {
+			return 1
+		}
+		incr n -1
+		tailcall a $n
+	}
+	a 1000
+} 1
+
+test tailcall-1.10 {tailcall through uplevel} {
+	proc a {} { tailcall b }
+	proc b {} { uplevel 1 c }
+	proc c {} { tailcall d }
+	proc d {} { return [info level] }
+	a
+} 1
+
+test tailcall-1.11 {chained tailcall} {
+	proc a {} { b }
+	proc b {} { tailcall tailcall c }
+	proc c {} { return [info level] }
+	a
+} 1
+
+test tailcall-1.12 {uplevel tailcall} {
+	proc a {} { b }
+	proc b {} { uplevel 1 tailcall c }
+	proc c {} { return [info level] }
+	a
+} 1
+
+testreport