# 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 100000 } 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