dbda8d6ce9 2007-07-21 drh: # dbda8d6ce9 2007-07-21 drh: # Copyright (c) 2006 D. Richard Hipp dbda8d6ce9 2007-07-21 drh: # dbda8d6ce9 2007-07-21 drh: # This program is free software; you can redistribute it and/or dbda8d6ce9 2007-07-21 drh: # modify it under the terms of the GNU General Public dbda8d6ce9 2007-07-21 drh: # License version 2 as published by the Free Software Foundation. dbda8d6ce9 2007-07-21 drh: # dbda8d6ce9 2007-07-21 drh: # This program is distributed in the hope that it will be useful, dbda8d6ce9 2007-07-21 drh: # but WITHOUT ANY WARRANTY; without even the implied warranty of dbda8d6ce9 2007-07-21 drh: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU dbda8d6ce9 2007-07-21 drh: # General Public License for more details. dbda8d6ce9 2007-07-21 drh: # dbda8d6ce9 2007-07-21 drh: # You should have received a copy of the GNU General Public dbda8d6ce9 2007-07-21 drh: # License along with this library; if not, write to the dbda8d6ce9 2007-07-21 drh: # Free Software Foundation, Inc., 59 Temple Place - Suite 330, dbda8d6ce9 2007-07-21 drh: # Boston, MA 02111-1307, USA. dbda8d6ce9 2007-07-21 drh: # dbda8d6ce9 2007-07-21 drh: # Author contact information: dbda8d6ce9 2007-07-21 drh: # drh@hwaci.com dbda8d6ce9 2007-07-21 drh: # http://www.hwaci.com/drh/ dbda8d6ce9 2007-07-21 drh: # dbda8d6ce9 2007-07-21 drh: ############################################################################ dbda8d6ce9 2007-07-21 drh: # dbda8d6ce9 2007-07-21 drh: # This is the main test script. To run a regression test, do this: dbda8d6ce9 2007-07-21 drh: # dbda8d6ce9 2007-07-21 drh: # tclsh ../test/tester.tcl ../bld/fossil dbda8d6ce9 2007-07-21 drh: # dbda8d6ce9 2007-07-21 drh: # Where ../test/tester.tcl is the name of this file and ../bld/fossil dbda8d6ce9 2007-07-21 drh: # is the name of the executable to be tested. dbda8d6ce9 2007-07-21 drh: # dbda8d6ce9 2007-07-21 drh: dbda8d6ce9 2007-07-21 drh: set testdir [file normalize [file dir $argv0]] dbda8d6ce9 2007-07-21 drh: set fossilexe [file normalize [lindex $argv 0]] dbda8d6ce9 2007-07-21 drh: set argv [lrange $argv 1 end] dbda8d6ce9 2007-07-21 drh: dbda8d6ce9 2007-07-21 drh: set i [lsearch $argv -halt] dbda8d6ce9 2007-07-21 drh: if {$i>=0} { dbda8d6ce9 2007-07-21 drh: set HALT 1 dbda8d6ce9 2007-07-21 drh: set argv [lreplace $argv $i $i] dbda8d6ce9 2007-07-21 drh: } else { dbda8d6ce9 2007-07-21 drh: set HALT 0 dbda8d6ce9 2007-07-21 drh: } dbda8d6ce9 2007-07-21 drh: dbda8d6ce9 2007-07-21 drh: if {[llength $argv]==0} { dbda8d6ce9 2007-07-21 drh: foreach f [lsort [glob $testdir/*.test]] { dbda8d6ce9 2007-07-21 drh: set base [file root [file tail $f]] dbda8d6ce9 2007-07-21 drh: lappend argv $base dbda8d6ce9 2007-07-21 drh: } dbda8d6ce9 2007-07-21 drh: } dbda8d6ce9 2007-07-21 drh: dbda8d6ce9 2007-07-21 drh: # Run the fossil program dbda8d6ce9 2007-07-21 drh: # dbda8d6ce9 2007-07-21 drh: proc fossil {args} { dbda8d6ce9 2007-07-21 drh: global fossilexe dbda8d6ce9 2007-07-21 drh: set cmd $fossilexe dbda8d6ce9 2007-07-21 drh: foreach a $args { dbda8d6ce9 2007-07-21 drh: lappend cmd $a dbda8d6ce9 2007-07-21 drh: } dbda8d6ce9 2007-07-21 drh: puts $cmd dbda8d6ce9 2007-07-21 drh: flush stdout dbda8d6ce9 2007-07-21 drh: set rc [catch {eval exec $cmd} result] dbda8d6ce9 2007-07-21 drh: global RESULT CODE dbda8d6ce9 2007-07-21 drh: set CODE $rc dbda8d6ce9 2007-07-21 drh: set RESULT $result dbda8d6ce9 2007-07-21 drh: } dbda8d6ce9 2007-07-21 drh: dbda8d6ce9 2007-07-21 drh: # Read a file into memory. dbda8d6ce9 2007-07-21 drh: # dbda8d6ce9 2007-07-21 drh: proc read_file {filename} { dbda8d6ce9 2007-07-21 drh: set in [open $filename r] dbda8d6ce9 2007-07-21 drh: fconfigure $in -translation binary dbda8d6ce9 2007-07-21 drh: set txt [read $in [file size $filename]] dbda8d6ce9 2007-07-21 drh: close $in dbda8d6ce9 2007-07-21 drh: return $txt dbda8d6ce9 2007-07-21 drh: } dbda8d6ce9 2007-07-21 drh: dbda8d6ce9 2007-07-21 drh: # Write a file to disk dbda8d6ce9 2007-07-21 drh: # dbda8d6ce9 2007-07-21 drh: proc write_file {filename txt} { dbda8d6ce9 2007-07-21 drh: set out [open $filename w] dbda8d6ce9 2007-07-21 drh: fconfigure $out -translation binary dbda8d6ce9 2007-07-21 drh: puts -nonewline $out $txt dbda8d6ce9 2007-07-21 drh: close $out dbda8d6ce9 2007-07-21 drh: } dbda8d6ce9 2007-07-21 drh: proc write_file_indented {filename txt} { dbda8d6ce9 2007-07-21 drh: write_file $filename [string trim [string map [list "\n " \n] $txt]]\n dbda8d6ce9 2007-07-21 drh: } dbda8d6ce9 2007-07-21 drh: dbda8d6ce9 2007-07-21 drh: # Return true if two files are the same dbda8d6ce9 2007-07-21 drh: # dbda8d6ce9 2007-07-21 drh: proc same_file {a b} { 36b96b8616 2007-11-16 drh: set x [read_file $a] 36b96b8616 2007-11-16 drh: regsub -all { +\n} $x \n x 36b96b8616 2007-11-16 drh: set y [read_file $b] 36b96b8616 2007-11-16 drh: regsub -all { +\n} $y \n y 36b96b8616 2007-11-16 drh: return [expr {$x==$y}] dbda8d6ce9 2007-07-21 drh: } dbda8d6ce9 2007-07-21 drh: dbda8d6ce9 2007-07-21 drh: # Perform a test dbda8d6ce9 2007-07-21 drh: # dbda8d6ce9 2007-07-21 drh: proc test {name expr} { dbda8d6ce9 2007-07-21 drh: global bad_test dbda8d6ce9 2007-07-21 drh: set r [uplevel 1 [list expr $expr]] dbda8d6ce9 2007-07-21 drh: if {$r} { dbda8d6ce9 2007-07-21 drh: puts "test $name OK" dbda8d6ce9 2007-07-21 drh: } else { dbda8d6ce9 2007-07-21 drh: puts "test $name FAILED!" dbda8d6ce9 2007-07-21 drh: lappend bad_test $name dbda8d6ce9 2007-07-21 drh: if {$::HALT} exit dbda8d6ce9 2007-07-21 drh: } dbda8d6ce9 2007-07-21 drh: } dbda8d6ce9 2007-07-21 drh: set bad_test {} dbda8d6ce9 2007-07-21 drh: dbda8d6ce9 2007-07-21 drh: # Return a random string N characters long. dbda8d6ce9 2007-07-21 drh: # dbda8d6ce9 2007-07-21 drh: set vocabulary 01234567890abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" dbda8d6ce9 2007-07-21 drh: append vocabulary " ()*^!.eeeeeeeeaaaaattiioo " dbda8d6ce9 2007-07-21 drh: set nvocabulary [string length $vocabulary] dbda8d6ce9 2007-07-21 drh: proc rand_str {N} { dbda8d6ce9 2007-07-21 drh: global vocabulary nvocabulary dbda8d6ce9 2007-07-21 drh: set out {} dbda8d6ce9 2007-07-21 drh: while {$N>0} { dbda8d6ce9 2007-07-21 drh: incr N -1 dbda8d6ce9 2007-07-21 drh: set i [expr {int(rand()*$nvocabulary)}] dbda8d6ce9 2007-07-21 drh: append out [string index $vocabulary $i] dbda8d6ce9 2007-07-21 drh: } dbda8d6ce9 2007-07-21 drh: return $out dbda8d6ce9 2007-07-21 drh: } dbda8d6ce9 2007-07-21 drh: dbda8d6ce9 2007-07-21 drh: # Make random changes to a file. dbda8d6ce9 2007-07-21 drh: # dbda8d6ce9 2007-07-21 drh: # The file is divided into blocks of $blocksize lines each. The first dbda8d6ce9 2007-07-21 drh: # block is number 0. Changes are only made within blocks where dbda8d6ce9 2007-07-21 drh: # the block number divided by $count has a remainder of $index. dbda8d6ce9 2007-07-21 drh: # dbda8d6ce9 2007-07-21 drh: # For any given line that mets the block count criteria, the probably dbda8d6ce9 2007-07-21 drh: # of a change is $prob dbda8d6ce9 2007-07-21 drh: # dbda8d6ce9 2007-07-21 drh: # Changes do not add or remove newlines dbda8d6ce9 2007-07-21 drh: # dbda8d6ce9 2007-07-21 drh: proc random_changes {body blocksize count index prob} { dbda8d6ce9 2007-07-21 drh: set out {} dbda8d6ce9 2007-07-21 drh: set blockno 0 dbda8d6ce9 2007-07-21 drh: set lineno -1 dbda8d6ce9 2007-07-21 drh: foreach line [split $body \n] { dbda8d6ce9 2007-07-21 drh: incr lineno dbda8d6ce9 2007-07-21 drh: if {$lineno==$blocksize} { dbda8d6ce9 2007-07-21 drh: incr blockno dbda8d6ce9 2007-07-21 drh: set lineno 0 dbda8d6ce9 2007-07-21 drh: } dbda8d6ce9 2007-07-21 drh: if {$blockno%$count==$index && rand()<$prob} { dbda8d6ce9 2007-07-21 drh: set n [string length $line] dbda8d6ce9 2007-07-21 drh: if {$n>5 && rand()<0.5} { dbda8d6ce9 2007-07-21 drh: # delete part of the line dbda8d6ce9 2007-07-21 drh: set n [expr {int(rand()*$n)}] dbda8d6ce9 2007-07-21 drh: set i [expr {int(rand()*$n)}] dbda8d6ce9 2007-07-21 drh: set k [expr {$i+$n}] dbda8d6ce9 2007-07-21 drh: set line [string range $line 0 $i][string range $line $k end] dbda8d6ce9 2007-07-21 drh: } else { dbda8d6ce9 2007-07-21 drh: # insert something into the line dbda8d6ce9 2007-07-21 drh: set stuff [rand_str [expr {int(rand()*($n-5))-1}]] dbda8d6ce9 2007-07-21 drh: set i [expr {int(rand()*$n)}] dbda8d6ce9 2007-07-21 drh: set ip1 [expr {$i+1}] dbda8d6ce9 2007-07-21 drh: set line [string range $line 0 $i]$stuff[string range $line $ip1 end] dbda8d6ce9 2007-07-21 drh: } dbda8d6ce9 2007-07-21 drh: } dbda8d6ce9 2007-07-21 drh: append out \n$line dbda8d6ce9 2007-07-21 drh: } dbda8d6ce9 2007-07-21 drh: return [string range $out 1 end] dbda8d6ce9 2007-07-21 drh: } dbda8d6ce9 2007-07-21 drh: dbda8d6ce9 2007-07-21 drh: foreach testfile $argv { dbda8d6ce9 2007-07-21 drh: puts "***** $testfile ******" dbda8d6ce9 2007-07-21 drh: source $testdir/$testfile.test dbda8d6ce9 2007-07-21 drh: } dbda8d6ce9 2007-07-21 drh: puts "[llength $bad_test] errors: $bad_test"
File Annotation