diff options
Diffstat (limited to 'tests/trace.test')
| -rw-r--r-- | tests/trace.test | 405 |
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 |