diff options
author | Steve Bennett <steveb@workware.net.au> | 2011-07-28 12:52:22 +1000 |
---|---|---|
committer | Steve Bennett <steveb@workware.net.au> | 2021-01-09 11:06:48 +1000 |
commit | 0f09dd9e6b5a2474f04cfa0ea97e6e2b4bc77a45 (patch) | |
tree | 71c8baed08027749b6fc1477088de0a7c2d96907 /examples | |
parent | fe37b8dc2536b70d0aba3c6a70ead466ebe5b9d6 (diff) | |
download | jimtcl-0f09dd9e6b5a2474f04cfa0ea97e6e2b4bc77a45.zip jimtcl-0f09dd9e6b5a2474f04cfa0ea97e6e2b4bc77a45.tar.gz jimtcl-0f09dd9e6b5a2474f04cfa0ea97e6e2b4bc77a45.tar.bz2 |
jimdb: A command line Jim debugger using xtrace
Also add some additional tools that use xtrace.
examples/jcov - code coverage
examples/jtime - code coverage that measures execution time
examples/jtrace - trace script execution
Signed-off-by: Steve Bennett <steveb@workware.net.au>
Diffstat (limited to 'examples')
-rw-r--r-- | examples/dbgtest.tcl | 34 | ||||
-rwxr-xr-x | examples/jcov | 66 | ||||
-rwxr-xr-x | examples/jtime | 53 | ||||
-rwxr-xr-x | examples/jtrace | 23 |
4 files changed, 176 insertions, 0 deletions
diff --git a/examples/dbgtest.tcl b/examples/dbgtest.tcl new file mode 100644 index 0000000..ef6b56f --- /dev/null +++ b/examples/dbgtest.tcl @@ -0,0 +1,34 @@ +# An example script useful for testing the Jim debugger +# Taken from http://www.nist.gov/msidlibrary/doc/libes93c.ps + +set b 1 + +proc p4 {x} { + return [ + expr 5+[expr 1+$x]] +} + +set z [ + expr 1+[expr 2+[p4 $b]] +] + +proc p3 {} { + set m 0 +} + +proc p2 {} { + set c 4 + p3 + set d 5 +} + +proc p1 {} { + set a 2 + p2 + set a 3 + set a 5 +} + +p1 +set k 7 +p1 diff --git a/examples/jcov b/examples/jcov new file mode 100755 index 0000000..1508f4b --- /dev/null +++ b/examples/jcov @@ -0,0 +1,66 @@ +#!/usr/bin/env jimsh +# vim:se syntax=tcl: + +# Experimental code coverage for Jim Tcl + +set auto_path [linsert $auto_path 0 [file dirname $argv0]/jimlib] + +set opt_all 0 +if {[lindex $argv 0] eq "-all"} { + incr opt_all + set argv [lrange $argv 1 end] +} + +set argv [lassign $argv argv0] + +set coverage($argv0) {} + +proc xcov {type file line result name arglist} { + upvar ::coverage($file) info + incr info($line) +} + +xtrace xcov + +# Catch exit but not error +set rc [catch -noerror -exit {source $argv0} msg opts] + +xtrace + +proc show-coverage {filename} { + set info $::coverage($filename) + + puts "=== $filename ===" + set f [open $filename] + set n 0 + while {[$f gets buf] >= 0} { + incr n + if {[info exists info($n)]} { + set prefix [format "%4d: " $info($n)] + } else { + set b [string trimleft $buf] + if {$b eq "" || [string match "#*" $b] || [string match "\}*" $b]} { + set prefix " -: " + } else { + set prefix "####: " + } + } + puts "$prefix$buf" + } + $f close +} + +puts [dict keys $coverage] +if {$opt_all} { + foreach filename [lsort [dict keys $coverage]] { + if {$filename in {"" jcov}} { + continue + } + show-coverage $filename + puts "" + } +} else { + show-coverage $argv0 +} + +#parray coverage diff --git a/examples/jtime b/examples/jtime new file mode 100755 index 0000000..1f1929f --- /dev/null +++ b/examples/jtime @@ -0,0 +1,53 @@ +#!/usr/bin/env jimsh +# vim:se syntax=tcl: + +# Experimental code coverage for Jim Tcl + +set auto_path [linsert $auto_path 0 [file dirname $argv0]/jimlib] + +set argv [lassign $argv argv0] + +set jtime::fileinfo($argv0) {} +set jtime::last [clock micros] + +proc jtime::xtrace {type file line result name arglist} { + variable fileinfo + variable last + set now [clock micros] + + if {![exists fileinfo($file)]} { + set info {} + } else { + set info $fileinfo($file) + } + incr info($line) $($now - $last) + set fileinfo($file) $info + + set last $now +} + +xtrace jtime::xtrace + +# Catch exit but not error +set rc [catch -noerror -exit {source $argv0} msg opts] + +xtrace + +set info $jtime::fileinfo($argv0) + +set f [open $argv0] +set n 0 +while {[$f gets buf] >= 0} { + incr n + if {[info exists info($n)]} { + set prefix [format "%8d: " $info($n)] + } else { + set b [string trimleft $buf] + if {$b eq "" || [string match "#*" $b] || [string match "\}*" $b]} { + set prefix " -: " + } else { + set prefix " ####: " + } + } + puts "$prefix$buf" +} diff --git a/examples/jtrace b/examples/jtrace new file mode 100755 index 0000000..87aee8e --- /dev/null +++ b/examples/jtrace @@ -0,0 +1,23 @@ +#!/usr/bin/env jimsh +# vim:se syntax=tcl: + +# Experimental code coverage for Jim Tcl + +set auto_path [linsert $auto_path 0 [file dirname $argv0]/jimlib] + +set argv [lassign $argv argv0] + +proc jtime::xtrace {type file line result name arglist} { + set indent [string repeat " " [info level]] + if {[string length $arglist] > 45} { + set arglist [string range $arglist 0 45]... + } + stderr puts "$indent$name [string map {\r \\r \n \\n} $arglist]" +} + +xtrace jtime::xtrace + +# Catch exit but not error +set rc [catch -noerror -exit {source $argv0} msg opts] + +xtrace |