b0e3b6588f 2019-09-17 1: #! /usr/bin/env tclsh
b0e3b6588f 2019-09-17 2:
b0e3b6588f 2019-09-17 3: set LIB_SUFFIX [info sharedlibextension]
b0e3b6588f 2019-09-17 4: load -global ./xvfs${LIB_SUFFIX}; # Optional, uses a dispatcher
b0e3b6588f 2019-09-17 5: load ./example-flexible${LIB_SUFFIX} Xvfs_example
b0e3b6588f 2019-09-17 6:
200a60c198 2019-09-18 7: set benchmarkFormat "%-6s %-11s %s"
b0e3b6588f 2019-09-17 8:
b0e3b6588f 2019-09-17 9: proc benchmark {type name code} {
200a60c198 2019-09-18 10: set iterations 10000
200a60c198 2019-09-18 11:
200a60c198 2019-09-18 12: set work [string trim [lindex [split [string trim $code] "\n"] 0]]
200a60c198 2019-09-18 13: if {[string match "# iterations: *" $work]} {
200a60c198 2019-09-18 14: set iterations [lindex $work 2]
200a60c198 2019-09-18 15: }
200a60c198 2019-09-18 16:
200a60c198 2019-09-18 17: time $code [expr {max($iterations / 100, 1)}]
200a60c198 2019-09-18 18: set time [time $code $iterations]
b0e3b6588f 2019-09-17 19:
b0e3b6588f 2019-09-17 20: puts [format $::benchmarkFormat $type $name $time]
b0e3b6588f 2019-09-17 21: }
b0e3b6588f 2019-09-17 22:
b0e3b6588f 2019-09-17 23: set rootDirMap(xvfs) "//xvfs:/example"
b0e3b6588f 2019-09-17 24: set rootDirMap(native) [file join [pwd] example]
b0e3b6588f 2019-09-17 25:
200a60c198 2019-09-18 26: proc recursiveGlob {dir} {
200a60c198 2019-09-18 27: foreach subDir [glob -nocomplain -directory $dir -types d *] {
200a60c198 2019-09-18 28: recursiveGlob $subDir
200a60c198 2019-09-18 29: }
b0e3b6588f 2019-09-17 30: }
b0e3b6588f 2019-09-17 31:
200a60c198 2019-09-18 32: array set test {
200a60c198 2019-09-18 33: CD {
200a60c198 2019-09-18 34: cd $::rootDir
200a60c198 2019-09-18 35: pwd
200a60c198 2019-09-18 36: }
200a60c198 2019-09-18 37: Read {
200a60c198 2019-09-18 38: set fd [open ${::rootDir}/main.tcl]
200a60c198 2019-09-18 39: read $fd
200a60c198 2019-09-18 40: close $fd
200a60c198 2019-09-18 41: }
200a60c198 2019-09-18 42: "Read Async" {
200a60c198 2019-09-18 43: # iterations: 1000
200a60c198 2019-09-18 44: set ::async_read_done false
200a60c198 2019-09-18 45: set fd [open ${::rootDir}/main.tcl]
200a60c198 2019-09-18 46: fconfigure $fd -blocking false
200a60c198 2019-09-18 47: fileevent $fd readable [list apply {{fd} {
200a60c198 2019-09-18 48: set input [read $fd 512]
200a60c198 2019-09-18 49: if {[eof $fd] && $input eq ""} {
200a60c198 2019-09-18 50: set ::async_read_done true
200a60c198 2019-09-18 51: return
200a60c198 2019-09-18 52: }
200a60c198 2019-09-18 53: }} $fd]
200a60c198 2019-09-18 54: vwait ::async_read_done
200a60c198 2019-09-18 55: close $fd
200a60c198 2019-09-18 56: }
200a60c198 2019-09-18 57: Glob {
200a60c198 2019-09-18 58: glob -directory ${::rootDir} *
200a60c198 2019-09-18 59: }
200a60c198 2019-09-18 60: Search {
200a60c198 2019-09-18 61: recursiveGlob ${::rootDir}
200a60c198 2019-09-18 62: }
200a60c198 2019-09-18 63: +Stat {
200a60c198 2019-09-18 64: file stat ${::rootDir}/main.tcl UNUSED
200a60c198 2019-09-18 65: }
200a60c198 2019-09-18 66: -Stat {
200a60c198 2019-09-18 67: catch {
200a60c198 2019-09-18 68: file stat ${::rootDir}/DOES-NOT-EXIST UNUSED
200a60c198 2019-09-18 69: }
200a60c198 2019-09-18 70: }
b0e3b6588f 2019-09-17 71: }
b0e3b6588f 2019-09-17 72:
b0e3b6588f 2019-09-17 73: foreach {testName testBody} [lsort -stride 2 -dictionary [array get test]] {
b0e3b6588f 2019-09-17 74: foreach rootDirType {xvfs native} {
b0e3b6588f 2019-09-17 75: set rootDir $rootDirMap($rootDirType)
b0e3b6588f 2019-09-17 76: benchmark $rootDirType $testName $testBody
b0e3b6588f 2019-09-17 77: }
b0e3b6588f 2019-09-17 78: }