Fossil SCM
| 9e0da27… | drh | 1 | #!/usr/bin/tclsh |
| 9e0da27… | drh | 2 | # |
| 34820b4… | jan.nijtmans | 3 | # Run this script in an open Fossil checkout at the top-level with a |
| 9e0da27… | drh | 4 | # fresh build of Fossil itself. This script will run fossil on hundreds |
| 34820b4… | jan.nijtmans | 5 | # of different web-pages looking for memory allocation problems using |
| 9e0da27… | drh | 6 | # valgrind. Valgrind output appears on stderr. Suggested test scenario: |
| 9e0da27… | drh | 7 | # |
| 9e0da27… | drh | 8 | # make |
| 9e0da27… | drh | 9 | # tclsh valgrind-www.tcl 2>&1 | tee valgrind-out.txt |
| 9e0da27… | drh | 10 | # |
| 9e0da27… | drh | 11 | # Then examine the valgrind-out.txt file for issues. |
| 9e0da27… | drh | 12 | # |
| 9e0da27… | drh | 13 | proc run_query {url} { |
| 9e0da27… | drh | 14 | set fd [open q.txt w] |
| 9e0da27… | drh | 15 | puts $fd "GET $url HTTP/1.0\r\n\r" |
| 9e0da27… | drh | 16 | close $fd |
| fcfe117… | drh | 17 | set msg {} |
| fcfe117… | drh | 18 | catch {exec valgrind ./fossil test-http <q.txt 2>@ stderr} msg |
| fcfe117… | drh | 19 | return $msg |
| 9e0da27… | drh | 20 | } |
| 9e0da27… | drh | 21 | set todo {} |
| 9e0da27… | drh | 22 | foreach url { |
| 9e0da27… | drh | 23 | /home |
| 9e0da27… | drh | 24 | /timeline |
| 9e0da27… | drh | 25 | /brlist |
| 9e0da27… | drh | 26 | /taglist |
| 9e0da27… | drh | 27 | /reportlist |
| 9e0da27… | drh | 28 | /setup |
| 9e0da27… | drh | 29 | /dir |
| a106404… | drh | 30 | /wcontent |
| 9e0da27… | drh | 31 | } { |
| 9e0da27… | drh | 32 | set seen($url) 1 |
| a106404… | drh | 33 | set pending($url) 1 |
| a106404… | drh | 34 | } |
| a106404… | drh | 35 | set limit 1000 |
| a106404… | drh | 36 | set npending [llength [array names pending]] |
| a106404… | drh | 37 | proc get_pending {} { |
| a106404… | drh | 38 | global pending npending |
| a106404… | drh | 39 | set res [lindex [array names pending] [expr {int(rand()*$npending)}]] |
| a106404… | drh | 40 | unset pending($res) |
| a106404… | drh | 41 | incr npending -1 |
| a106404… | drh | 42 | return $res |
| 9e0da27… | drh | 43 | } |
| a106404… | drh | 44 | for {set i 0} {$npending>0 && $i<$limit} {incr i} { |
| a106404… | drh | 45 | set url [get_pending] |
| 9e0da27… | drh | 46 | puts "====== ([expr {$i+1}]) $url ======" |
| 9e0da27… | drh | 47 | set x [run_query $url] |
| 9e0da27… | drh | 48 | while {[regexp {<[aA] .*?href="(/[a-z].*?)".*?>(.*)$} $x all url tail]} { |
| 9e0da27… | drh | 49 | set u2 [string map {< < > > " \" & &} $url] |
| 9e0da27… | drh | 50 | if {![info exists seen($u2)]} { |
| a106404… | drh | 51 | set pending($u2) 1 |
| 9e0da27… | drh | 52 | set seen($u2) 1 |
| a106404… | drh | 53 | incr npending |
| 9e0da27… | drh | 54 | } |
| 9e0da27… | drh | 55 | set x $tail |
| 9e0da27… | drh | 56 | } |
| 9e0da27… | drh | 57 | } |