83d72a091e
Initial check-in of openocd-0.7.0 as it can be downloaded from http://sourceforge.net/projects/openocd/files/openocd/0.7.0/ Any modifications will follow. Change-Id: I6949beaefd589e046395ea0cb80f4e1ab1654d55
62 lines
1.1 KiB
Plaintext
62 lines
1.1 KiB
Plaintext
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}
|
|
|
|
testreport
|