summaryrefslogtreecommitdiffstats
path: root/tests-perf/comparePerf.tcl
diff options
context:
space:
mode:
Diffstat (limited to 'tests-perf/comparePerf.tcl')
-rw-r--r--tests-perf/comparePerf.tcl371
1 files changed, 371 insertions, 0 deletions
diff --git a/tests-perf/comparePerf.tcl b/tests-perf/comparePerf.tcl
new file mode 100644
index 0000000..f35da21
--- /dev/null
+++ b/tests-perf/comparePerf.tcl
@@ -0,0 +1,371 @@
+#!/usr/bin/tclsh
+# ------------------------------------------------------------------------
+#
+# comparePerf.tcl --
+#
+# Script to compare performance data from multiple runs.
+#
+# ------------------------------------------------------------------------
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file.
+#
+# Usage:
+# tclsh comparePerf.tcl [--regexp RE] [--ratio time|rate] [--combine] [--base BASELABEL] PERFFILE ...
+#
+# The test data from each input file is tabulated so as to compare the results
+# of test runs. If a PERFFILE does not exist, it is retried by adding the
+# .perf extension. If the --regexp is specified, only test results whose
+# id matches RE are examined.
+#
+# If the --combine option is specified, results of test sets with the same
+# label are combined and averaged in the output.
+#
+# If the --base option is specified, the BASELABEL is used as the label to use
+# the base timing. Otherwise, the label of the first data file is used.
+#
+# If --ratio option is "time" the ratio of test timing vs base test timing
+# is shown. If "rate" (default) the inverse is shown.
+#
+# If --no-header is specified, the header describing test configuration is
+# not output.
+#
+# The format of input files is as follows:
+#
+# Each line must begin with one of the characters below followed by a space
+# followed by a string whose semantics depend on the initial character.
+# E - Full path to the Tcl executable that was used to generate the file
+# V - The Tcl patchlevel of the implementation
+# D - A description for the test run for human consumption
+# L - A label used to identify run environment. The --combine option will
+# average all measuremets that have the same label. An input file without
+# a label is treated as having a unique label and not combined with any other.
+# P - A test measurement (see below)
+# R - The number of runs made for the each test
+# # - A comment, may be an arbitrary string. Usually included in performance
+# data to describe the test. This is silently ignored
+#
+# Any lines not matching one of the above are ignored with a warning to stderr.
+#
+# A line beginning with the "P" marker is a test measurement. The first word
+# following is a floating point number representing the test runtime.
+# The remaining line (after trimming of whitespace) is the id of the test.
+# Test generators are encouraged to make the id a well-defined machine-parseable
+# as well human readable description of the test. The id must not appear more
+# than once. An example test measurement line:
+# P 2.32280 linsert in unshared L[10000] 1 elems 10000 times at 0 (var)
+# Note here the iteration count is not present.
+#
+
+namespace eval perf::compare {
+ # List of dictionaries, one per input file
+ variable PerfData
+}
+
+proc perf::compare::warn {message} {
+ puts stderr "Warning: $message"
+}
+proc perf::compare::print {text} {
+ puts stdout $text
+}
+proc perf::compare::slurp {testrun_path} {
+ variable PerfData
+
+ set runtimes [dict create]
+
+ set path [file normalize $testrun_path]
+ set fd [open $path]
+ array set header {}
+ while {[gets $fd line] >= 0} {
+ set line [regsub -all {\s+} [string trim $line] " "]
+ switch -glob -- $line {
+ "#*" {
+ # Skip comments
+ }
+ "R *" -
+ "L *" -
+ "D *" -
+ "V *" -
+ "T *" -
+ "E *" {
+ set marker [lindex $line 0]
+ if {[info exists header($marker)]} {
+ warn "Ignoring $marker record (duplicate): \"$line\""
+ }
+ set header($marker) [string range $line 2 end]
+ }
+ "P *" {
+ if {[scan $line "P %f %n" runtime id_start] == 2} {
+ set id [string range $line $id_start end]
+ if {[dict exists $runtimes $id]} {
+ warn "Ignoring duplicate test id \"$id\""
+ } else {
+ dict set runtimes $id $runtime
+ }
+ } else {
+ warn "Invalid test result line format: \"$line\""
+ }
+ }
+ default {
+ puts stderr "Warning: ignoring unrecognized line \"$line\""
+ }
+ }
+ }
+ close $fd
+
+ set result [dict create Input $path Runtimes $runtimes]
+ foreach {c k} {
+ L Label
+ V Version
+ E Executable
+ D Description
+ } {
+ if {[info exists header($c)]} {
+ dict set result $k $header($c)
+ }
+ }
+
+ return $result
+}
+
+proc perf::compare::burp {test_sets} {
+ variable Options
+
+ # Print the key for each test run
+ set header " "
+ set separator " "
+ foreach test_set $test_sets {
+ set test_set_key "\[[incr test_set_num]\]"
+ if {! $Options(--no-header)} {
+ print "$test_set_key"
+ foreach k {Label Executable Version Input Description} {
+ if {[dict exists $test_set $k]} {
+ print "$k: [dict get $test_set $k]"
+ }
+ }
+ }
+ append header $test_set_key $separator
+ set separator " "; # Expand because later columns have ratio
+ }
+ set header [string trimright $header]
+
+ if {! $Options(--no-header)} {
+ print ""
+ if {$Options(--ratio) eq "rate"} {
+ set ratio_description "ratio of baseline to the measurement (higher is faster)."
+ } else {
+ set ratio_description "ratio of measurement to the baseline (lower is faster)."
+ }
+ print "The first column \[1\] is the baseline measurement."
+ print "Subsequent columns are pairs of the additional measurement and "
+ print $ratio_description
+ print ""
+ }
+
+ # Print the actual test run data
+
+ print $header
+ set test_sets [lassign $test_sets base_set]
+ set fmt {%#10.5f}
+ set fmt_ratio {%-6.2f}
+ foreach {id base_runtime} [dict get $base_set Runtimes] {
+ if {[info exists Options(--regexp)]} {
+ if {![regexp $Options(--regexp) $id]} {
+ continue
+ }
+ }
+ if {$Options(--print-test-number)} {
+ set line "[format %-4s [incr counter].]"
+ } else {
+ set line ""
+ }
+ append line [format $fmt $base_runtime]
+ foreach test_set $test_sets {
+ if {[dict exists $test_set Runtimes $id]} {
+ set runtime [dict get $test_set Runtimes $id]
+ if {$Options(--ratio) eq "time"} {
+ if {$base_runtime != 0} {
+ set ratio [format $fmt_ratio [expr {$runtime/$base_runtime}]]
+ } else {
+ if {$runtime == 0} {
+ set ratio "NaN "
+ } else {
+ set ratio "Inf "
+ }
+ }
+ } else {
+ if {$runtime != 0} {
+ set ratio [format $fmt_ratio [expr {$base_runtime/$runtime}]]
+ } else {
+ if {$base_runtime == 0} {
+ set ratio "NaN "
+ } else {
+ set ratio "Inf "
+ }
+ }
+ }
+ append line "|" [format $fmt $runtime] "|" $ratio
+ } else {
+ append line [string repeat { } 11]
+ }
+ }
+ append line "|" $id
+ print $line
+ }
+}
+
+proc perf::compare::chew {test_sets} {
+ variable Options
+
+ # Combine test sets that have the same label, averaging the values
+ set unlabeled_sets {}
+ array set labeled_sets {}
+
+ foreach test_set $test_sets {
+ # If there is no label, treat as independent set
+ if {![dict exists $test_set Label]} {
+ lappend unlabeled_sets $test_set
+ } else {
+ lappend labeled_sets([dict get $test_set Label]) $test_set
+ }
+ }
+
+ foreach label [array names labeled_sets] {
+ set combined_set [lindex $labeled_sets($label) 0]
+ set runtimes [dict get $combined_set Runtimes]
+ foreach test_set [lrange $labeled_sets($label) 1 end] {
+ dict for {id timing} [dict get $test_set Runtimes] {
+ dict lappend runtimes $id $timing
+ }
+ }
+ dict for {id timings} $runtimes {
+ set total [tcl::mathop::+ {*}$timings]
+ dict set runtimes $id [expr {$total/[llength $timings]}]
+ }
+ dict set combined_set Runtimes $runtimes
+ set labeled_sets($label) $combined_set
+ }
+
+ # Choose the "base" test set
+ if {![info exists Options(--base)]} {
+ set first_set [lindex $test_sets 0]
+ if {[dict exists $first_set Label]} {
+ # Use label of first as the base
+ set Options(--base) [dict get $first_set Label]
+ }
+ }
+
+ if {[info exists Options(--base)] && $Options(--base) ne ""} {
+ lappend combined_sets $labeled_sets($Options(--base));# Will error if no such
+ unset labeled_sets($Options(--base))
+ } else {
+ lappend combined_sets [lindex $unlabeled_sets 0]
+ set unlabeled_sets [lrange $unlabeled_sets 1 end]
+ }
+ foreach label [array names labeled_sets] {
+ lappend combined_sets $labeled_sets($label)
+ }
+ lappend combined_sets {*}$unlabeled_sets
+
+ return $combined_sets
+}
+
+proc perf::compare::setup {argv} {
+ variable Options
+
+ array set Options {
+ --ratio rate
+ --combine 0
+ --print-test-number 0
+ --no-header 0
+ }
+ while {[llength $argv]} {
+ set argv [lassign $argv arg]
+ switch -glob -- $arg {
+ -r -
+ --regexp {
+ if {[llength $argv] == 0} {
+ error "Missing value for option $arg"
+ }
+ set argv [lassign $argv val]
+ set Options(--regexp) $val
+ }
+ --ratio {
+ if {[llength $argv] == 0} {
+ error "Missing value for option $arg"
+ }
+ set argv [lassign $argv val]
+ if {$val ni {time rate}} {
+ error "Value for option $arg must be either \"time\" or \"rate\""
+ }
+ set Options(--ratio) $val
+ }
+ --print-test-number -
+ --combine -
+ --no-header {
+ set Options($arg) 1
+ }
+ --base {
+ if {[llength $argv] == 0} {
+ error "Missing value for option $arg"
+ }
+ set argv [lassign $argv val]
+ set Options($arg) $val
+ }
+ -- {
+ # Remaining will be passed back to the caller
+ break
+ }
+ --* {
+ error "Unknown option $arg"
+ }
+ -* {
+ error "Unknown option -[lindex $arg 0]"
+ }
+ default {
+ # Remaining will be passed back to the caller
+ set argv [linsert $argv 0 $arg]
+ break;
+ }
+ }
+ }
+
+ set paths {}
+ foreach path $argv {
+ set path [file join $path]; # Convert from native else glob fails
+ if {[file isfile $path]} {
+ lappend paths $path
+ continue
+ }
+ if {[file isfile $path.perf]} {
+ lappend paths $path.perf
+ continue
+ }
+ lappend paths {*}[glob -nocomplain $path]
+ }
+ return $paths
+}
+proc perf::compare::main {} {
+ variable Options
+
+ set paths [setup $::argv]
+ if {[llength $paths] == 0} {
+ error "No test data files specified."
+ }
+ set test_data [list ]
+ set seen [dict create]
+ foreach path $paths {
+ if {![dict exists $seen $path]} {
+ lappend test_data [slurp $path]
+ dict set seen $path ""
+ }
+ }
+
+ if {$Options(--combine)} {
+ set test_data [chew $test_data]
+ }
+
+ burp $test_data
+}
+
+perf::compare::main