63 lines
1.6 KiB
Plaintext
63 lines
1.6 KiB
Plaintext
source [file dirname [info script]]/testing.tcl
|
|
|
|
needs cmd xtrace
|
|
|
|
# Simply accumulate the callback args in the list ::lines
|
|
proc xtracetest {args} {
|
|
lappend ::lines $args
|
|
}
|
|
|
|
proc xtracesummary {lines} {
|
|
# Omit the last line that will always be xtrace {}
|
|
# Remove file and line
|
|
lmap line [lrange $lines 0 end-1] {
|
|
lassign $line type file line result cmd arglist
|
|
list $type ($result) $cmd $arglist
|
|
}
|
|
}
|
|
|
|
proc xtracetestproc {a} {
|
|
append a " world"
|
|
return $a
|
|
}
|
|
|
|
test xtrace-1.1 {xtrace usage} -body {
|
|
xtrace
|
|
} -returnCodes error -result {wrong # args: should be "xtrace callback"}
|
|
|
|
test xtrace-1.2 {xtrace non-proc} -body {
|
|
set lines {}
|
|
xtrace xtracetest
|
|
set x 3
|
|
xtrace {}
|
|
xtracesummary $lines
|
|
} -result {{cmd () set {x 3}}}
|
|
|
|
# This will produce 4 calls to the trace callback
|
|
# 1. xtracetestproc hello (cmd)
|
|
# 2. xtracetestproc hello (proc - when executing the proc body)
|
|
# 3. append a " hello"
|
|
# 4. return "hello world" (previous command result will be "hello world")
|
|
test xtrace-1.3 {xtrace proc} -body {
|
|
set lines {}
|
|
xtrace xtracetest
|
|
xtracetestproc hello
|
|
xtrace {}
|
|
xtracesummary $lines
|
|
} -result {{cmd () xtracetestproc hello} {proc () xtracetestproc hello} {cmd () append {a { world}}} {cmd {(hello world)} return {{hello world}}}}
|
|
|
|
test xtrace-1.4 {xtrace line numbers} -body {
|
|
set lines {}
|
|
xtrace xtracetest
|
|
set x abc
|
|
xtrace {}
|
|
# Now the first callback should happen at the correct line number
|
|
lassign [lindex $lines 0] - tracefile traceline
|
|
lassign [info source $x] file line
|
|
if {"$tracefile:$traceline" eq "$file:$line"} {
|
|
function ok
|
|
}
|
|
} -result {ok}
|
|
|
|
testreport
|