Artifact
921135f07258d89e3876e074808ca7b462b92eb4:
- File
test/valgrind-www.tcl
— part of check-in
[a106404272]
at
2012-11-08 16:09:45
on branch trunk
— 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.
(user:
drh
size: 1402)
[more...]
0000: 23 21 2f 75 73 72 2f 62 69 6e 2f 74 63 6c 73 68 #!/usr/bin/tclsh
0010: 0a 23 0a 23 20 52 75 6e 20 74 68 69 73 20 73 63 .#.# Run this sc
0020: 72 69 70 74 20 69 6e 20 61 6e 20 6f 70 65 6e 20 ript in an open
0030: 46 6f 73 73 69 6c 20 63 68 65 63 6b 6f 75 74 20 Fossil checkout
0040: 61 74 20 74 68 65 20 74 6f 70 2d 6c 65 76 65 6c at the top-level
0050: 20 77 69 74 68 20 61 20 0a 23 20 66 72 65 73 68 with a .# fresh
0060: 20 62 75 69 6c 64 20 6f 66 20 46 6f 73 73 69 6c build of Fossil
0070: 20 69 74 73 65 6c 66 2e 20 20 54 68 69 73 20 73 itself. This s
0080: 63 72 69 70 74 20 77 69 6c 6c 20 72 75 6e 20 66 cript will run f
0090: 6f 73 73 69 6c 20 6f 6e 20 68 75 6e 64 72 65 64 ossil on hundred
00a0: 73 0a 23 20 6f 66 20 64 69 66 66 65 72 65 6e 74 s.# of different
00b0: 20 77 65 62 2d 70 61 67 65 73 20 6c 6f 6f 6b 69 web-pages looki
00c0: 6e 67 20 66 6f 72 20 6d 65 6d 6f 72 79 20 61 6c ng for memory al
00d0: 6c 6f 63 61 74 69 6f 6e 20 70 72 6f 62 6c 65 6d location problem
00e0: 73 20 75 73 69 6e 67 20 0a 23 20 76 61 6c 67 72 s using .# valgr
00f0: 69 6e 64 2e 20 20 56 61 6c 67 72 69 6e 64 20 6f ind. Valgrind o
0100: 75 74 70 75 74 20 61 70 70 65 61 72 73 20 6f 6e utput appears on
0110: 20 73 74 64 65 72 72 2e 20 20 53 75 67 67 65 73 stderr. Sugges
0120: 74 65 64 20 74 65 73 74 20 73 63 65 6e 61 72 69 ted test scenari
0130: 6f 3a 0a 23 0a 23 20 20 20 20 20 6d 61 6b 65 0a o:.#.# make.
0140: 23 20 20 20 20 20 74 63 6c 73 68 20 76 61 6c 67 # tclsh valg
0150: 72 69 6e 64 2d 77 77 77 2e 74 63 6c 20 32 3e 26 rind-www.tcl 2>&
0160: 31 20 7c 20 74 65 65 20 76 61 6c 67 72 69 6e 64 1 | tee valgrind
0170: 2d 6f 75 74 2e 74 78 74 0a 23 0a 23 20 54 68 65 -out.txt.#.# The
0180: 6e 20 65 78 61 6d 69 6e 65 20 74 68 65 20 76 61 n examine the va
0190: 6c 67 72 69 6e 64 2d 6f 75 74 2e 74 78 74 20 66 lgrind-out.txt f
01a0: 69 6c 65 20 66 6f 72 20 69 73 73 75 65 73 2e 0a ile for issues..
01b0: 23 0a 70 72 6f 63 20 72 75 6e 5f 71 75 65 72 79 #.proc run_query
01c0: 20 7b 75 72 6c 7d 20 7b 0a 20 20 73 65 74 20 66 {url} {. set f
01d0: 64 20 5b 6f 70 65 6e 20 71 2e 74 78 74 20 77 5d d [open q.txt w]
01e0: 0a 20 20 70 75 74 73 20 24 66 64 20 22 47 45 54 . puts $fd "GET
01f0: 20 24 75 72 6c 20 48 54 54 50 2f 31 2e 30 5c 72 $url HTTP/1.0\r
0200: 5c 6e 5c 72 22 0a 20 20 63 6c 6f 73 65 20 24 66 \n\r". close $f
0210: 64 0a 20 20 72 65 74 75 72 6e 20 5b 65 78 65 63 d. return [exec
0220: 20 76 61 6c 67 72 69 6e 64 20 2e 2f 66 6f 73 73 valgrind ./foss
0230: 69 6c 20 74 65 73 74 2d 68 74 74 70 20 3c 71 2e il test-http <q.
0240: 74 78 74 20 32 3e 40 20 73 74 64 65 72 72 5d 0a txt 2>@ stderr].
0250: 7d 0a 73 65 74 20 74 6f 64 6f 20 7b 7d 0a 66 6f }.set todo {}.fo
0260: 72 65 61 63 68 20 75 72 6c 20 7b 0a 20 20 2f 68 reach url {. /h
0270: 6f 6d 65 0a 20 20 2f 74 69 6d 65 6c 69 6e 65 0a ome. /timeline.
0280: 20 20 2f 62 72 6c 69 73 74 0a 20 20 2f 74 61 67 /brlist. /tag
0290: 6c 69 73 74 0a 20 20 2f 72 65 70 6f 72 74 6c 69 list. /reportli
02a0: 73 74 0a 20 20 2f 73 65 74 75 70 0a 20 20 2f 64 st. /setup. /d
02b0: 69 72 0a 20 20 2f 77 63 6f 6e 74 65 6e 74 0a 7d ir. /wcontent.}
02c0: 20 7b 0a 20 20 73 65 74 20 73 65 65 6e 28 24 75 {. set seen($u
02d0: 72 6c 29 20 31 0a 20 20 73 65 74 20 70 65 6e 64 rl) 1. set pend
02e0: 69 6e 67 28 24 75 72 6c 29 20 31 0a 7d 0a 73 65 ing($url) 1.}.se
02f0: 74 20 6c 69 6d 69 74 20 31 30 30 30 0a 73 65 74 t limit 1000.set
0300: 20 6e 70 65 6e 64 69 6e 67 20 5b 6c 6c 65 6e 67 npending [lleng
0310: 74 68 20 5b 61 72 72 61 79 20 6e 61 6d 65 73 20 th [array names
0320: 70 65 6e 64 69 6e 67 5d 5d 0a 70 72 6f 63 20 67 pending]].proc g
0330: 65 74 5f 70 65 6e 64 69 6e 67 20 7b 7d 20 7b 0a et_pending {} {.
0340: 20 20 67 6c 6f 62 61 6c 20 70 65 6e 64 69 6e 67 global pending
0350: 20 6e 70 65 6e 64 69 6e 67 0a 20 20 73 65 74 20 npending. set
0360: 72 65 73 20 5b 6c 69 6e 64 65 78 20 5b 61 72 72 res [lindex [arr
0370: 61 79 20 6e 61 6d 65 73 20 70 65 6e 64 69 6e 67 ay names pending
0380: 5d 20 5b 65 78 70 72 20 7b 69 6e 74 28 72 61 6e ] [expr {int(ran
0390: 64 28 29 2a 24 6e 70 65 6e 64 69 6e 67 29 7d 5d d()*$npending)}]
03a0: 5d 0a 20 20 75 6e 73 65 74 20 70 65 6e 64 69 6e ]. unset pendin
03b0: 67 28 24 72 65 73 29 0a 20 20 69 6e 63 72 20 6e g($res). incr n
03c0: 70 65 6e 64 69 6e 67 20 2d 31 0a 20 20 72 65 74 pending -1. ret
03d0: 75 72 6e 20 24 72 65 73 0a 7d 0a 66 6f 72 20 7b urn $res.}.for {
03e0: 73 65 74 20 69 20 30 7d 20 7b 24 6e 70 65 6e 64 set i 0} {$npend
03f0: 69 6e 67 3e 30 20 26 26 20 24 69 3c 24 6c 69 6d ing>0 && $i<$lim
0400: 69 74 7d 20 7b 69 6e 63 72 20 69 7d 20 7b 0a 20 it} {incr i} {.
0410: 20 73 65 74 20 75 72 6c 20 5b 67 65 74 5f 70 65 set url [get_pe
0420: 6e 64 69 6e 67 5d 0a 20 20 70 75 74 73 20 22 3d nding]. puts "=
0430: 3d 3d 3d 3d 3d 20 28 5b 65 78 70 72 20 7b 24 69 ===== ([expr {$i
0440: 2b 31 7d 5d 29 20 24 75 72 6c 20 3d 3d 3d 3d 3d +1}]) $url =====
0450: 3d 22 0a 20 20 73 65 74 20 78 20 5b 72 75 6e 5f =". set x [run_
0460: 71 75 65 72 79 20 24 75 72 6c 5d 0a 20 20 77 68 query $url]. wh
0470: 69 6c 65 20 7b 5b 72 65 67 65 78 70 20 7b 3c 5b ile {[regexp {<[
0480: 61 41 5d 20 2e 2a 3f 68 72 65 66 3d 22 28 2f 5b aA] .*?href="(/[
0490: 61 2d 7a 5d 2e 2a 3f 29 22 2e 2a 3f 3e 28 2e 2a a-z].*?)".*?>(.*
04a0: 29 24 7d 20 24 78 20 61 6c 6c 20 75 72 6c 20 74 )$} $x all url t
04b0: 61 69 6c 5d 7d 20 7b 0a 20 20 20 20 73 65 74 20 ail]} {. set
04c0: 75 32 20 5b 73 74 72 69 6e 67 20 6d 61 70 20 7b u2 [string map {
04d0: 26 6c 74 3b 20 3c 20 26 67 74 3b 20 3e 20 26 71 < < > > &q
04e0: 75 6f 74 3b 20 5c 22 20 26 61 6d 70 3b 20 26 7d uot; \" & &}
04f0: 20 24 75 72 6c 5d 0a 20 20 20 20 69 66 20 7b 21 $url]. if {!
0500: 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 73 65 65 [info exists see
0510: 6e 28 24 75 32 29 5d 7d 20 7b 0a 20 20 20 20 20 n($u2)]} {.
0520: 20 73 65 74 20 70 65 6e 64 69 6e 67 28 24 75 32 set pending($u2
0530: 29 20 31 0a 20 20 20 20 20 20 73 65 74 20 73 65 ) 1. set se
0540: 65 6e 28 24 75 32 29 20 31 0a 20 20 20 20 20 20 en($u2) 1.
0550: 69 6e 63 72 20 6e 70 65 6e 64 69 6e 67 0a 20 20 incr npending.
0560: 20 20 7d 0a 20 20 20 20 73 65 74 20 78 20 24 74 }. set x $t
0570: 61 69 6c 0a 20 20 7d 0a 7d 0a ail. }.}.