speed-regression.tcl 3.7 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130
  1. #!/usr/bin/env tclsh8.5
  2. # Copyright (C) 2011 Salvatore Sanfilippo
  3. # Released under the BSD license like Redis itself
  4. source ../tests/support/redis.tcl
  5. set ::port 12123
  6. set ::tests {PING,SET,GET,INCR,LPUSH,LPOP,SADD,SPOP,LRANGE_100,LRANGE_600,MSET}
  7. set ::datasize 16
  8. set ::requests 100000
  9. proc run-tests branches {
  10. set runs {}
  11. set branch_id 0
  12. foreach b $branches {
  13. cd ../src
  14. puts "Benchmarking $b"
  15. exec -ignorestderr git checkout $b 2> /dev/null
  16. exec -ignorestderr make clean 2> /dev/null
  17. puts " compiling..."
  18. exec -ignorestderr make 2> /dev/null
  19. if {$branch_id == 0} {
  20. puts " copy redis-benchmark from unstable to /tmp..."
  21. exec -ignorestderr cp ./redis-benchmark /tmp
  22. incr branch_id
  23. continue
  24. }
  25. # Start the Redis server
  26. puts " starting the server... [exec ./redis-server -v]"
  27. set pids [exec echo "port $::port\nloglevel warning\n" | ./redis-server - > /dev/null 2> /dev/null &]
  28. puts " pids: $pids"
  29. after 1000
  30. puts " running the benchmark"
  31. set r [redis 127.0.0.1 $::port]
  32. set i [$r info]
  33. puts " redis INFO shows version: [lindex [split $i] 0]"
  34. $r close
  35. set output [exec /tmp/redis-benchmark -n $::requests -t $::tests -d $::datasize --csv -p $::port]
  36. lappend runs $b $output
  37. puts " killing server..."
  38. catch {exec kill -9 [lindex $pids 0]}
  39. catch {exec kill -9 [lindex $pids 1]}
  40. incr branch_id
  41. }
  42. return $runs
  43. }
  44. proc get-result-with-name {output name} {
  45. foreach line [split $output "\n"] {
  46. lassign [split $line ","] key value
  47. set key [string tolower [string range $key 1 end-1]]
  48. set value [string range $value 1 end-1]
  49. if {$key eq [string tolower $name]} {
  50. return $value
  51. }
  52. }
  53. return "n/a"
  54. }
  55. proc get-test-names output {
  56. set names {}
  57. foreach line [split $output "\n"] {
  58. lassign [split $line ","] key value
  59. set key [string tolower [string range $key 1 end-1]]
  60. lappend names $key
  61. }
  62. return $names
  63. }
  64. proc combine-results {results} {
  65. set tests [get-test-names [lindex $results 1]]
  66. foreach test $tests {
  67. puts $test
  68. foreach {branch output} $results {
  69. puts [format "%-20s %s" \
  70. $branch [get-result-with-name $output $test]]
  71. }
  72. puts {}
  73. }
  74. }
  75. proc main {} {
  76. # Note: the first branch is only used in order to get the redis-benchmark
  77. # executable. Tests are performed starting from the second branch.
  78. set branches {
  79. slowset 2.2.0 2.4.0 unstable slowset
  80. }
  81. set results [run-tests $branches]
  82. puts "\n"
  83. puts "# Test results: datasize=$::datasize requests=$::requests"
  84. puts [combine-results $results]
  85. }
  86. # Force the user to run the script from the 'utils' directory.
  87. if {![file exists speed-regression.tcl]} {
  88. puts "Please make sure to run speed-regression.tcl while inside /utils."
  89. puts "Example: cd utils; ./speed-regression.tcl"
  90. exit 1
  91. }
  92. # Make sure there is not already a server runnign on port 12123
  93. set is_not_running [catch {set r [redis 127.0.0.1 $::port]}]
  94. if {!$is_not_running} {
  95. puts "Sorry, you have a running server on port $::port"
  96. exit 1
  97. }
  98. # parse arguments
  99. for {set j 0} {$j < [llength $argv]} {incr j} {
  100. set opt [lindex $argv $j]
  101. set arg [lindex $argv [expr $j+1]]
  102. if {$opt eq {--tests}} {
  103. set ::tests $arg
  104. incr j
  105. } elseif {$opt eq {--datasize}} {
  106. set ::datasize $arg
  107. incr j
  108. } elseif {$opt eq {--requests}} {
  109. set ::requests $arg
  110. incr j
  111. } else {
  112. puts "Wrong argument: $opt"
  113. exit 1
  114. }
  115. }
  116. main