From fe37b8dc2536b70d0aba3c6a70ead466ebe5b9d6 Mon Sep 17 00:00:00 2001
From: Steve Bennett <steveb@workware.net.au>
Date: Fri, 2 Dec 2011 13:24:38 +1000
Subject: Add the [xtrace] command

Allows a debugger or tracing facility to be implemented

Signed-off-by: Steve Bennett <steveb@workware.net.au>
---
 tests/xtrace.test | 62 +++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 62 insertions(+)
 create mode 100644 tests/xtrace.test

(limited to 'tests/xtrace.test')

diff --git a/tests/xtrace.test b/tests/xtrace.test
new file mode 100644
index 0000000..c55a54e
--- /dev/null
+++ b/tests/xtrace.test
@@ -0,0 +1,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
-- 
cgit v1.1