Artifact ba01105cd099ba556e6a9131bad4f90fe88b73c7:
File
test/tester.tcl
part of check-in
[36b96b8616]
- Rework the merge algorithm. It now only works for text files. But,
it no longer gets confused by line endings (\r\n versus \n) and it
reports conflicts.
by
drh on
2007-11-16 20:42:31.
Also file
test/tester.tcl
part of check-in
[d0305b305a]
- Merged mainline into my branch to get the newest application.
by
aku on
2007-12-05 08:07:46.
0000: 23 0a 23 20 43 6f 70 79 72 69 67 68 74 20 28 63 #.# Copyright (c
0010: 29 20 32 30 30 36 20 44 2e 20 52 69 63 68 61 72 ) 2006 D. Richar
0020: 64 20 48 69 70 70 0a 23 0a 23 20 54 68 69 73 20 d Hipp.#.# This
0030: 70 72 6f 67 72 61 6d 20 69 73 20 66 72 65 65 20 program is free
0040: 73 6f 66 74 77 61 72 65 3b 20 79 6f 75 20 63 61 software; you ca
0050: 6e 20 72 65 64 69 73 74 72 69 62 75 74 65 20 69 n redistribute i
0060: 74 20 61 6e 64 2f 6f 72 0a 23 20 6d 6f 64 69 66 t and/or.# modif
0070: 79 20 69 74 20 75 6e 64 65 72 20 74 68 65 20 74 y it under the t
0080: 65 72 6d 73 20 6f 66 20 74 68 65 20 47 4e 55 20 erms of the GNU
0090: 47 65 6e 65 72 61 6c 20 50 75 62 6c 69 63 0a 23 General Public.#
00a0: 20 4c 69 63 65 6e 73 65 20 76 65 72 73 69 6f 6e License version
00b0: 20 32 20 61 73 20 70 75 62 6c 69 73 68 65 64 20 2 as published
00c0: 62 79 20 74 68 65 20 46 72 65 65 20 53 6f 66 74 by the Free Soft
00d0: 77 61 72 65 20 46 6f 75 6e 64 61 74 69 6f 6e 2e ware Foundation.
00e0: 0a 23 0a 23 20 54 68 69 73 20 70 72 6f 67 72 61 .#.# This progra
00f0: 6d 20 69 73 20 64 69 73 74 72 69 62 75 74 65 64 m is distributed
0100: 20 69 6e 20 74 68 65 20 68 6f 70 65 20 74 68 61 in the hope tha
0110: 74 20 69 74 20 77 69 6c 6c 20 62 65 20 75 73 65 t it will be use
0120: 66 75 6c 2c 0a 23 20 62 75 74 20 57 49 54 48 4f ful,.# but WITHO
0130: 55 54 20 41 4e 59 20 57 41 52 52 41 4e 54 59 3b UT ANY WARRANTY;
0140: 20 77 69 74 68 6f 75 74 20 65 76 65 6e 20 74 68 without even th
0150: 65 20 69 6d 70 6c 69 65 64 20 77 61 72 72 61 6e e implied warran
0160: 74 79 20 6f 66 0a 23 20 4d 45 52 43 48 41 4e 54 ty of.# MERCHANT
0170: 41 42 49 4c 49 54 59 20 6f 72 20 46 49 54 4e 45 ABILITY or FITNE
0180: 53 53 20 46 4f 52 20 41 20 50 41 52 54 49 43 55 SS FOR A PARTICU
0190: 4c 41 52 20 50 55 52 50 4f 53 45 2e 20 20 53 65 LAR PURPOSE. Se
01a0: 65 20 74 68 65 20 47 4e 55 0a 23 20 47 65 6e 65 e the GNU.# Gene
01b0: 72 61 6c 20 50 75 62 6c 69 63 20 4c 69 63 65 6e ral Public Licen
01c0: 73 65 20 66 6f 72 20 6d 6f 72 65 20 64 65 74 61 se for more deta
01d0: 69 6c 73 2e 0a 23 20 0a 23 20 59 6f 75 20 73 68 ils..# .# You sh
01e0: 6f 75 6c 64 20 68 61 76 65 20 72 65 63 65 69 76 ould have receiv
01f0: 65 64 20 61 20 63 6f 70 79 20 6f 66 20 74 68 65 ed a copy of the
0200: 20 47 4e 55 20 47 65 6e 65 72 61 6c 20 50 75 62 GNU General Pub
0210: 6c 69 63 0a 23 20 4c 69 63 65 6e 73 65 20 61 6c lic.# License al
0220: 6f 6e 67 20 77 69 74 68 20 74 68 69 73 20 6c 69 ong with this li
0230: 62 72 61 72 79 3b 20 69 66 20 6e 6f 74 2c 20 77 brary; if not, w
0240: 72 69 74 65 20 74 6f 20 74 68 65 0a 23 20 46 72 rite to the.# Fr
0250: 65 65 20 53 6f 66 74 77 61 72 65 20 46 6f 75 6e ee Software Foun
0260: 64 61 74 69 6f 6e 2c 20 49 6e 63 2e 2c 20 35 39 dation, Inc., 59
0270: 20 54 65 6d 70 6c 65 20 50 6c 61 63 65 20 2d 20 Temple Place -
0280: 53 75 69 74 65 20 33 33 30 2c 0a 23 20 42 6f 73 Suite 330,.# Bos
0290: 74 6f 6e 2c 20 4d 41 20 20 30 32 31 31 31 2d 31 ton, MA 02111-1
02a0: 33 30 37 2c 20 55 53 41 2e 0a 23 0a 23 20 41 75 307, USA..#.# Au
02b0: 74 68 6f 72 20 63 6f 6e 74 61 63 74 20 69 6e 66 thor contact inf
02c0: 6f 72 6d 61 74 69 6f 6e 3a 0a 23 20 20 20 64 72 ormation:.# dr
02d0: 68 40 68 77 61 63 69 2e 63 6f 6d 0a 23 20 20 20 h@hwaci.com.#
02e0: 68 74 74 70 3a 2f 2f 77 77 77 2e 68 77 61 63 69 http://www.hwaci
02f0: 2e 63 6f 6d 2f 64 72 68 2f 0a 23 0a 23 23 23 23 .com/drh/.#.####
0300: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
0310: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
0320: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
0330: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
0340: 23 23 23 23 23 23 23 23 0a 23 0a 23 20 54 68 69 ########.#.# Thi
0350: 73 20 69 73 20 74 68 65 20 6d 61 69 6e 20 74 65 s is the main te
0360: 73 74 20 73 63 72 69 70 74 2e 20 20 54 6f 20 72 st script. To r
0370: 75 6e 20 61 20 72 65 67 72 65 73 73 69 6f 6e 20 un a regression
0380: 74 65 73 74 2c 20 64 6f 20 74 68 69 73 3a 0a 23 test, do this:.#
0390: 0a 23 20 20 20 20 20 74 63 6c 73 68 20 2e 2e 2f .# tclsh ../
03a0: 74 65 73 74 2f 74 65 73 74 65 72 2e 74 63 6c 20 test/tester.tcl
03b0: 2e 2e 2f 62 6c 64 2f 66 6f 73 73 69 6c 0a 23 0a ../bld/fossil.#.
03c0: 23 20 57 68 65 72 65 20 2e 2e 2f 74 65 73 74 2f # Where ../test/
03d0: 74 65 73 74 65 72 2e 74 63 6c 20 69 73 20 74 68 tester.tcl is th
03e0: 65 20 6e 61 6d 65 20 6f 66 20 74 68 69 73 20 66 e name of this f
03f0: 69 6c 65 20 61 6e 64 20 2e 2e 2f 62 6c 64 2f 66 ile and ../bld/f
0400: 6f 73 73 69 6c 0a 23 20 69 73 20 74 68 65 20 6e ossil.# is the n
0410: 61 6d 65 20 6f 66 20 74 68 65 20 65 78 65 63 75 ame of the execu
0420: 74 61 62 6c 65 20 74 6f 20 62 65 20 74 65 73 74 table to be test
0430: 65 64 2e 0a 23 0a 0a 73 65 74 20 74 65 73 74 64 ed..#..set testd
0440: 69 72 20 5b 66 69 6c 65 20 6e 6f 72 6d 61 6c 69 ir [file normali
0450: 7a 65 20 5b 66 69 6c 65 20 64 69 72 20 24 61 72 ze [file dir $ar
0460: 67 76 30 5d 5d 0a 73 65 74 20 66 6f 73 73 69 6c gv0]].set fossil
0470: 65 78 65 20 5b 66 69 6c 65 20 6e 6f 72 6d 61 6c exe [file normal
0480: 69 7a 65 20 5b 6c 69 6e 64 65 78 20 24 61 72 67 ize [lindex $arg
0490: 76 20 30 5d 5d 0a 73 65 74 20 61 72 67 76 20 5b v 0]].set argv [
04a0: 6c 72 61 6e 67 65 20 24 61 72 67 76 20 31 20 65 lrange $argv 1 e
04b0: 6e 64 5d 0a 0a 73 65 74 20 69 20 5b 6c 73 65 61 nd]..set i [lsea
04c0: 72 63 68 20 24 61 72 67 76 20 2d 68 61 6c 74 5d rch $argv -halt]
04d0: 0a 69 66 20 7b 24 69 3e 3d 30 7d 20 7b 0a 20 20 .if {$i>=0} {.
04e0: 73 65 74 20 48 41 4c 54 20 31 0a 20 20 73 65 74 set HALT 1. set
04f0: 20 61 72 67 76 20 5b 6c 72 65 70 6c 61 63 65 20 argv [lreplace
0500: 24 61 72 67 76 20 24 69 20 24 69 5d 0a 7d 20 65 $argv $i $i].} e
0510: 6c 73 65 20 7b 0a 20 20 73 65 74 20 48 41 4c 54 lse {. set HALT
0520: 20 30 0a 7d 0a 0a 69 66 20 7b 5b 6c 6c 65 6e 67 0.}..if {[lleng
0530: 74 68 20 24 61 72 67 76 5d 3d 3d 30 7d 20 7b 0a th $argv]==0} {.
0540: 20 20 66 6f 72 65 61 63 68 20 66 20 5b 6c 73 6f foreach f [lso
0550: 72 74 20 5b 67 6c 6f 62 20 24 74 65 73 74 64 69 rt [glob $testdi
0560: 72 2f 2a 2e 74 65 73 74 5d 5d 20 7b 0a 20 20 20 r/*.test]] {.
0570: 20 73 65 74 20 62 61 73 65 20 5b 66 69 6c 65 20 set base [file
0580: 72 6f 6f 74 20 5b 66 69 6c 65 20 74 61 69 6c 20 root [file tail
0590: 24 66 5d 5d 0a 20 20 20 20 6c 61 70 70 65 6e 64 $f]]. lappend
05a0: 20 61 72 67 76 20 24 62 61 73 65 0a 20 20 7d 0a argv $base. }.
05b0: 7d 0a 0a 23 20 52 75 6e 20 74 68 65 20 66 6f 73 }..# Run the fos
05c0: 73 69 6c 20 70 72 6f 67 72 61 6d 0a 23 0a 70 72 sil program.#.pr
05d0: 6f 63 20 66 6f 73 73 69 6c 20 7b 61 72 67 73 7d oc fossil {args}
05e0: 20 7b 0a 20 20 67 6c 6f 62 61 6c 20 66 6f 73 73 {. global foss
05f0: 69 6c 65 78 65 0a 20 20 73 65 74 20 63 6d 64 20 ilexe. set cmd
0600: 24 66 6f 73 73 69 6c 65 78 65 0a 20 20 66 6f 72 $fossilexe. for
0610: 65 61 63 68 20 61 20 24 61 72 67 73 20 7b 0a 20 each a $args {.
0620: 20 20 20 6c 61 70 70 65 6e 64 20 63 6d 64 20 24 lappend cmd $
0630: 61 0a 20 20 7d 0a 20 20 70 75 74 73 20 24 63 6d a. }. puts $cm
0640: 64 0a 20 20 66 6c 75 73 68 20 73 74 64 6f 75 74 d. flush stdout
0650: 0a 20 20 73 65 74 20 72 63 20 5b 63 61 74 63 68 . set rc [catch
0660: 20 7b 65 76 61 6c 20 65 78 65 63 20 24 63 6d 64 {eval exec $cmd
0670: 7d 20 72 65 73 75 6c 74 5d 0a 20 20 67 6c 6f 62 } result]. glob
0680: 61 6c 20 52 45 53 55 4c 54 20 43 4f 44 45 0a 20 al RESULT CODE.
0690: 20 73 65 74 20 43 4f 44 45 20 24 72 63 0a 20 20 set CODE $rc.
06a0: 73 65 74 20 52 45 53 55 4c 54 20 24 72 65 73 75 set RESULT $resu
06b0: 6c 74 0a 7d 0a 0a 23 20 52 65 61 64 20 61 20 66 lt.}..# Read a f
06c0: 69 6c 65 20 69 6e 74 6f 20 6d 65 6d 6f 72 79 2e ile into memory.
06d0: 20 0a 23 0a 70 72 6f 63 20 72 65 61 64 5f 66 69 .#.proc read_fi
06e0: 6c 65 20 7b 66 69 6c 65 6e 61 6d 65 7d 20 7b 0a le {filename} {.
06f0: 20 20 73 65 74 20 69 6e 20 5b 6f 70 65 6e 20 24 set in [open $
0700: 66 69 6c 65 6e 61 6d 65 20 72 5d 0a 20 20 66 63 filename r]. fc
0710: 6f 6e 66 69 67 75 72 65 20 24 69 6e 20 2d 74 72 onfigure $in -tr
0720: 61 6e 73 6c 61 74 69 6f 6e 20 62 69 6e 61 72 79 anslation binary
0730: 0a 20 20 73 65 74 20 74 78 74 20 5b 72 65 61 64 . set txt [read
0740: 20 24 69 6e 20 5b 66 69 6c 65 20 73 69 7a 65 20 $in [file size
0750: 24 66 69 6c 65 6e 61 6d 65 5d 5d 0a 20 20 63 6c $filename]]. cl
0760: 6f 73 65 20 24 69 6e 0a 20 20 72 65 74 75 72 6e ose $in. return
0770: 20 24 74 78 74 0a 7d 0a 0a 23 20 57 72 69 74 65 $txt.}..# Write
0780: 20 61 20 66 69 6c 65 20 74 6f 20 64 69 73 6b 0a a file to disk.
0790: 23 0a 70 72 6f 63 20 77 72 69 74 65 5f 66 69 6c #.proc write_fil
07a0: 65 20 7b 66 69 6c 65 6e 61 6d 65 20 74 78 74 7d e {filename txt}
07b0: 20 7b 0a 20 20 73 65 74 20 6f 75 74 20 5b 6f 70 {. set out [op
07c0: 65 6e 20 24 66 69 6c 65 6e 61 6d 65 20 77 5d 0a en $filename w].
07d0: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 6f 75 fconfigure $ou
07e0: 74 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 62 t -translation b
07f0: 69 6e 61 72 79 0a 20 20 70 75 74 73 20 2d 6e 6f inary. puts -no
0800: 6e 65 77 6c 69 6e 65 20 24 6f 75 74 20 24 74 78 newline $out $tx
0810: 74 0a 20 20 63 6c 6f 73 65 20 24 6f 75 74 0a 7d t. close $out.}
0820: 0a 70 72 6f 63 20 77 72 69 74 65 5f 66 69 6c 65 .proc write_file
0830: 5f 69 6e 64 65 6e 74 65 64 20 7b 66 69 6c 65 6e _indented {filen
0840: 61 6d 65 20 74 78 74 7d 20 7b 0a 20 20 77 72 69 ame txt} {. wri
0850: 74 65 5f 66 69 6c 65 20 24 66 69 6c 65 6e 61 6d te_file $filenam
0860: 65 20 5b 73 74 72 69 6e 67 20 74 72 69 6d 20 5b e [string trim [
0870: 73 74 72 69 6e 67 20 6d 61 70 20 5b 6c 69 73 74 string map [list
0880: 20 22 5c 6e 20 20 22 20 5c 6e 5d 20 24 74 78 74 "\n " \n] $txt
0890: 5d 5d 5c 6e 0a 7d 0a 0a 23 20 52 65 74 75 72 6e ]]\n.}..# Return
08a0: 20 74 72 75 65 20 69 66 20 74 77 6f 20 66 69 6c true if two fil
08b0: 65 73 20 61 72 65 20 74 68 65 20 73 61 6d 65 0a es are the same.
08c0: 23 0a 70 72 6f 63 20 73 61 6d 65 5f 66 69 6c 65 #.proc same_file
08d0: 20 7b 61 20 62 7d 20 7b 0a 20 20 73 65 74 20 78 {a b} {. set x
08e0: 20 5b 72 65 61 64 5f 66 69 6c 65 20 24 61 5d 0a [read_file $a].
08f0: 20 20 72 65 67 73 75 62 20 2d 61 6c 6c 20 7b 20 regsub -all {
0900: 2b 5c 6e 7d 20 24 78 20 5c 6e 20 78 0a 20 20 73 +\n} $x \n x. s
0910: 65 74 20 79 20 5b 72 65 61 64 5f 66 69 6c 65 20 et y [read_file
0920: 24 62 5d 0a 20 20 72 65 67 73 75 62 20 2d 61 6c $b]. regsub -al
0930: 6c 20 7b 20 2b 5c 6e 7d 20 24 79 20 5c 6e 20 79 l { +\n} $y \n y
0940: 0a 20 20 72 65 74 75 72 6e 20 5b 65 78 70 72 20 . return [expr
0950: 7b 24 78 3d 3d 24 79 7d 5d 0a 7d 0a 0a 23 20 50 {$x==$y}].}..# P
0960: 65 72 66 6f 72 6d 20 61 20 74 65 73 74 0a 23 0a erform a test.#.
0970: 70 72 6f 63 20 74 65 73 74 20 7b 6e 61 6d 65 20 proc test {name
0980: 65 78 70 72 7d 20 7b 0a 20 20 67 6c 6f 62 61 6c expr} {. global
0990: 20 62 61 64 5f 74 65 73 74 0a 20 20 73 65 74 20 bad_test. set
09a0: 72 20 5b 75 70 6c 65 76 65 6c 20 31 20 5b 6c 69 r [uplevel 1 [li
09b0: 73 74 20 65 78 70 72 20 24 65 78 70 72 5d 5d 0a st expr $expr]].
09c0: 20 20 69 66 20 7b 24 72 7d 20 7b 0a 20 20 20 20 if {$r} {.
09d0: 70 75 74 73 20 22 74 65 73 74 20 24 6e 61 6d 65 puts "test $name
09e0: 20 4f 4b 22 0a 20 20 7d 20 65 6c 73 65 20 7b 0a OK". } else {.
09f0: 20 20 20 20 70 75 74 73 20 22 74 65 73 74 20 24 puts "test $
0a00: 6e 61 6d 65 20 46 41 49 4c 45 44 21 22 0a 20 20 name FAILED!".
0a10: 20 20 6c 61 70 70 65 6e 64 20 62 61 64 5f 74 65 lappend bad_te
0a20: 73 74 20 24 6e 61 6d 65 0a 20 20 20 20 69 66 20 st $name. if
0a30: 7b 24 3a 3a 48 41 4c 54 7d 20 65 78 69 74 0a 20 {$::HALT} exit.
0a40: 20 7d 0a 7d 0a 73 65 74 20 62 61 64 5f 74 65 73 }.}.set bad_tes
0a50: 74 20 7b 7d 0a 0a 23 20 52 65 74 75 72 6e 20 61 t {}..# Return a
0a60: 20 72 61 6e 64 6f 6d 20 73 74 72 69 6e 67 20 4e random string N
0a70: 20 63 68 61 72 61 63 74 65 72 73 20 6c 6f 6e 67 characters long
0a80: 2e 0a 23 0a 73 65 74 20 76 6f 63 61 62 75 6c 61 ..#.set vocabula
0a90: 72 79 20 30 31 32 33 34 35 36 37 38 39 30 61 62 ry 01234567890ab
0aa0: 63 64 65 66 67 68 69 6a 6b 6c 6d 6e 6f 70 71 72 cdefghijklmnopqr
0ab0: 73 74 75 76 77 78 79 7a 41 42 43 44 45 46 47 48 stuvwxyzABCDEFGH
0ac0: 49 4a 4b 4c 4d 4e 4f 50 51 52 53 54 55 56 57 58 IJKLMNOPQRSTUVWX
0ad0: 59 5a 22 0a 61 70 70 65 6e 64 20 76 6f 63 61 62 YZ".append vocab
0ae0: 75 6c 61 72 79 20 22 20 20 20 20 20 20 20 28 29 ulary " ()
0af0: 2a 5e 21 2e 65 65 65 65 65 65 65 65 61 61 61 61 *^!.eeeeeeeeaaaa
0b00: 61 74 74 69 69 6f 6f 20 20 20 22 0a 73 65 74 20 attiioo ".set
0b10: 6e 76 6f 63 61 62 75 6c 61 72 79 20 5b 73 74 72 nvocabulary [str
0b20: 69 6e 67 20 6c 65 6e 67 74 68 20 24 76 6f 63 61 ing length $voca
0b30: 62 75 6c 61 72 79 5d 0a 70 72 6f 63 20 72 61 6e bulary].proc ran
0b40: 64 5f 73 74 72 20 7b 4e 7d 20 7b 0a 20 20 67 6c d_str {N} {. gl
0b50: 6f 62 61 6c 20 76 6f 63 61 62 75 6c 61 72 79 20 obal vocabulary
0b60: 6e 76 6f 63 61 62 75 6c 61 72 79 0a 20 20 73 65 nvocabulary. se
0b70: 74 20 6f 75 74 20 7b 7d 0a 20 20 77 68 69 6c 65 t out {}. while
0b80: 20 7b 24 4e 3e 30 7d 20 7b 0a 20 20 20 20 69 6e {$N>0} {. in
0b90: 63 72 20 4e 20 2d 31 0a 20 20 20 20 73 65 74 20 cr N -1. set
0ba0: 69 20 5b 65 78 70 72 20 7b 69 6e 74 28 72 61 6e i [expr {int(ran
0bb0: 64 28 29 2a 24 6e 76 6f 63 61 62 75 6c 61 72 79 d()*$nvocabulary
0bc0: 29 7d 5d 0a 20 20 20 20 61 70 70 65 6e 64 20 6f )}]. append o
0bd0: 75 74 20 5b 73 74 72 69 6e 67 20 69 6e 64 65 78 ut [string index
0be0: 20 24 76 6f 63 61 62 75 6c 61 72 79 20 24 69 5d $vocabulary $i]
0bf0: 0a 20 20 7d 0a 20 20 72 65 74 75 72 6e 20 24 6f . }. return $o
0c00: 75 74 0a 7d 0a 0a 23 20 4d 61 6b 65 20 72 61 6e ut.}..# Make ran
0c10: 64 6f 6d 20 63 68 61 6e 67 65 73 20 74 6f 20 61 dom changes to a
0c20: 20 66 69 6c 65 2e 0a 23 0a 23 20 54 68 65 20 66 file..#.# The f
0c30: 69 6c 65 20 69 73 20 64 69 76 69 64 65 64 20 69 ile is divided i
0c40: 6e 74 6f 20 62 6c 6f 63 6b 73 20 6f 66 20 24 62 nto blocks of $b
0c50: 6c 6f 63 6b 73 69 7a 65 20 6c 69 6e 65 73 20 65 locksize lines e
0c60: 61 63 68 2e 20 20 54 68 65 20 66 69 72 73 74 0a ach. The first.
0c70: 23 20 62 6c 6f 63 6b 20 69 73 20 6e 75 6d 62 65 # block is numbe
0c80: 72 20 30 2e 20 20 43 68 61 6e 67 65 73 20 61 72 r 0. Changes ar
0c90: 65 20 6f 6e 6c 79 20 6d 61 64 65 20 77 69 74 68 e only made with
0ca0: 69 6e 20 62 6c 6f 63 6b 73 20 77 68 65 72 65 0a in blocks where.
0cb0: 23 20 74 68 65 20 62 6c 6f 63 6b 20 6e 75 6d 62 # the block numb
0cc0: 65 72 20 64 69 76 69 64 65 64 20 62 79 20 24 63 er divided by $c
0cd0: 6f 75 6e 74 20 68 61 73 20 61 20 72 65 6d 61 69 ount has a remai
0ce0: 6e 64 65 72 20 6f 66 20 24 69 6e 64 65 78 2e 0a nder of $index..
0cf0: 23 0a 23 20 46 6f 72 20 61 6e 79 20 67 69 76 65 #.# For any give
0d00: 6e 20 6c 69 6e 65 20 74 68 61 74 20 6d 65 74 73 n line that mets
0d10: 20 74 68 65 20 62 6c 6f 63 6b 20 63 6f 75 6e 74 the block count
0d20: 20 63 72 69 74 65 72 69 61 2c 20 74 68 65 20 70 criteria, the p
0d30: 72 6f 62 61 62 6c 79 0a 23 20 6f 66 20 61 20 63 robably.# of a c
0d40: 68 61 6e 67 65 20 69 73 20 24 70 72 6f 62 0a 23 hange is $prob.#
0d50: 0a 23 20 43 68 61 6e 67 65 73 20 64 6f 20 6e 6f .# Changes do no
0d60: 74 20 61 64 64 20 6f 72 20 72 65 6d 6f 76 65 20 t add or remove
0d70: 6e 65 77 6c 69 6e 65 73 0a 23 0a 70 72 6f 63 20 newlines.#.proc
0d80: 72 61 6e 64 6f 6d 5f 63 68 61 6e 67 65 73 20 7b random_changes {
0d90: 62 6f 64 79 20 62 6c 6f 63 6b 73 69 7a 65 20 63 body blocksize c
0da0: 6f 75 6e 74 20 69 6e 64 65 78 20 70 72 6f 62 7d ount index prob}
0db0: 20 7b 0a 20 20 73 65 74 20 6f 75 74 20 7b 7d 0a {. set out {}.
0dc0: 20 20 73 65 74 20 62 6c 6f 63 6b 6e 6f 20 30 0a set blockno 0.
0dd0: 20 20 73 65 74 20 6c 69 6e 65 6e 6f 20 2d 31 0a set lineno -1.
0de0: 20 20 66 6f 72 65 61 63 68 20 6c 69 6e 65 20 5b foreach line [
0df0: 73 70 6c 69 74 20 24 62 6f 64 79 20 5c 6e 5d 20 split $body \n]
0e00: 7b 0a 20 20 20 20 69 6e 63 72 20 6c 69 6e 65 6e {. incr linen
0e10: 6f 0a 20 20 20 20 69 66 20 7b 24 6c 69 6e 65 6e o. if {$linen
0e20: 6f 3d 3d 24 62 6c 6f 63 6b 73 69 7a 65 7d 20 7b o==$blocksize} {
0e30: 0a 20 20 20 20 20 20 69 6e 63 72 20 62 6c 6f 63 . incr bloc
0e40: 6b 6e 6f 0a 20 20 20 20 20 20 73 65 74 20 6c 69 kno. set li
0e50: 6e 65 6e 6f 20 30 0a 20 20 20 20 7d 0a 20 20 20 neno 0. }.
0e60: 20 69 66 20 7b 24 62 6c 6f 63 6b 6e 6f 25 24 63 if {$blockno%$c
0e70: 6f 75 6e 74 3d 3d 24 69 6e 64 65 78 20 26 26 20 ount==$index &&
0e80: 72 61 6e 64 28 29 3c 24 70 72 6f 62 7d 20 7b 0a rand()<$prob} {.
0e90: 20 20 20 20 20 20 73 65 74 20 6e 20 5b 73 74 72 set n [str
0ea0: 69 6e 67 20 6c 65 6e 67 74 68 20 24 6c 69 6e 65 ing length $line
0eb0: 5d 0a 20 20 20 20 20 20 69 66 20 7b 24 6e 3e 35 ]. if {$n>5
0ec0: 20 26 26 20 72 61 6e 64 28 29 3c 30 2e 35 7d 20 && rand()<0.5}
0ed0: 7b 0a 20 20 20 20 20 20 20 20 23 20 64 65 6c 65 {. # dele
0ee0: 74 65 20 70 61 72 74 20 6f 66 20 74 68 65 20 6c te part of the l
0ef0: 69 6e 65 0a 20 20 20 20 20 20 20 20 73 65 74 20 ine. set
0f00: 6e 20 5b 65 78 70 72 20 7b 69 6e 74 28 72 61 6e n [expr {int(ran
0f10: 64 28 29 2a 24 6e 29 7d 5d 0a 20 20 20 20 20 20 d()*$n)}].
0f20: 20 20 73 65 74 20 69 20 5b 65 78 70 72 20 7b 69 set i [expr {i
0f30: 6e 74 28 72 61 6e 64 28 29 2a 24 6e 29 7d 5d 0a nt(rand()*$n)}].
0f40: 20 20 20 20 20 20 20 20 73 65 74 20 6b 20 5b 65 set k [e
0f50: 78 70 72 20 7b 24 69 2b 24 6e 7d 5d 0a 20 20 20 xpr {$i+$n}].
0f60: 20 20 20 20 20 73 65 74 20 6c 69 6e 65 20 5b 73 set line [s
0f70: 74 72 69 6e 67 20 72 61 6e 67 65 20 24 6c 69 6e tring range $lin
0f80: 65 20 30 20 24 69 5d 5b 73 74 72 69 6e 67 20 72 e 0 $i][string r
0f90: 61 6e 67 65 20 24 6c 69 6e 65 20 24 6b 20 65 6e ange $line $k en
0fa0: 64 5d 0a 20 20 20 20 20 20 7d 20 65 6c 73 65 20 d]. } else
0fb0: 7b 0a 20 20 20 20 20 20 20 20 23 20 69 6e 73 65 {. # inse
0fc0: 72 74 20 73 6f 6d 65 74 68 69 6e 67 20 69 6e 74 rt something int
0fd0: 6f 20 74 68 65 20 6c 69 6e 65 0a 20 20 20 20 20 o the line.
0fe0: 20 20 20 73 65 74 20 73 74 75 66 66 20 5b 72 61 set stuff [ra
0ff0: 6e 64 5f 73 74 72 20 5b 65 78 70 72 20 7b 69 6e nd_str [expr {in
1000: 74 28 72 61 6e 64 28 29 2a 28 24 6e 2d 35 29 29 t(rand()*($n-5))
1010: 2d 31 7d 5d 5d 0a 20 20 20 20 20 20 20 20 73 65 -1}]]. se
1020: 74 20 69 20 5b 65 78 70 72 20 7b 69 6e 74 28 72 t i [expr {int(r
1030: 61 6e 64 28 29 2a 24 6e 29 7d 5d 0a 20 20 20 20 and()*$n)}].
1040: 20 20 20 20 73 65 74 20 69 70 31 20 5b 65 78 70 set ip1 [exp
1050: 72 20 7b 24 69 2b 31 7d 5d 0a 20 20 20 20 20 20 r {$i+1}].
1060: 20 20 73 65 74 20 6c 69 6e 65 20 5b 73 74 72 69 set line [stri
1070: 6e 67 20 72 61 6e 67 65 20 24 6c 69 6e 65 20 30 ng range $line 0
1080: 20 24 69 5d 24 73 74 75 66 66 5b 73 74 72 69 6e $i]$stuff[strin
1090: 67 20 72 61 6e 67 65 20 24 6c 69 6e 65 20 24 69 g range $line $i
10a0: 70 31 20 65 6e 64 5d 0a 20 20 20 20 20 20 7d 0a p1 end]. }.
10b0: 20 20 20 20 7d 0a 20 20 20 20 61 70 70 65 6e 64 }. append
10c0: 20 6f 75 74 20 5c 6e 24 6c 69 6e 65 0a 20 20 7d out \n$line. }
10d0: 0a 20 20 72 65 74 75 72 6e 20 5b 73 74 72 69 6e . return [strin
10e0: 67 20 72 61 6e 67 65 20 24 6f 75 74 20 31 20 65 g range $out 1 e
10f0: 6e 64 5d 0a 7d 0a 0a 66 6f 72 65 61 63 68 20 74 nd].}..foreach t
1100: 65 73 74 66 69 6c 65 20 24 61 72 67 76 20 7b 0a estfile $argv {.
1110: 20 20 70 75 74 73 20 22 2a 2a 2a 2a 2a 20 24 74 puts "***** $t
1120: 65 73 74 66 69 6c 65 20 2a 2a 2a 2a 2a 2a 22 0a estfile ******".
1130: 20 20 73 6f 75 72 63 65 20 24 74 65 73 74 64 69 source $testdi
1140: 72 2f 24 74 65 73 74 66 69 6c 65 2e 74 65 73 74 r/$testfile.test
1150: 0a 7d 0a 70 75 74 73 20 22 5b 6c 6c 65 6e 67 74 .}.puts "[llengt
1160: 68 20 24 62 61 64 5f 74 65 73 74 5d 20 65 72 72 h $bad_test] err
1170: 6f 72 73 3a 20 24 62 61 64 5f 74 65 73 74 22 0a ors: $bad_test".