Attachment "patch_v2" to
ticket [1778143fff]
added by
pointsman
2007-08-21 19:22:41.
? patch_v2
Index: bench.tcl
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/bench/bench.tcl,v
retrieving revision 1.9
diff -u -r1.9 bench.tcl
--- bench.tcl 28 Mar 2007 17:49:44 -0000 1.9
+++ bench.tcl 21 Aug 2007 12:16:54 -0000
@@ -47,6 +47,7 @@
# -match <pattern> only run tests matching this pattern
# -rmatch <pattern> only run tests matching this pattern
# -iters <num> default 1000, max#iterations for any benchmark
+ # -pkgdirs <dir list> defaults to no auto_path manipulation
# interps - dict (path -> version)
# files - list (of files)
@@ -59,6 +60,8 @@
set match {} ; # Do not exclude benchmarks based on glob pattern
set rmatch {} ; # Do not exclude benchmarks based on regex pattern
set iters 1000 ; # Limit #iterations for any benchmark
+ set pkgdirs {{}} ; # List of dirs to put in front of auto_path in the
+ # bench interpreters.
while {[string match "-*" [set opt [lindex $args 0]]]} {
set val [lindex $args 1]
@@ -87,6 +90,29 @@
}
set iters [lindex $args 1]
}
+ -pkgdirs {
+ if {[catch {set pkgdirslength [llength $val]}]} {
+ return -code error "Expected list, got \"$val\""
+ }
+ foreach pkgdir $val {
+ if {$pkgdir eq ""} {
+ continue
+ }
+ if {![file isdirectory $pkgdir]} {
+ return -code error "Expected a list of dirs in\
+ \"$val\", but \"$pkgdir\" isn't\
+ a directory."
+ }
+ if {![file readable $pkgdir]} {
+ return -code error "Directory \"pkgdir\" out of the\
+ list of dirs in \"$val\" isn't\
+ reable."
+ }
+ }
+ if {$pkgdirslength} {
+ set pkgdirs $val
+ }
+ }
default {
return -code error "Unknown option \"$opt\", should -errors, -threads, -match, -rmatch, or -iters"
}
@@ -97,72 +123,81 @@
return -code error "wrong\#args, should be: ?options? interp files"
}
foreach {interps files} $args break
-
+
# Run the benchmarks .....................................
array set DATA {}
foreach {ip ver} $interps {
- log::info "Benchmark $ver $ip"
-
- set DATA([list interp ${ip}]) $ver
-
- set cmd [list $ip [file join $self libbench.tcl] \
- -match $match \
- -rmatch $rmatch \
- -iters $iters \
- -interp $ip \
- -errors $errors \
- -threads $threads \
- ]
-
- # Determine elapsed time per file, logged.
- set start [clock seconds]
-
- array set tmp {}
-
- if {$threads} {
- if {[catch {
- eval exec $cmd $files
- } output]} {
- if {$errors} {
- error $::errorInfo
- }
- } else {
- array set tmp $output
- }
- } else {
- foreach file $files {
- log::info [file tail $file]
- if {[catch {
- eval exec [linsert $cmd end $file]
- } output]} {
- if {$errors} {
- error $::errorInfo
- } else {
- continue
- }
- } else {
- array set tmp $output
- }
- }
- }
-
- catch {unset tmp(Sourcing)}
- catch {unset tmp(__THREADED)}
-
- foreach desc [array names tmp] {
- set DATA([list desc $desc]) {}
- set DATA([list usec $desc $ip]) $tmp($desc)
- }
-
- unset tmp
- set elapsed [expr {[clock seconds] - $start}]
-
- set hour [expr {$elapsed / 3600}]
- set min [expr {$elapsed / 60}]
- set sec [expr {$elapsed % 60}]
- log::info " [format %.2d:%.2d:%.2d $hour $min $sec] elapsed"
+ foreach pkgdir $pkgdirs {
+ if {[llength $pkgdir]} {
+ log::info "Benchmark $ver ($pkgdir) $ip"
+ set idstr "$ip ($pkgdir)"
+ } else {
+ log::info "Benchmark $ver $ip"
+ set idstr $ip
+ }
+
+ set DATA([list interp $idstr]) $ver
+
+ set cmd [list $ip [file join $self libbench.tcl] \
+ -match $match \
+ -rmatch $rmatch \
+ -iters $iters \
+ -interp $ip \
+ -errors $errors \
+ -threads $threads \
+ -pkgdir $pkgdir \
+ ]
+
+ # Determine elapsed time per file, logged.
+ set start [clock seconds]
+
+ array set tmp {}
+
+ if {$threads} {
+ if {[catch {
+ eval exec $cmd $files
+ } output]} {
+ if {$errors} {
+ error $::errorInfo
+ }
+ } else {
+ array set tmp $output
+ }
+ } else {
+ foreach file $files {
+ log::info [file tail $file]
+ if {[catch {
+ eval exec [linsert $cmd end $file]
+ } output]} {
+ if {$errors} {
+ error $::errorInfo
+ } else {
+ continue
+ }
+ } else {
+ array set tmp $output
+ }
+ }
+ }
+
+ catch {unset tmp(Sourcing)}
+ catch {unset tmp(__THREADED)}
+
+ foreach desc [array names tmp] {
+ set DATA([list desc $desc]) {}
+ set DATA([list usec $desc $idstr]) $tmp($desc)
+ }
+
+ unset tmp
+ set elapsed [expr {[clock seconds] - $start}]
+
+ set hour [expr {$elapsed / 3600}]
+ set min [expr {$elapsed / 60}]
+ set sec [expr {$elapsed % 60}]
+ log::info " [format %.2d:%.2d:%.2d $hour $min $sec] elapsed"
+ }
}
# Benchmark data ... Structure, dict (key -> value)
Index: libbench.tcl
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/bench/libbench.tcl,v
retrieving revision 1.2
diff -u -r1.2 libbench.tcl
--- libbench.tcl 23 Jan 2007 03:21:35 -0000 1.2
+++ libbench.tcl 21 Aug 2007 12:16:55 -0000
@@ -350,6 +350,7 @@
FILES {}
ITERS 1000
THREADS 0
+ PKGDIR {}
EXIT "[info exists tk_version]"
} {
if {![info exists BENCH($var)]} {
@@ -369,6 +370,7 @@
-mat* { set BENCH(MATCH) [lindex $argv 1] }
-iter* { set BENCH(ITERS) [lindex $argv 1] }
-thr* { set BENCH(THREADS) [lindex $argv 1] }
+ -pkg* { set BENCH(PKGDIR) [lindex $argv 1] }
default {
foreach arg $argv {
if {![file exists $arg]} { usage }
@@ -381,6 +383,10 @@
}
}
+if {[llength $BENCH(PKGDIR)]} {
+ set auto_path [linsert $auto_path 0 $BENCH(PKGDIR)]
+}
+
if {$BENCH(THREADS)} {
# We have to be able to load threads if we want to use threads, and
# we don't want to create more threads than we have files.
