blob: c55a54e415524cbed30c6818d10a92276febad3c (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
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
|
