Fossil SCM

Add a new test script that runs 10,000 web pages without valgrind looking for performance issues or fatal errors. Fix one incorrect SQL statement found by this script. Update the valgrind test script to run discovered web pages in a random order.

drh 2012-11-08 16:09 trunk
Commit a1064042722ba2a2d41ec103cd18284e9c5a9ba1
Parent b1199eb92bf09b5…
3 files changed +1 -1 +51 +15 -4
~ src/attach.c + test/many-www.tcl ~ test/valgrind-www.tcl
M src/attach.c
+1 -1
--- src/attach.c
+++ src/attach.c
@@ -525,11 +525,11 @@
525525
 @ </pre>
526526
 }
527527
 }else if( strncmp(zMime, "image/", 6)==0 ){
528528
 @ <img src="%R/raw?name=%s(zSrc)&m=%s(zMime)"></img>
529529
 }else{
530
- int sz = db_int(0, "SELECT sz FROM blob WHERE rid=%d", ridSrc);
530
+ int sz = db_int(0, "SELECT size FROM blob WHERE rid=%d", ridSrc);
531531
 @ <i>(file is %d(sz) bytes of binary data)</i>
532532
 }
533533
 @ </blockquote>
534534
 manifest_destroy(pAttach);
535535
 blob_reset(&attach);
536536
537537
ADDED test/many-www.tcl
--- src/attach.c
+++ src/attach.c
@@ -525,11 +525,11 @@
525 @ </pre>
526 }
527 }else if( strncmp(zMime, "image/", 6)==0 ){
528 @ <img src="%R/raw?name=%s(zSrc)&m=%s(zMime)"></img>
529 }else{
530 int sz = db_int(0, "SELECT sz FROM blob WHERE rid=%d", ridSrc);
531 @ <i>(file is %d(sz) bytes of binary data)</i>
532 }
533 @ </blockquote>
534 manifest_destroy(pAttach);
535 blob_reset(&attach);
536
537 DDED test/many-www.tcl
--- src/attach.c
+++ src/attach.c
@@ -525,11 +525,11 @@
525 @ </pre>
526 }
527 }else if( strncmp(zMime, "image/", 6)==0 ){
528 @ <img src="%R/raw?name=%s(zSrc)&m=%s(zMime)"></img>
529 }else{
530 int sz = db_int(0, "SELECT size FROM blob WHERE rid=%d", ridSrc);
531 @ <i>(file is %d(sz) bytes of binary data)</i>
532 }
533 @ </blockquote>
534 manifest_destroy(pAttach);
535 blob_reset(&attach);
536
537 DDED test/many-www.tcl
A test/many-www.tcl
+51
--- a/test/many-www.tcl
+++ b/test/many-www.tcl
@@ -0,0 +1,51 @@
1
+#!/usr/bin/tclsh
2
+#
3
+# Run this script from within any open Fossil checkout. Example:
4
+#
5
+# tclsh many-www.tcl | tee out.txt
6
+#
7
+# About 10,000 different web page requests will be made. Each is timed
8
+# and the time shown on output. Use this script to search for segfault problems
9
+# or to look for pages that need optimization.
10
+#
11
+proc run_query {url} {
12
+ set fd [open q.txt w]
13
+ puts $fd "GET $url HTTP/1.0\r\n\r"
14
+ close $fd
15
+ return [exec fossil test-http <q.txt]
16
+}
17
+set todo {}
18
+foreach url {
19
+ /home
20
+ /timeline
21
+ /brlist
22
+ /taglist
23
+ /reportlist
24
+ } {
25
+ set seen($url) 1
26
+ limit 10000
27
+set npending [llength [array names pending]]
28
+proc get_pending {} {
29
+ global pending npending
30
+ set res [lindex [array names pending] [expr {int(rand()*$npending)}]]
31
+ unset pending($res)
32
+ incr npending -1
33
+ return $res
34
+}
35
+for {set i 0} {$npending>0 && turn $res
36
+}
37
+for {set i 0} {$i<$limit} {incr i} {
38
+ set url [get_pe puts -nonewline "($round/[expr {$i+1}]) $url "
39
+ flush stdout
40
+ set tm [time {set x [run_query $url]}]
41
+ set ms [lindex $tm 0]
42
+ puts [format {%.3fs} [expr {$ms/1000000.0}]]
43
+ flush stdout
44
+ if {[string length $x]>1000000} {
45
+ set x [string0 1000000]
46
+ }
47
+ set k 0
48
+ while {[regexp {<[aA] .*?href="(/[a-z].*?)".*?>(.*)$} $x all url taset u2 [string map {&lt; < &gt; > &quot; \" &amp; &} $url]
49
+ if {![info exists seen($u2)]} {
50
+ set next($u2) 1
51
+ set seen(pending incr npending
--- a/test/many-www.tcl
+++ b/test/many-www.tcl
@@ -0,0 +1,51 @@
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
--- a/test/many-www.tcl
+++ b/test/many-www.tcl
@@ -0,0 +1,51 @@
1 #!/usr/bin/tclsh
2 #
3 # Run this script from within any open Fossil checkout. Example:
4 #
5 # tclsh many-www.tcl | tee out.txt
6 #
7 # About 10,000 different web page requests will be made. Each is timed
8 # and the time shown on output. Use this script to search for segfault problems
9 # or to look for pages that need optimization.
10 #
11 proc run_query {url} {
12 set fd [open q.txt w]
13 puts $fd "GET $url HTTP/1.0\r\n\r"
14 close $fd
15 return [exec fossil test-http <q.txt]
16 }
17 set todo {}
18 foreach url {
19 /home
20 /timeline
21 /brlist
22 /taglist
23 /reportlist
24 } {
25 set seen($url) 1
26 limit 10000
27 set npending [llength [array names pending]]
28 proc get_pending {} {
29 global pending npending
30 set res [lindex [array names pending] [expr {int(rand()*$npending)}]]
31 unset pending($res)
32 incr npending -1
33 return $res
34 }
35 for {set i 0} {$npending>0 && turn $res
36 }
37 for {set i 0} {$i<$limit} {incr i} {
38 set url [get_pe puts -nonewline "($round/[expr {$i+1}]) $url "
39 flush stdout
40 set tm [time {set x [run_query $url]}]
41 set ms [lindex $tm 0]
42 puts [format {%.3fs} [expr {$ms/1000000.0}]]
43 flush stdout
44 if {[string length $x]>1000000} {
45 set x [string0 1000000]
46 }
47 set k 0
48 while {[regexp {<[aA] .*?href="(/[a-z].*?)".*?>(.*)$} $x all url taset u2 [string map {&lt; < &gt; > &quot; \" &amp; &} $url]
49 if {![info exists seen($u2)]} {
50 set next($u2) 1
51 set seen(pending incr npending
M test/valgrind-www.tcl
+15 -4
--- test/valgrind-www.tcl
+++ test/valgrind-www.tcl
@@ -23,22 +23,33 @@
2323
 /brlist
2424
 /taglist
2525
 /reportlist
2626
 /setup
2727
 /dir
28
+ /wcontent
2829
 } {
2930
 set seen($url) 1
30
- lappend todo $url
31
+ set pending($url) 1
32
+}
33
+set limit 1000
34
+set npending [llength [array names pending]]
35
+proc get_pending {} {
36
+ global pending npending
37
+ set res [lindex [array names pending] [expr {int(rand()*$npending)}]]
38
+ unset pending($res)
39
+ incr npending -1
40
+ return $res
3141
 }
32
-for {set i 0} {$i<[llength $todo] && $i<1000} {incr i} {
33
- set url [lindex $todo $i]
42
+for {set i 0} {$npending>0 && $i<$limit} {incr i} {
43
+ set url [get_pending]
3444
 puts "====== ([expr {$i+1}]) $url ======"
3545
 set x [run_query $url]
3646
 while {[regexp {<[aA] .*?href="(/[a-z].*?)".*?>(.*)$} $x all url tail]} {
3747
 set u2 [string map {&lt; < &gt; > &quot; \" &amp; &} $url]
3848
 if {![info exists seen($u2)]} {
39
- lappend todo $u2
49
+ set pending($u2) 1
4050
 set seen($u2) 1
51
+ incr npending
4152
 }
4253
 set x $tail
4354
 }
4455
 }
4556
--- test/valgrind-www.tcl
+++ test/valgrind-www.tcl
@@ -23,22 +23,33 @@
23 /brlist
24 /taglist
25 /reportlist
26 /setup
27 /dir
 
28 } {
29 set seen($url) 1
30 lappend todo $url
 
 
 
 
 
 
 
 
 
31 }
32 for {set i 0} {$i<[llength $todo] && $i<1000} {incr i} {
33 set url [lindex $todo $i]
34 puts "====== ([expr {$i+1}]) $url ======"
35 set x [run_query $url]
36 while {[regexp {<[aA] .*?href="(/[a-z].*?)".*?>(.*)$} $x all url tail]} {
37 set u2 [string map {&lt; < &gt; > &quot; \" &amp; &} $url]
38 if {![info exists seen($u2)]} {
39 lappend todo $u2
40 set seen($u2) 1
 
41 }
42 set x $tail
43 }
44 }
45
--- test/valgrind-www.tcl
+++ test/valgrind-www.tcl
@@ -23,22 +23,33 @@
23 /brlist
24 /taglist
25 /reportlist
26 /setup
27 /dir
28 /wcontent
29 } {
30 set seen($url) 1
31 set pending($url) 1
32 }
33 set limit 1000
34 set npending [llength [array names pending]]
35 proc get_pending {} {
36 global pending npending
37 set res [lindex [array names pending] [expr {int(rand()*$npending)}]]
38 unset pending($res)
39 incr npending -1
40 return $res
41 }
42 for {set i 0} {$npending>0 && $i<$limit} {incr i} {
43 set url [get_pending]
44 puts "====== ([expr {$i+1}]) $url ======"
45 set x [run_query $url]
46 while {[regexp {<[aA] .*?href="(/[a-z].*?)".*?>(.*)$} $x all url tail]} {
47 set u2 [string map {&lt; < &gt; > &quot; \" &amp; &} $url]
48 if {![info exists seen($u2)]} {
49 set pending($u2) 1
50 set seen($u2) 1
51 incr npending
52 }
53 set x $tail
54 }
55 }
56

Keyboard Shortcuts

Open search /
Next entry (timeline) j
Previous entry (timeline) k
Open focused entry Enter
Show this help ?
Toggle theme Top nav button