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:
Lars Rademacher
563
debuggers/openocd/jimtcl/tests/misc.test
Normal file
563
debuggers/openocd/jimtcl/tests/misc.test
Normal file
@ -0,0 +1,563 @@
|
||||
source [file dirname [info script]]/testing.tcl
|
||||
|
||||
needs constraint jim
|
||||
needs cmd gets tclcompat
|
||||
needs cmd array
|
||||
|
||||
catch {unset a b}
|
||||
test regr-1.1 "Double dereference arrays" {
|
||||
array set a {one ONE two TWO three THREE}
|
||||
array set b {ONE 1 TWO 2 THREE 3}
|
||||
set chan two
|
||||
set b($a($chan))
|
||||
} {2}
|
||||
|
||||
# Will assert on exit if the bug exists
|
||||
test regr-1.2 "Reference count shared literals" {
|
||||
proc a {} {
|
||||
while {1} {break}
|
||||
}
|
||||
a
|
||||
rename a ""
|
||||
return 1
|
||||
} {1}
|
||||
|
||||
test regr-1.3 "Invalid for expression" jim {
|
||||
# Crashes with invalid expression
|
||||
catch {
|
||||
for {set i 0} {$i < n} {incr i} {
|
||||
set a(b) $i
|
||||
set a(c) $i
|
||||
break
|
||||
}
|
||||
}
|
||||
} 1
|
||||
|
||||
test regr-1.4 "format double percent" {
|
||||
format (%d%%) 12
|
||||
} {(12%)}
|
||||
|
||||
test regr-1.5 "lassign with empty list" {
|
||||
unset -nocomplain a b c
|
||||
lassign {} a b c
|
||||
info exists c
|
||||
} {1}
|
||||
|
||||
test io-1.1 "Read last line with no newline" {
|
||||
set lines 0
|
||||
set f [open $testdir/testio.in]
|
||||
while {[gets $f buf] >= 0} {
|
||||
incr lines
|
||||
}
|
||||
close $f
|
||||
list $lines
|
||||
} {2}
|
||||
|
||||
set g1 1
|
||||
set g2 2
|
||||
array set g3 {4 5 6 7}
|
||||
|
||||
proc test_unset {} {
|
||||
test unset-1.1 "Simple var" {
|
||||
set g4 4
|
||||
list [catch {unset g4; info exists g4} msg] $msg
|
||||
} {0 0}
|
||||
|
||||
test unset-1.2 "Simple var" {
|
||||
list [catch {unset g4; info exists g4} msg] $msg
|
||||
} {1 {can't unset "g4": no such variable}}
|
||||
|
||||
test unset-1.3 "Simple var" {
|
||||
list [catch {unset g2; info exists g2} msg] $msg
|
||||
} {1 {can't unset "g2": no such variable}}
|
||||
|
||||
test unset-1.4 "Global via global" {
|
||||
global g1
|
||||
list [catch {unset g1; info exists g1} msg] $msg
|
||||
} {0 0}
|
||||
|
||||
test unset-1.5 "Global error" {
|
||||
list [catch {unset ::g2; info exists ::g2} msg] $msg
|
||||
} {0 0}
|
||||
|
||||
test unset-1.6 "Global array" {
|
||||
list [catch {unset ::g3; info exists ::g3} msg] $msg
|
||||
} {0 0}
|
||||
|
||||
test unset-1.7 "Simple var -nocomplain" {
|
||||
list [catch {unset -nocomplain g2; info exists g2} msg] $msg
|
||||
} {0 0}
|
||||
|
||||
test unset-1.8 "Simple var --" {
|
||||
list [catch {unset -- g2; info exists g2} msg] $msg
|
||||
} {1 {can't unset "g2": no such variable}}
|
||||
|
||||
test unset-1.9 "Simple var -nocomplain --" {
|
||||
set g2 1
|
||||
list [catch {unset -nocomplain -- g2; info exists g2} msg] $msg
|
||||
} {0 0}
|
||||
|
||||
test unset-1.10 "Var named -nocomplain with --" {
|
||||
set -nocomplain 1
|
||||
list [catch {unset -- -nocomplain; info exists -nocomplain} msg] $msg
|
||||
} {0 0}
|
||||
|
||||
test unset-1.11 "Unset no args" {
|
||||
list [catch {unset} msg] $msg
|
||||
} {0 {}}
|
||||
}
|
||||
|
||||
test_unset
|
||||
|
||||
test lrepeat-1.1 "Basic tests" {
|
||||
lrepeat 1 a
|
||||
} {a}
|
||||
|
||||
test lrepeat-1.2 "Basic tests" {
|
||||
lrepeat 1 a b
|
||||
} {a b}
|
||||
|
||||
test lrepeat-1.3 "Basic tests" {
|
||||
lrepeat 2 a b
|
||||
} {a b a b}
|
||||
|
||||
test lrepeat-1.4 "Basic tests" {
|
||||
lrepeat 2 a
|
||||
} {a a}
|
||||
|
||||
test lrepeat-1.5 "Errors" {
|
||||
catch {lrepeat}
|
||||
} {1}
|
||||
|
||||
test lrepeat-1.6 "Errors" {
|
||||
lrepeat 1
|
||||
} {}
|
||||
|
||||
test lrepeat-1.7 "Errors" {
|
||||
lrepeat 0 a b
|
||||
} {}
|
||||
|
||||
test lrepeat-1.8 "Errors" {
|
||||
catch {lrepeat -10 a}
|
||||
} {1}
|
||||
|
||||
test lindex-1.1 "Integer" {
|
||||
lindex {a b c} 0
|
||||
} a
|
||||
|
||||
test lindex-1.2 "Integer" {
|
||||
lindex {a b c} 2
|
||||
} c
|
||||
|
||||
test lindex-1.3 "Integer" {
|
||||
lindex {a b c} -1
|
||||
} {}
|
||||
|
||||
test lindex-1.4 "Integer" {
|
||||
lindex {a b c} 4
|
||||
} {}
|
||||
|
||||
test lindex-1.5 "end" {
|
||||
lindex {a b c} end
|
||||
} c
|
||||
|
||||
test lindex-1.6 "end" {
|
||||
lindex {a b c} end-1
|
||||
} b
|
||||
|
||||
test lindex-1.7 "end" {
|
||||
lindex {a b c} end-4
|
||||
} {}
|
||||
|
||||
test lindex-1.8 "end + " {
|
||||
lindex {a b c} end+1
|
||||
} {}
|
||||
|
||||
test lindex-1.9 "end + " {
|
||||
lindex {a b c} end+-1
|
||||
} b
|
||||
|
||||
test lindex-1.10 "end - errors" {
|
||||
catch {lindex {a b c} end-}
|
||||
} 1
|
||||
|
||||
test lindex-1.11 "end - errors" {
|
||||
catch {lindex {a b c} end-blah}
|
||||
} 1
|
||||
|
||||
test lindex-1.12 "int+int, int-int" {
|
||||
lindex {a b c} 0+4
|
||||
} {}
|
||||
|
||||
test lindex-1.13 "int+int, int-int" {
|
||||
lindex {a b c} 3-1
|
||||
} c
|
||||
|
||||
test lindex-1.14 "int+int, int-int" {
|
||||
lindex {a b c} 1--1
|
||||
} c
|
||||
|
||||
test lindex-1.15 "int+int, int-int" {
|
||||
set l {a b c}
|
||||
lindex $l [lsearch $l b]-1
|
||||
} a
|
||||
|
||||
test lindex-1.16 "int+int, int-int" {
|
||||
lindex {a b c} 0+1
|
||||
} b
|
||||
|
||||
test lindex-1.17 "int+int - errors" {
|
||||
catch {lindex {a b c} 5-blah}
|
||||
} 1
|
||||
|
||||
test lindex-1.18 "int+int - errors" {
|
||||
catch {lindex {a b c} blah-2}
|
||||
} 1
|
||||
|
||||
test lindex-1.19 "int+int - errors" {
|
||||
catch {lindex {a b c} 5+blah}
|
||||
} 1
|
||||
|
||||
test lindex-1.20 "unary plus" {
|
||||
lindex {a b c} +2
|
||||
} c
|
||||
|
||||
test incr-1.1 "incr unset" {
|
||||
unset -nocomplain a
|
||||
incr a
|
||||
set a
|
||||
} 1
|
||||
|
||||
test incr-1.2 "incr, incr unset" {
|
||||
incr a
|
||||
} 2
|
||||
|
||||
test incr-1.3 "incr unset array element" {
|
||||
unset -nocomplain a
|
||||
incr a(2)
|
||||
set a(2)
|
||||
} 1
|
||||
|
||||
test incr-1.4 "incr array element - shimmering" {
|
||||
set b "$a(2)-test"
|
||||
incr a(2)
|
||||
} 2
|
||||
|
||||
test catch-1.1 "catch ok" {
|
||||
list [catch {set abc 2} result] $result
|
||||
} {0 2}
|
||||
|
||||
test catch-1.2 "catch error" {
|
||||
list [catch {error 3} result] $result
|
||||
} {1 3}
|
||||
|
||||
test catch-1.3 "catch break" {
|
||||
list [catch {break} result] $result
|
||||
} {3 {}}
|
||||
|
||||
test catch-1.4 "catch -nobreak" {
|
||||
set result {}
|
||||
foreach x {a b c} {
|
||||
lappend result $x
|
||||
# This acts just like break since it won't be caught by catch
|
||||
catch -nobreak {break} tmp
|
||||
}
|
||||
set result
|
||||
} {a}
|
||||
|
||||
test catch-1.5 "catch -no3" {
|
||||
set result {}
|
||||
foreach x {a b c} {
|
||||
lappend result $x
|
||||
# Same as above, but specify as an integer
|
||||
catch -no3 {break} tmp
|
||||
}
|
||||
set result
|
||||
} {a}
|
||||
|
||||
test catch-1.6 "catch break" {
|
||||
set result {}
|
||||
foreach x {a b c} {
|
||||
lappend result $x
|
||||
# This does nothing since the break is caught
|
||||
catch {break} tmp
|
||||
}
|
||||
set result
|
||||
} {a b c}
|
||||
|
||||
|
||||
test catch-1.7 "catch exit" {
|
||||
# Normally exit would not be caught
|
||||
dict get [info returncodes] [catch -exit {exit 5} result]
|
||||
} {exit}
|
||||
|
||||
test catch-1.8 "catch error has -errorinfo" {
|
||||
set rc [catch {set undefined} msg opts]
|
||||
list $rc [info exists opts(-errorinfo)]
|
||||
} {1 1}
|
||||
|
||||
test catch-1.9 "catch no error has no -errorinfo" {
|
||||
set rc [catch {set x 1} msg opts]
|
||||
list $rc [info exists opts(-errorinfo)]
|
||||
} {0 0}
|
||||
|
||||
test return-1.1 "return can rethrow an error" {
|
||||
proc a {} { error "from a" }
|
||||
proc b {} { catch {a} msg opts; return {*}$opts $msg }
|
||||
set rc [catch {b} msg opts]
|
||||
list $rc $msg [llength $opts(-errorinfo)]
|
||||
} {1 {from a} 6}
|
||||
|
||||
test return-1.2 "error can rethrow an error" {
|
||||
proc a {} { error "from a" }
|
||||
proc b {} { catch {a} msg; error $msg [info stacktrace] }
|
||||
set rc [catch {b} msg opts]
|
||||
list $rc $msg [llength $opts(-errorinfo)]
|
||||
} {1 {from a} 9}
|
||||
|
||||
test return-1.3 "return can rethrow no error" {
|
||||
proc a {} { return "from a" }
|
||||
proc b {} { catch {a} msg opts; return {*}$opts $msg }
|
||||
set rc [catch {b} msg opts]
|
||||
#list $rc $msg [llength $opts(-errorinfo)]
|
||||
list $rc $msg [info exists opts(-errorinfo)]
|
||||
} {0 {from a} 0}
|
||||
|
||||
test stringreverse-1.1 "Containing nulls" {
|
||||
string reverse abc\0def
|
||||
} "fed\0cba"
|
||||
|
||||
test split-1.1 "Split with leading null" {
|
||||
split "\0abc\0def\0" \0
|
||||
} {{} abc def {}}
|
||||
|
||||
test parsevar-1.1 "Variables should include double colons" {
|
||||
set ::a::b 2
|
||||
set x $::a::b
|
||||
unset ::a::b
|
||||
set x
|
||||
} 2
|
||||
|
||||
test sharing-1.1 "Problems with ref sharing in arrays: lappend" {
|
||||
set a {a 1 c 2}
|
||||
set b $a
|
||||
lappend b(c) 3
|
||||
set a(c)
|
||||
} 2
|
||||
|
||||
test sharing-1.2 "Problems with ref sharing in arrays: append" {
|
||||
set a {a 1 c 2}
|
||||
set b $a
|
||||
append b(c) 3
|
||||
set a(c)
|
||||
} 2
|
||||
|
||||
test sharing-1.3 "Problems with ref sharing in arrays: incr" {
|
||||
set a {a 1 c 2}
|
||||
set b $a
|
||||
incr b(c)
|
||||
set a(c)
|
||||
} 2
|
||||
|
||||
test sharing-1.4 "Problems with ref sharing in arrays: lset" {
|
||||
set a {a 1 c {2 3}}
|
||||
set b $a
|
||||
lset b(c) 1 x
|
||||
set a(c)
|
||||
} {2 3}
|
||||
|
||||
test jimexpr-1.1 "integer ** operator" {
|
||||
expr {2 ** 3}
|
||||
} 8
|
||||
|
||||
test jimexpr-1.2 "integer ** operator" {
|
||||
expr {0 ** 3}
|
||||
} 0
|
||||
|
||||
test jimexpr-1.3 "integer ** operator" {
|
||||
expr {2 ** 0}
|
||||
} 1
|
||||
|
||||
test jimexpr-1.4 "integer ** operator" {
|
||||
expr {-2 ** 1}
|
||||
} -2
|
||||
|
||||
test jimexpr-1.5 "integer ** operator" {
|
||||
expr {3 ** -2}
|
||||
} 0
|
||||
|
||||
test jimexpr-1.6 "+ command" {
|
||||
+ 1
|
||||
} 1
|
||||
|
||||
test jimexpr-1.7 "+ command" {
|
||||
+ 2 3.5
|
||||
} 5.5
|
||||
|
||||
test jimexpr-1.8 "+ command" {
|
||||
+ 2 3 4 -6
|
||||
} 3
|
||||
|
||||
test jimexpr-1.9 "* command" {
|
||||
* 4
|
||||
} 4
|
||||
|
||||
test jimexpr-1.10 "* command" {
|
||||
* 4 2
|
||||
} 8
|
||||
|
||||
test jimexpr-1.11 "* command" {
|
||||
* 4 2 -0.5
|
||||
} -4.0
|
||||
|
||||
test jimexpr-1.12 "/ command" {
|
||||
/ 2
|
||||
} 0.5
|
||||
|
||||
test jimexpr-1.12 "/ command" {
|
||||
/ 0.5
|
||||
} 2.0
|
||||
|
||||
test jimexpr-1.13 "/ command" {
|
||||
/ 12 3
|
||||
} 4
|
||||
|
||||
test jimexpr-1.14 "/ command" {
|
||||
/ 12 3 2.0
|
||||
} 2.0
|
||||
|
||||
test jimexpr-1.15 "- command" {
|
||||
- 6
|
||||
} -6
|
||||
|
||||
test jimexpr-1.15 "- command" {
|
||||
- 6.5
|
||||
} -6.5
|
||||
|
||||
test jimexpr-1.16 "- command" {
|
||||
- 6 3
|
||||
} 3
|
||||
|
||||
test jimexpr-1.17 "- command" {
|
||||
- 6 3 1.5
|
||||
} 1.5
|
||||
|
||||
test jimexpr-1.17 "- command" {
|
||||
- 6.5 3
|
||||
} 3.5
|
||||
|
||||
test jimexpr-2.1 "errors in math commands" {
|
||||
list [catch /] [catch {/ x}] [catch -] [catch {- blah blah}] [catch {- 2.0 blah}] [catch {+ x y}] [catch {* x}]
|
||||
} {1 1 1 1 1 1 1}
|
||||
|
||||
test jimexpr-2.2 "not var optimisation" {
|
||||
set x [expr 1]
|
||||
set y [expr 0]
|
||||
set z [expr 2.0]
|
||||
list [expr {!$x}] [expr {!$y}] [expr {!$z}]
|
||||
} {0 1 0}
|
||||
|
||||
test jimexpr-2.3 "expr access unset var" {
|
||||
unset -nocomplain a
|
||||
catch {expr {3 * $a}}
|
||||
} 1
|
||||
|
||||
test jimexpr-2.4 "expr double as bool" {
|
||||
set x 2
|
||||
if {1.0} {
|
||||
set x 3
|
||||
}
|
||||
} 3
|
||||
|
||||
# May be supported if support compiled in
|
||||
test jimexpr-2.5 "double ** operator" {
|
||||
catch {expr {2.0 ** 3}} result
|
||||
expr {$result in {unsupported 8.0}}
|
||||
} 1
|
||||
|
||||
# This one is for test coverage of an unusual case
|
||||
test jimobj-1.1 "duplicate obj with no dupIntRepProc" {
|
||||
proc "x x" {} { return 2 }
|
||||
set a "x x"
|
||||
# force it to be a command object
|
||||
set b [$a]
|
||||
# A second reference
|
||||
set c $a
|
||||
# Now force it to be duplicated
|
||||
lset a 1 x
|
||||
# force the duplicate object it to be a command object again
|
||||
set b [$a]
|
||||
# And get the string rep
|
||||
set x "y $a"
|
||||
} "y x x"
|
||||
|
||||
test jimobj-1.2 "cooerced double to int" {
|
||||
set x 3
|
||||
# cooerce to a double
|
||||
expr {4.5 + $x}
|
||||
# Now get the int rep
|
||||
incr x
|
||||
} 4
|
||||
|
||||
test jimobj-1.3 "cooerced double to double" {
|
||||
set x 3
|
||||
# cooerce to a double
|
||||
expr {4.5 + $x}
|
||||
# Now use as a double
|
||||
expr {1.5 + $x}
|
||||
} 4.5
|
||||
|
||||
test jimobj-1.4 "incr dict sugar" {
|
||||
unset -nocomplain a
|
||||
set a(3) 3
|
||||
incr a(3)
|
||||
list $a(3) $a
|
||||
} {4 {3 4}}
|
||||
|
||||
test jim-badvar-1.1 "invalid variable name" {
|
||||
set x b\0c
|
||||
catch {set $x 5}
|
||||
} 1
|
||||
|
||||
test jim-badvar-1.2 "incr invalid variable name" {
|
||||
set x b\0c
|
||||
catch {incr $x}
|
||||
} 1
|
||||
|
||||
test lset-1.1 "lset with bad var" {
|
||||
catch {lset badvar 1 x}
|
||||
} 1
|
||||
|
||||
test dict-1.1 "dict to string" {
|
||||
set a [dict create abc \\ def \"]
|
||||
set x x$a
|
||||
} "xabc \\\\ def {\"}"
|
||||
|
||||
test channels-1.1 {info channels} {
|
||||
lsort [info channels]
|
||||
} {stderr stdin stdout}
|
||||
|
||||
test lmap-1.1 {lmap} {
|
||||
lmap p {1 2 3} {incr p}
|
||||
} {2 3 4}
|
||||
|
||||
test exprerr-1.1 {Error message with bad expr} {
|
||||
catch {expr {5 ||}} msg
|
||||
set msg
|
||||
} {Expression has bad operands to ||}
|
||||
|
||||
test eval-list-1.1 {Lost string rep with list} {
|
||||
set x {set y 1; incr y}
|
||||
# Convert to list rep internally
|
||||
lindex $x 4
|
||||
# But make sure we don't lost the original string rep
|
||||
list [catch $x] $y
|
||||
} {0 2}
|
||||
|
||||
test info-statics-1.1 {info statics commands} {
|
||||
set x 1
|
||||
proc a {} {x {y 2}} {}
|
||||
info statics a
|
||||
} {x 1 y 2}
|
||||
|
||||
testreport
|
||||
Reference in New Issue
Block a user