diff options
author | Steve Bennett <steveb@workware.net.au> | 2011-12-02 13:24:38 +1000 |
---|---|---|
committer | Steve Bennett <steveb@workware.net.au> | 2021-01-09 11:06:48 +1000 |
commit | fe37b8dc2536b70d0aba3c6a70ead466ebe5b9d6 (patch) | |
tree | f4e3db58f298facf7cf84272d3a3321144c23d32 /tests/xtrace.test | |
parent | b8018299ad54fecfdcffe4b22ac994944a716f2a (diff) | |
download | jimtcl-fe37b8dc2536b70d0aba3c6a70ead466ebe5b9d6.zip jimtcl-fe37b8dc2536b70d0aba3c6a70ead466ebe5b9d6.tar.gz jimtcl-fe37b8dc2536b70d0aba3c6a70ead466ebe5b9d6.tar.bz2 |
Add the [xtrace] command
Allows a debugger or tracing facility to be implemented
Signed-off-by: Steve Bennett <steveb@workware.net.au>
Diffstat (limited to 'tests/xtrace.test')
-rw-r--r-- | tests/xtrace.test | 62 |
1 files changed, 62 insertions, 0 deletions
diff --git a/tests/xtrace.test b/tests/xtrace.test new file mode 100644 index 0000000..c55a54e --- /dev/null +++ b/tests/xtrace.test @@ -0,0 +1,62 @@ +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 |