summaryrefslogtreecommitdiffstats
path: root/tests/trace.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/trace.test')
-rw-r--r--tests/trace.test405
1 files changed, 397 insertions, 8 deletions
diff --git a/tests/trace.test b/tests/trace.test
index bc67464..7f7213b 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.18 2002/06/14 13:17:17 dkf Exp $
+# RCS: @(#) $Id: trace.test,v 1.19 2002/06/17 22:52:51 hobbs Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -791,9 +791,10 @@ test trace-14.5 {trace command, invalid option} {
# error messages.
set i 0
-set errs [list "array, read, unset, or write" "delete or rename"]
-set abbvs [list {a r u w} {d r}]
-foreach type {variable command} err $errs abbvlist $abbvs {
+set errs [list "array, read, unset, or write" "delete or rename" "enter, leave, enterstep, or leavestep"]
+set abbvs [list {a r u w} {d r} {}]
+proc x {} {}
+foreach type {variable command execution} err $errs abbvlist $abbvs {
foreach op {add remove} {
test trace-14.6.[incr i] "trace $op $type errors" {
list [catch {trace $op $type x {y z w} a} msg] $msg
@@ -808,6 +809,7 @@ foreach type {variable command} err $errs abbvlist $abbvs {
} [list 1 "bad operation list \"\": must be one or more of $err"]
}
}
+rename x {}
test trace-14.7 {trace command, "trace variable" errors} {
list [catch {trace variable} msg] $msg
@@ -1415,12 +1417,399 @@ catch {rename foobar {}}
catch {rename foo {}}
catch {rename bar {}}
-# Delete arrays when done, so they can be re-used as scalars
-# elsewhere.
+proc foo {a} {
+ set b $a
+}
-catch {unset x}
-catch {unset y}
+proc traceExecute {args} {
+ global info
+ lappend info $args
+}
+
+test trace-21.1 {trace execution: enter} {
+ set info {}
+ trace add execution foo enter [list traceExecute foo]
+ foo 1
+ trace remove execution foo enter [list traceExecute foo]
+ set info
+} {{foo {foo 1} enter}}
+
+test trace-21.2 {trace exeuction: leave} {
+ set info {}
+ trace add execution foo leave [list traceExecute foo]
+ foo 2
+ trace remove execution foo leave [list traceExecute foo]
+ set info
+} {{foo {foo 2} 0 2 leave}}
+
+test trace-21.3 {trace exeuction: enter, leave} {
+ set info {}
+ trace add execution foo {enter leave} [list traceExecute foo]
+ foo 3
+ trace remove execution foo {enter leave} [list traceExecute foo]
+ set info
+} {{foo {foo 3} enter} {foo {foo 3} 0 3 leave}}
+
+test trace-21.4 {trace execution: enter, leave, enterstep} {
+ set info {}
+ trace add execution foo {enter leave enterstep} [list traceExecute foo]
+ foo 3
+ trace remove execution foo {enter leave enterstep} [list traceExecute foo]
+ set info
+} {{foo {foo 3} enter} {foo {set b 3} enterstep} {foo {foo 3} 0 3 leave}}
+
+test trace-21.5 {trace execution: enter, leave, enterstep, leavestep} {
+ set info {}
+ trace add execution foo {enter leave enterstep leavestep} [list traceExecute foo]
+ foo 3
+ trace remove execution foo {enter leave enterstep leavestep} [list traceExecute foo]
+ set info
+} {{foo {foo 3} enter} {foo {set b 3} enterstep} {foo {set b 3} 0 3 leavestep} {foo {foo 3} 0 3 leave}}
+
+test trace-21.6 {trace execution: enterstep, leavestep} {
+ set info {}
+ trace add execution foo {enterstep leavestep} [list traceExecute foo]
+ foo 3
+ trace remove execution foo {enterstep leavestep} [list traceExecute foo]
+ set info
+} {{foo {set b 3} enterstep} {foo {set b 3} 0 3 leavestep}}
+
+test trace-21.7 {trace execution: enterstep} {
+ set info {}
+ trace add execution foo {enterstep} [list traceExecute foo]
+ foo 3
+ trace remove execution foo {enterstep} [list traceExecute foo]
+ set info
+} {{foo {set b 3} enterstep}}
+
+test trace-21.8 {trace execution: leavestep} {
+ set info {}
+ trace add execution foo {leavestep} [list traceExecute foo]
+ foo 3
+ trace remove execution foo {leavestep} [list traceExecute foo]
+ set info
+} {{foo {set b 3} 0 3 leavestep}}
+
+proc factorial {n} {
+ if {$n != 1} { return [expr {$n * [factorial [expr {$n -1 }]]}] }
+ return 1
+}
+
+test trace-22.1 {recursive(1) trace execution: enter} {
+ set info {}
+ trace add execution factorial {enter} [list traceExecute factorial]
+ factorial 1
+ trace remove execution factorial {enter} [list traceExecute factorial]
+ set info
+} {{factorial {factorial 1} enter}}
+
+test trace-22.2 {recursive(2) trace execution: enter} {
+ set info {}
+ trace add execution factorial {enter} [list traceExecute factorial]
+ factorial 2
+ trace remove execution factorial {enter} [list traceExecute factorial]
+ set info
+} {{factorial {factorial 2} enter} {factorial {factorial 1} enter}}
+
+test trace-22.3 {recursive(3) trace execution: enter} {
+ set info {}
+ trace add execution factorial {enter} [list traceExecute factorial]
+ factorial 3
+ trace remove execution factorial {enter} [list traceExecute factorial]
+ set info
+} {{factorial {factorial 3} enter} {factorial {factorial 2} enter} {factorial {factorial 1} enter}}
+
+test trace-23.1 {recursive(1) trace execution: enter, leave, enterstep, leavestep} {
+ set info {}
+ trace add execution factorial {enter leave enterstep leavestep} [list traceExecute]
+ factorial 1
+ trace remove execution factorial {enter leave enterstep leavestep} [list traceExecute]
+ join $info "\n"
+} {{factorial 1} enter
+{if {$n != 1} { return [expr {$n * [factorial [expr {$n -1 }]]}] }} enterstep
+{if {$n != 1} { return [expr {$n * [factorial [expr {$n -1 }]]}] }} 0 {} leavestep
+{return 1} enterstep
+{return 1} 2 1 leavestep
+{factorial 1} 0 1 leave}
+
+test trace-23.2 {recursive(2) trace execution: enter, leave, enterstep, leavestep} {
+ set info {}
+ trace add execution factorial {enter leave enterstep leavestep} [list traceExecute]
+ factorial 2
+ trace remove execution factorial {enter leave enterstep leavestep} [list traceExecute]
+ join $info "\n"
+} {{factorial 2} enter
+{if {$n != 1} { return [expr {$n * [factorial [expr {$n -1 }]]}] }} enterstep
+{expr {$n * [factorial [expr {$n -1 }]]}} enterstep
+{expr {$n -1 }} enterstep
+{expr {$n -1 }} 0 1 leavestep
+{factorial 1} enterstep
+{factorial 1} enter
+{if {$n != 1} { return [expr {$n * [factorial [expr {$n -1 }]]}] }} enterstep
+{if {$n != 1} { return [expr {$n * [factorial [expr {$n -1 }]]}] }} 0 {} leavestep
+{return 1} enterstep
+{return 1} 2 1 leavestep
+{factorial 1} 0 1 leave
+{factorial 1} 0 1 leavestep
+{expr {$n * [factorial [expr {$n -1 }]]}} 0 2 leavestep
+{return 2} enterstep
+{return 2} 2 2 leavestep
+{if {$n != 1} { return [expr {$n * [factorial [expr {$n -1 }]]}] }} 2 2 leavestep
+{factorial 2} 0 2 leave}
+
+test trace-23.3 {recursive(3) trace execution: enter, leave, enterstep, leavestep} {
+ set info {}
+ trace add execution factorial {enter leave enterstep leavestep} [list traceExecute]
+ factorial 3
+ trace remove execution factorial {enter leave enterstep leavestep} [list traceExecute]
+ join $info "\n"
+} {{factorial 3} enter
+{if {$n != 1} { return [expr {$n * [factorial [expr {$n -1 }]]}] }} enterstep
+{expr {$n * [factorial [expr {$n -1 }]]}} enterstep
+{expr {$n -1 }} enterstep
+{expr {$n -1 }} 0 2 leavestep
+{factorial 2} enterstep
+{factorial 2} enter
+{if {$n != 1} { return [expr {$n * [factorial [expr {$n -1 }]]}] }} enterstep
+{expr {$n * [factorial [expr {$n -1 }]]}} enterstep
+{expr {$n -1 }} enterstep
+{expr {$n -1 }} 0 1 leavestep
+{factorial 1} enterstep
+{factorial 1} enter
+{if {$n != 1} { return [expr {$n * [factorial [expr {$n -1 }]]}] }} enterstep
+{if {$n != 1} { return [expr {$n * [factorial [expr {$n -1 }]]}] }} 0 {} leavestep
+{return 1} enterstep
+{return 1} 2 1 leavestep
+{factorial 1} 0 1 leave
+{factorial 1} 0 1 leavestep
+{expr {$n * [factorial [expr {$n -1 }]]}} 0 2 leavestep
+{return 2} enterstep
+{return 2} 2 2 leavestep
+{if {$n != 1} { return [expr {$n * [factorial [expr {$n -1 }]]}] }} 2 2 leavestep
+{factorial 2} 0 2 leave
+{factorial 2} 0 2 leavestep
+{expr {$n * [factorial [expr {$n -1 }]]}} 0 6 leavestep
+{return 6} enterstep
+{return 6} 2 6 leavestep
+{if {$n != 1} { return [expr {$n * [factorial [expr {$n -1 }]]}] }} 2 6 leavestep
+{factorial 3} 0 6 leave}
+
+proc traceDelete {cmd args} {
+ eval trace remove execution $cmd [lindex [trace info execution $cmd] 0]
+ global info
+ set info $args
+}
+
+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} {}}
+
+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} {}}
+
+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} {}}
+
+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} {}}
+
+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} {}}
+
+proc traceDelete {cmd args} {
+ rename $cmd {}
+ global info
+ set info $args
+}
+
+proc foo {a} {
+ set b $a
+}
+
+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"}}
+
+proc foo {a} {
+ set b $a
+}
+
+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"}}
+
+proc foo {a} {
+ set b $a
+}
+
+test trace-25.3 {delete command during enter then leave trace} {
+ set info {}
+ 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"}}
+proc foo {a} {
+ set b $a
+}
+proc traceExecute2 {args} {
+ global info
+ lappend info $args
+}
+
+# This shows the peculiar consequences of having two traces
+# at the same time: as well as tracing the procedure you want
+test trace-25.4 {order dependencies of two enter traces} {
+ set info {}
+ trace add execution foo enter [list traceExecute traceExecute]
+ trace add execution foo enter [list traceExecute2 traceExecute2]
+ catch {foo 1} err
+ trace remove execution foo enter [list traceExecute traceExecute]
+ trace remove execution foo enter [list traceExecute2 traceExecute2]
+ join [list $err [join $info \n] [trace info execution foo]] "\n"
+} {1
+traceExecute2 {foo 1} enter
+traceExecute {foo 1} enter
+}
+
+test trace-25.5 {order dependencies of two step traces} {
+ set info {}
+ trace add execution foo enterstep [list traceExecute traceExecute]
+ trace add execution foo enterstep [list traceExecute2 traceExecute2]
+ catch {foo 1} err
+ trace remove execution foo enterstep [list traceExecute traceExecute]
+ trace remove execution foo enterstep [list traceExecute2 traceExecute2]
+ join [list $err [join $info \n] [trace info execution foo]] "\n"
+} {1
+traceExecute2 {set b 1} enterstep
+traceExecute {set b 1} enterstep
+}
+
+# We don't want the result string (5th argument), or the results
+# will get unmanageable.
+proc tracePostExecute {args} {
+ global info
+ lappend info [concat [lrange $args 0 2] [lindex $args 4]]
+}
+proc tracePostExecute2 {args} {
+ global info
+ lappend info [concat [lrange $args 0 2] [lindex $args 4]]
+}
+
+test trace-25.6 {order dependencies of two leave traces} {
+ set info {}
+ trace add execution foo leave [list tracePostExecute tracePostExecute]
+ trace add execution foo leave [list tracePostExecute2 tracePostExecute2]
+ catch {foo 1} err
+ trace remove execution foo leave [list tracePostExecute tracePostExecute]
+ trace remove execution foo leave [list tracePostExecute2 tracePostExecute2]
+ join [list $err [join $info \n] [trace info execution foo]] "\n"
+} {1
+tracePostExecute {foo 1} 0 leave
+tracePostExecute2 {foo 1} 0 leave
+}
+
+test trace-25.7 {order dependencies of two leavestep traces} {
+ set info {}
+ trace add execution foo leavestep [list tracePostExecute tracePostExecute]
+ trace add execution foo leavestep [list tracePostExecute2 tracePostExecute2]
+ catch {foo 1} err
+ trace remove execution foo leavestep [list tracePostExecute tracePostExecute]
+ trace remove execution foo leavestep [list tracePostExecute2 tracePostExecute2]
+ join [list $err [join $info \n] [trace info execution foo]] "\n"
+} {1
+tracePostExecute {set b 1} 0 leavestep
+tracePostExecute2 {set b 1} 0 leavestep
+}
+
+proc foo {a} {
+ set b $a
+}
+
+proc traceDelete {cmd args} {
+ rename $cmd {}
+ global info
+ set info $args
+}
+
+test trace-25.8 {delete command during enter leave and enter/leave-step traces} {
+ set info {}
+ trace add execution foo enter [list traceDelete foo]
+ trace add execution foo leave [list traceDelete foo]
+ 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"}}
+
+proc foo {a} {
+ set b $a
+}
+
+test trace-25.9 {delete command during enter leave and leavestep traces} {
+ set info {}
+ trace add execution foo enter [list traceDelete foo]
+ 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"}}
+
+proc foo {a} {
+ set b $a
+}
+
+test trace-25.10 {delete command during leave and leavestep traces} {
+ set info {}
+ 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"}}
+
+proc foo {a} {
+ set b $a
+}
+
+test trace-25.11 {delete command during enter and enterstep traces} {
+ set info {}
+ 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"}}
+
+# Delete procedures when done, so we don't clash with other tests
+# (e.g. foobar will clash with 'unknown' tests).
+catch {rename foobar {}}
+catch {rename foo {}}
+catch {rename bar {}}
# cleanup
::tcltest::cleanupTests