54 lines
1.0 KiB
Tcl
Executable File
54 lines
1.0 KiB
Tcl
Executable File
#!/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"
|
|
}
|