summaryrefslogtreecommitdiffstats
path: root/tests/trace.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/trace.test')
-rw-r--r--tests/trace.test129
1 files changed, 99 insertions, 30 deletions
diff --git a/tests/trace.test b/tests/trace.test
index 2e8b61b..52a6c4e 100644
--- a/tests/trace.test
+++ b/tests/trace.test
@@ -11,7 +11,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: trace.test,v 1.24 2002/11/13 22:11:41 vincentdarley Exp $
+# RCS: @(#) $Id: trace.test,v 1.25 2003/01/17 14:19:55 vincentdarley Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -865,27 +865,27 @@ test trace-14.12 {trace command ("remove variable" option)} {
set x 12345
set info
} {1}
-test trace-14.15 {trace command ("list variable" option)} {
+test trace-14.15 {trace command ("info variable" option)} {
catch {unset x}
trace add variable x write {traceTag 1}
trace add variable x write traceProc
trace add variable x write {traceTag 2}
trace info variable x
} {{write {traceTag 2}} {write traceProc} {write {traceTag 1}}}
-test trace-14.16 {trace command ("list variable" option)} {
+test trace-14.16 {trace command ("info variable" option)} {
catch {unset x}
trace info variable x
} {}
-test trace-14.17 {trace command ("list variable" option)} {
+test trace-14.17 {trace command ("info variable" option)} {
catch {unset x}
trace info variable x(0)
} {}
-test trace-14.18 {trace command ("list variable" option)} {
+test trace-14.18 {trace command ("info variable" option)} {
catch {unset x}
set x 44
trace info variable x(0)
} {}
-test trace-14.19 {trace command ("list variable" option)} {
+test trace-14.19 {trace command ("info variable" option)} {
catch {unset x}
set x 44
trace add variable x write {traceTag 1}
@@ -1604,36 +1604,36 @@ test trace-24.1 {delete trace during enter trace} {
set info {}
trace add execution foo enter [list traceDelete foo]
foo 1
- list $info [trace info execution foo]
-} {{{foo 1} enter} {}}
+ list $info [catch {trace info execution foo} res] $res
+} {{{foo 1} enter} 0 {}}
test trace-24.2 {delete trace during leave trace} {
set info {}
trace add execution foo leave [list traceDelete foo]
foo 1
- list $info [trace info execution foo]
-} {{{foo 1} 0 1 leave} {}}
+ list $info [catch {trace info execution foo} res] $res
+} {{{foo 1} 0 1 leave} 0 {}}
test trace-24.3 {delete trace during enter-leave trace} {
set info {}
trace add execution foo {enter leave} [list traceDelete foo]
foo 1
- list $info [trace info execution foo]
-} {{{foo 1} enter} {}}
+ list $info [catch {trace info execution foo} res] $res
+} {{{foo 1} enter} 0 {}}
test trace-24.4 {delete trace during all exec traces} {
set info {}
trace add execution foo {enter leave enterstep leavestep} [list traceDelete foo]
foo 1
- list $info [trace info execution foo]
-} {{{foo 1} enter} {}}
+ list $info [catch {trace info execution foo} res] $res
+} {{{foo 1} enter} 0 {}}
test trace-24.5 {delete trace during all exec traces except enter} {
set info {}
trace add execution foo {leave enterstep leavestep} [list traceDelete foo]
foo 1
- list $info [trace info execution foo]
-} {{{set b 1} enterstep} {}}
+ list $info [catch {trace info execution foo} res] $res
+} {{{set b 1} enterstep} 0 {}}
proc traceDelete {cmd args} {
rename $cmd {}
@@ -1649,8 +1649,8 @@ test trace-25.1 {delete command during enter trace} {
set info {}
trace add execution foo enter [list traceDelete foo]
catch {foo 1} err
- list $err $info [trace info execution foo]
-} {{invalid command name "foo"} {{foo 1} enter} {unknown command "foo"}}
+ list $err $info [catch {trace info execution foo} res] $res
+} {{invalid command name "foo"} {{foo 1} enter} 1 {unknown command "foo"}}
proc foo {a} {
set b $a
@@ -1660,8 +1660,8 @@ test trace-25.2 {delete command during leave trace} {
set info {}
trace add execution foo leave [list traceDelete foo]
foo 1
- list $info [trace info execution foo]
-} {{{foo 1} 0 1 leave} {unknown command "foo"}}
+ list $info [catch {trace info execution foo} res] $res
+} {{{foo 1} 0 1 leave} 1 {unknown command "foo"}}
proc foo {a} {
set b $a
@@ -1672,8 +1672,8 @@ test trace-25.3 {delete command during enter then leave trace} {
trace add execution foo enter [list traceDelete foo]
trace add execution foo leave [list traceDelete foo]
catch {foo 1} err
- list $err $info [trace info execution foo]
-} {{invalid command name "foo"} {{foo 1} enter} {unknown command "foo"}}
+ list $err $info [catch {trace info execution foo} res] $res
+} {{invalid command name "foo"} {{foo 1} enter} 1 {unknown command "foo"}}
proc foo {a} {
set b $a
@@ -1765,8 +1765,8 @@ test trace-25.8 {delete command during enter leave and enter/leave-step traces}
trace add execution foo enterstep [list traceDelete foo]
trace add execution foo leavestep [list traceDelete foo]
catch {foo 1} err
- list $err $info [trace info execution foo]
-} {{invalid command name "foo"} {{foo 1} enter} {unknown command "foo"}}
+ list $err $info [catch {trace info execution foo} res] $res
+} {{invalid command name "foo"} {{foo 1} enter} 1 {unknown command "foo"}}
proc foo {a} {
set b $a
@@ -1778,8 +1778,8 @@ test trace-25.9 {delete command during enter leave and leavestep traces} {
trace add execution foo leave [list traceDelete foo]
trace add execution foo leavestep [list traceDelete foo]
catch {foo 1} err
- list $err $info [trace info execution foo]
-} {{invalid command name "foo"} {{foo 1} enter} {unknown command "foo"}}
+ list $err $info [catch {trace info execution foo} res] $res
+} {{invalid command name "foo"} {{foo 1} enter} 1 {unknown command "foo"}}
proc foo {a} {
set b $a
@@ -1790,8 +1790,8 @@ test trace-25.10 {delete command during leave and leavestep traces} {
trace add execution foo leave [list traceDelete foo]
trace add execution foo leavestep [list traceDelete foo]
catch {foo 1} err
- list $err $info [trace info execution foo]
-} {1 {{set b 1} 0 1 leavestep} {unknown command "foo"}}
+ list $err $info [catch {trace info execution foo} res] $res
+} {1 {{set b 1} 0 1 leavestep} 1 {unknown command "foo"}}
proc foo {a} {
set b $a
@@ -1802,8 +1802,8 @@ test trace-25.11 {delete command during enter and enterstep traces} {
trace add execution foo enter [list traceDelete foo]
trace add execution foo enterstep [list traceDelete foo]
catch {foo 1} err
- list $err $info [trace info execution foo]
-} {{invalid command name "foo"} {{foo 1} enter} {unknown command "foo"}}
+ list $err $info [catch {trace info execution foo} res] $res
+} {{invalid command name "foo"} {{foo 1} enter} 1 {unknown command "foo"}}
test trace-26.1 {trace targetCmd when invoked through an alias} {
proc foo {args} {
@@ -1838,6 +1838,16 @@ test trace-27.1 {memory leak in rename trace (604609)} {
info commands foo
} {}
+test trace-27.2 {command trace remove nonsense} {
+ list [catch {trace remove command thisdoesntexist \
+ {delete rename} bar} res] $res
+} {1 {unknown command "thisdoesntexist"}}
+
+test trace-27.3 {command trace info nonsense} {
+ list [catch {trace info command thisdoesntexist} res] $res
+} {1 {unknown command "thisdoesntexist"}}
+
+
test trace-28.1 {enterstep and leavestep traces with update idletasks (615043)} {
catch {rename foo {}}
proc foo {} {
@@ -2019,6 +2029,65 @@ foo {if {[catch {bar}]} {
}} 2 error leavestep
foo foo 0 error leave}}
+test trace-28.5 {exec traces} {
+ set info {}
+ proc foo {args} { set a 1 }
+ trace add execution foo {enter enterstep leave leavestep} \
+ [list traceExecute foo]
+ after idle [list foo test-28.4]
+ update
+ # Complicated way of removing traces
+ set ti [lindex [eval [list trace info execution ::foo]] 0]
+ if {[llength $ti]} {
+ eval [concat [list trace remove execution foo] $ti]
+ }
+ join $info \n
+} {foo {foo test-28.4} enter
+foo {set a 1} enterstep
+foo {set a 1} 0 1 leavestep
+foo {foo test-28.4} 0 1 leave}
+
+test trace-28.6 {exec traces firing order} {
+ set info {}
+ proc enterStep {cmd op} {lappend ::info "enter $cmd/$op"}
+ proc leaveStep {cmd code result op} {lappend ::info "leave $cmd/$code/$result/$op"}
+
+ proc foo x {
+ set b x=$x
+ incr x
+ }
+ trace add execution foo enterstep enterStep
+ trace add execution foo leavestep leaveStep
+ foo 42
+ rename foo {}
+ join $info \n
+} {enter set b x=42/enterstep
+leave set b x=42/0/x=42/leavestep
+enter incr x/enterstep
+leave incr x/0/43/leavestep}
+
+test trace-28.7 {exec trace information} {
+ set info {}
+ proc foo x { incr x }
+ proc bar {args} {}
+ trace add execution foo {enter leave enterstep leavestep} bar
+ set info [trace info execution foo]
+ trace remove execution foo {enter leave enterstep leavestep} bar
+} {}
+
+test trace-28.8 {exec trace remove nonsense} {
+ list [catch {trace remove execution thisdoesntexist \
+ {enter leave enterstep leavestep} bar} res] $res
+} {1 {unknown command "thisdoesntexist"}}
+
+test trace-28.9 {exec trace info nonsense} {
+ list [catch {trace info execution thisdoesntexist} res] $res
+} {1 {unknown command "thisdoesntexist"}}
+
+test trace-28.10 {exec trace info nonsense} {
+ list [catch {trace remove execution} res] $res
+} {1 {wrong # args: should be "trace remove execution name opList command"}}
+
# Delete procedures when done, so we don't clash with other tests
# (e.g. foobar will clash with 'unknown' tests).
catch {rename foobar {}}