1# bench_read.tcl -- 2# 3# Management of benchmarks, reading results in various formats. 4# 5# Copyright (c) 2005 by Andreas Kupries <andreas_kupries@users.sourceforge.net> 6# library derived from runbench.tcl application (C) Jeff Hobbs. 7# 8# See the file "license.terms" for information on usage and redistribution 9# of this file, and for a DISCLAIMER OF ALL WARRANTIES. 10# 11# RCS: @(#) $Id: bench_read.tcl,v 1.3 2006/06/13 23:20:30 andreas_kupries Exp $ 12 13# ### ### ### ######### ######### ######### ########################### 14## Requisites - Packages and namespace for the commands and data. 15 16package require Tcl 8.2 17package require csv 18 19namespace eval ::bench::in {} 20 21# ### ### ### ######### ######### ######### ########################### 22## Public API - Result reading 23 24# ::bench::in::read -- 25# 26# Read a bench result in any of the raw/csv/text formats 27# 28# Arguments: 29# path to file to read 30# 31# Results: 32# DATA dictionary, internal representation of the bench results. 33 34proc ::bench::in::read {file} { 35 36 set f [open $file r] 37 set head [gets $f] 38 39 if {![string match "# -\\*- tcl -\\*- bench/*" $head]} { 40 return -code error "Bad file format, not a benchmark file" 41 } else { 42 regexp {bench/(.*)$} $head -> format 43 44 switch -exact -- $format { 45 raw - csv - text { 46 set res [RD$format $f] 47 } 48 default { 49 return -code error "Bad format \"$val\", expected text, csv, or raw" 50 } 51 } 52 } 53 close $f 54 return $res 55} 56 57# ### ### ### ######### ######### ######### ########################### 58## Internal commands 59 60proc ::bench::in::RDraw {chan} { 61 return [string trimright [::read $chan]] 62} 63 64proc ::bench::in::RDcsv {chan} { 65 # Lines Format 66 # First line is number of interpreters #n. int 67 # Next to 1+n is interpreter data. id,ver,path 68 # Beyond is benchmark results. id,desc,res1,...,res#n 69 70 array set DATA {} 71 72 # #Interp ... 73 74 set nip [lindex [csv::split [gets $chan]] 0] 75 76 # Interp data ... 77 78 set iplist {} 79 for {set i 0} {$i < $nip} {incr i} { 80 foreach {__ ver ip} [csv::split [gets $chan]] break 81 82 set DATA([list interp $ip]) $ver 83 lappend iplist $ip 84 } 85 86 # Benchmark data ... 87 88 while {[gets $chan line] >= 0} { 89 set line [string trim $line] 90 if {$line == {}} break 91 set line [csv::split $line] 92 set desc [lindex $line 1] 93 94 set DATA([list desc $desc]) {} 95 foreach val [lrange $line 2 end] ip $iplist { 96 if {$val == {}} continue 97 set DATA([list usec $desc $ip]) $val 98 } 99 } 100 101 return [array get DATA] 102} 103 104proc ::bench::in::RDtext {chan} { 105 array set DATA {} 106 107 # Interp data ... 108 109 # Empty line - ignore 110 # "id: ver path" - interp data. 111 # Empty line - separator before benchmark data. 112 113 set n 0 114 set iplist {} 115 while {[gets $chan line] >= 0} { 116 set line [string trim $line] 117 if {$line == {}} { 118 incr n 119 if {$n == 2} break 120 continue 121 } 122 123 regexp {[^:]+: ([^ ]+) (.*)$} $line -> ver ip 124 set DATA([list interp $ip]) $ver 125 lappend iplist $ip 126 } 127 128 # Benchmark data ... 129 130 # '---' -> Ignore. 131 # '|' column separators. Remove spaces around it. Then treat line 132 # as CSV data with a particular separator. 133 # Ignore the INTERP line. 134 135 while {[gets $chan line] >= 0} { 136 set line [string trim $line] 137 if {$line == {}} continue 138 if {[string match "+---*" $line]} continue 139 if {[string match "*INTERP*" $line]} continue 140 141 regsub -all "\\| +" $line {|} line 142 regsub -all " +\\|" $line {|} line 143 set line [csv::split [string trim $line |] |] 144 set desc [lindex $line 1] 145 146 set DATA([list desc $desc]) {} 147 foreach val [lrange $line 2 end] ip $iplist { 148 if {$val == {}} continue 149 set DATA([list usec $desc $ip]) $val 150 } 151 } 152 153 return [array get DATA] 154} 155 156# ### ### ### ######### ######### ######### ########################### 157## Initialize internal data structures. 158 159# ### ### ### ######### ######### ######### ########################### 160## Ready to run 161 162package provide bench::in 0.1 163