读懂每一行代码! 问题大全new
你需要登录才能添加代码说明
redis-2.8.3/ utils/ speed-regression.tcl
 1  2  3  4  5  6  7  8  9  10  11  12  13  14  15  16  17  18  19  20  21  22  23  24  25  26  27  28  29  30  31  32  33  34  35  36  37  38  39  40  41  42  43  44  45  46  47  48  49  50  51  52  53  54  55  56  57  58  59  60  61  62  63  64  65  66  67  68  69  70  71  72  73  74  75  76  77  78  79  80  81  82  83  84  85  86  87  88  89  90  91  92  93  94  95  96  97  98  99  100  101  102  103  104  105  106  107  108  109  110  111  112  113  114  115  116  117  118  119  120  121  122  123  124  125  126  127  128  129  130  131 
#!/usr/bin/env tclsh8.5
# Copyright (C) 2011 Salvatore Sanfilippo
# Released under the BSD license like Redis itself

source ../tests/support/redis.tcl
set ::port 12123
set ::tests {PING,SET,GET,INCR,LPUSH,LPOP,SADD,SPOP,LRANGE_100,LRANGE_600,MSET}
set ::datasize 16
set ::requests 100000

proc run-tests branches {
    set runs {}
    set branch_id 0
    foreach b $branches {
        cd ../src
        puts "Benchmarking $b"
        exec -ignorestderr git checkout $b 2> /dev/null
        exec -ignorestderr make clean 2> /dev/null
        puts "  compiling..."
        exec -ignorestderr make 2> /dev/null

        if {$branch_id == 0} {
            puts "  copy redis-benchmark from unstable to /tmp..."
            exec -ignorestderr cp ./redis-benchmark /tmp
            incr branch_id
            continue
        }

        # Start the Redis server
        puts "  starting the server... [exec ./redis-server -v]"
        set pids [exec echo "port $::port\nloglevel warning\n" | ./redis-server - > /dev/null 2> /dev/null &]
        puts "  pids: $pids"
        after 1000
        puts "  running the benchmark"

        set r [redis 127.0.0.1 $::port]
        set i [$r info]
        puts "  redis INFO shows version: [lindex [split $i] 0]"
        $r close

        set output [exec /tmp/redis-benchmark -n $::requests -t $::tests -d $::datasize --csv -p $::port]
        lappend runs $b $output
        puts "  killing server..."
        catch {exec kill -9 [lindex $pids 0]}
        catch {exec kill -9 [lindex $pids 1]}
        incr branch_id
    }
    return $runs
}

proc get-result-with-name {output name} {
    foreach line [split $output "\n"] {
        lassign [split $line ","] key value
        set key [string tolower [string range $key 1 end-1]]
        set value [string range $value 1 end-1]
        if {$key eq [string tolower $name]} {
            return $value
        }
    }
    return "n/a"
}

proc get-test-names output {
    set names {}
    foreach line [split $output "\n"] {
        lassign [split $line ","] key value
        set key [string tolower [string range $key 1 end-1]]
        lappend names $key
    }
    return $names
}

proc combine-results {results} {
    set tests [get-test-names [lindex $results 1]]
    foreach test $tests {
        puts $test
        foreach {branch output} $results {
            puts [format "%-20s %s" \
                $branch [get-result-with-name $output $test]]
        }
        puts {}
    }
}

proc main {} {
    # Note: the first branch is only used in order to get the redis-benchmark
    # executable. Tests are performed starting from the second branch.
    set branches {
        slowset 2.2.0 2.4.0 unstable slowset
    }
    set results [run-tests $branches]
    puts "\n"
    puts "# Test results: datasize=$::datasize requests=$::requests"
    puts [combine-results $results]
}

# Force the user to run the script from the 'utils' directory.
if {![file exists speed-regression.tcl]} {
    puts "Please make sure to run speed-regression.tcl while inside /utils."
    puts "Example: cd utils; ./speed-regression.tcl"
    exit 1
}

# Make sure there is not already a server runnign on port 12123
set is_not_running [catch {set r [redis 127.0.0.1 $::port]}]
if {!$is_not_running} {
    puts "Sorry, you have a running server on port $::port"
    exit 1
}

# parse arguments
for {set j 0} {$j < [llength $argv]} {incr j} {
    set opt [lindex $argv $j]
    set arg [lindex $argv [expr $j+1]]
    if {$opt eq {--tests}} {
        set ::tests $arg
        incr j
    } elseif {$opt eq {--datasize}} {
        set ::datasize $arg
        incr j
    } elseif {$opt eq {--requests}} {
        set ::requests $arg
        incr j
    } else {
        puts "Wrong argument: $opt"
        exit 1
    }
}

main