* doc/CrtTrace.3: Added TIP#62 implementation of command

	* doc/trace.n:           execution tracing [FR #462580] (lavana).
	* generic/tcl.h:         This includes enter/leave tracing as well
	* generic/tclBasic.c:    as inter-procedure stepping.
	* generic/tclCmdMZ.c:
	* generic/tclCompile.c:
	* generic/tclExecute.c:
	* generic/tclInt.decls:
	* generic/tclInt.h:
	* generic/tclIntDecls.h:
	* generic/tclStubInit.c:
	* generic/tclVar.c:
	* tests/trace.test:

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