debuggers: import openocd-0.7.0
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
This commit is contained in:
61
debuggers/openocd/jimtcl/tests/tailcall.test
Normal file
61
debuggers/openocd/jimtcl/tests/tailcall.test
Normal file
@ -0,0 +1,61 @@
|
||||
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
|
||||
Reference in New Issue
Block a user