Fossil SCM
Update the many-www.tcl test script to stage the URLs testing and to run more of them.
Commit
691f18840211f8b0855eee7a4f5f05cabfb37e93
Parent
cd8aad43929cdc8…
1 file changed
+23
-6
+23
-6
| --- test/many-www.tcl | ||
| +++ test/many-www.tcl | ||
| @@ -22,26 +22,44 @@ | ||
| 22 | 22 | /taglist |
| 23 | 23 | /reportlist |
| 24 | 24 | /setup |
| 25 | 25 | /dir |
| 26 | 26 | /wcontent |
| 27 | + /attachlist | |
| 28 | + /taglist | |
| 29 | + /test_env | |
| 30 | + /stat | |
| 31 | + /rcvfromlist | |
| 32 | + /urllist | |
| 33 | + /modreq | |
| 34 | + /info/d5c4 | |
| 35 | + /test-all-help | |
| 36 | + /leaves | |
| 37 | + /timeline?a=1970-01-01 | |
| 27 | 38 | } { |
| 28 | 39 | set seen($url) 1 |
| 29 | 40 | set pending($url) 1 |
| 30 | 41 | } |
| 31 | -set limit 10000 | |
| 42 | +set round 1 | |
| 43 | +set limit 25000 | |
| 32 | 44 | set npending [llength [array names pending]] |
| 33 | 45 | proc get_pending {} { |
| 34 | - global pending npending | |
| 46 | + global pending npending round next | |
| 47 | + if {$npending==0} { | |
| 48 | + incr round | |
| 49 | + array set pending [array get next] | |
| 50 | + set npending [llength [array names pending]] | |
| 51 | + unset -nocomplain next | |
| 52 | + } | |
| 35 | 53 | set res [lindex [array names pending] [expr {int(rand()*$npending)}]] |
| 36 | 54 | unset pending($res) |
| 37 | 55 | incr npending -1 |
| 38 | 56 | return $res |
| 39 | 57 | } |
| 40 | -for {set i 0} {$npending>0 && $i<$limit} {incr i} { | |
| 58 | +for {set i 0} {$i<$limit} {incr i} { | |
| 41 | 59 | set url [get_pending] |
| 42 | - puts -nonewline "([expr {$i+1}]) $url " | |
| 60 | + puts -nonewline "($round/[expr {$i+1}]) $url " | |
| 43 | 61 | flush stdout |
| 44 | 62 | set tm [time {set x [run_query $url]}] |
| 45 | 63 | set ms [lindex $tm 0] |
| 46 | 64 | puts [format {%.3fs} [expr {$ms/1000000.0}]] |
| 47 | 65 | flush stdout |
| @@ -50,12 +68,11 @@ | ||
| 50 | 68 | } |
| 51 | 69 | while {[regexp {<[aA] .*?href="(/[a-z].*?)".*?>(.*)$} $x all url tail]} { |
| 52 | 70 | # if {$npending>2*($limit - $i)} break |
| 53 | 71 | set u2 [string map {< < > > " \" & &} $url] |
| 54 | 72 | if {![info exists seen($u2)]} { |
| 55 | - set pending($u2) 1 | |
| 73 | + set next($u2) 1 | |
| 56 | 74 | set seen($u2) 1 |
| 57 | - incr npending | |
| 58 | 75 | } |
| 59 | 76 | set x $tail |
| 60 | 77 | } |
| 61 | 78 | } |
| 62 | 79 |
| --- test/many-www.tcl | |
| +++ test/many-www.tcl | |
| @@ -22,26 +22,44 @@ | |
| 22 | /taglist |
| 23 | /reportlist |
| 24 | /setup |
| 25 | /dir |
| 26 | /wcontent |
| 27 | } { |
| 28 | set seen($url) 1 |
| 29 | set pending($url) 1 |
| 30 | } |
| 31 | set limit 10000 |
| 32 | set npending [llength [array names pending]] |
| 33 | proc get_pending {} { |
| 34 | global pending npending |
| 35 | set res [lindex [array names pending] [expr {int(rand()*$npending)}]] |
| 36 | unset pending($res) |
| 37 | incr npending -1 |
| 38 | return $res |
| 39 | } |
| 40 | for {set i 0} {$npending>0 && $i<$limit} {incr i} { |
| 41 | set url [get_pending] |
| 42 | puts -nonewline "([expr {$i+1}]) $url " |
| 43 | flush stdout |
| 44 | set tm [time {set x [run_query $url]}] |
| 45 | set ms [lindex $tm 0] |
| 46 | puts [format {%.3fs} [expr {$ms/1000000.0}]] |
| 47 | flush stdout |
| @@ -50,12 +68,11 @@ | |
| 50 | } |
| 51 | while {[regexp {<[aA] .*?href="(/[a-z].*?)".*?>(.*)$} $x all url tail]} { |
| 52 | # if {$npending>2*($limit - $i)} break |
| 53 | set u2 [string map {< < > > " \" & &} $url] |
| 54 | if {![info exists seen($u2)]} { |
| 55 | set pending($u2) 1 |
| 56 | set seen($u2) 1 |
| 57 | incr npending |
| 58 | } |
| 59 | set x $tail |
| 60 | } |
| 61 | } |
| 62 |
| --- test/many-www.tcl | |
| +++ test/many-www.tcl | |
| @@ -22,26 +22,44 @@ | |
| 22 | /taglist |
| 23 | /reportlist |
| 24 | /setup |
| 25 | /dir |
| 26 | /wcontent |
| 27 | /attachlist |
| 28 | /taglist |
| 29 | /test_env |
| 30 | /stat |
| 31 | /rcvfromlist |
| 32 | /urllist |
| 33 | /modreq |
| 34 | /info/d5c4 |
| 35 | /test-all-help |
| 36 | /leaves |
| 37 | /timeline?a=1970-01-01 |
| 38 | } { |
| 39 | set seen($url) 1 |
| 40 | set pending($url) 1 |
| 41 | } |
| 42 | set round 1 |
| 43 | set limit 25000 |
| 44 | set npending [llength [array names pending]] |
| 45 | proc get_pending {} { |
| 46 | global pending npending round next |
| 47 | if {$npending==0} { |
| 48 | incr round |
| 49 | array set pending [array get next] |
| 50 | set npending [llength [array names pending]] |
| 51 | unset -nocomplain next |
| 52 | } |
| 53 | set res [lindex [array names pending] [expr {int(rand()*$npending)}]] |
| 54 | unset pending($res) |
| 55 | incr npending -1 |
| 56 | return $res |
| 57 | } |
| 58 | for {set i 0} {$i<$limit} {incr i} { |
| 59 | set url [get_pending] |
| 60 | puts -nonewline "($round/[expr {$i+1}]) $url " |
| 61 | flush stdout |
| 62 | set tm [time {set x [run_query $url]}] |
| 63 | set ms [lindex $tm 0] |
| 64 | puts [format {%.3fs} [expr {$ms/1000000.0}]] |
| 65 | flush stdout |
| @@ -50,12 +68,11 @@ | |
| 68 | } |
| 69 | while {[regexp {<[aA] .*?href="(/[a-z].*?)".*?>(.*)$} $x all url tail]} { |
| 70 | # if {$npending>2*($limit - $i)} break |
| 71 | set u2 [string map {< < > > " \" & &} $url] |
| 72 | if {![info exists seen($u2)]} { |
| 73 | set next($u2) 1 |
| 74 | set seen($u2) 1 |
| 75 | } |
| 76 | set x $tail |
| 77 | } |
| 78 | } |
| 79 |