1#! /usr/bin/env tclkit 2 3# Test script to do 100,000 adds/mods/dels of strings in a bytes prop field. 4# The changes are also applied to a list and compared regularly to make sure 5# that the stored data matches exactly what the mirror list contains. 6# 7# This was an attempt to track down a problem reported for 2.4.4, but no 8# problem was found with this script. 9# 10# Output: 11# 12# 0: 0 rows, 0 b C==========C==========C==========C========== 13# 4000: 774 rows, 820166 b C==========C==========C==========C========== 14# 8000: 1596 rows, 1724131 b C==========C==========C==========C========== 15# 12000: 2381 rows, 1940124 b C==========C==========C==========C========== 16# 16000: 3225 rows, 2453683 b C==========C==========C==========C========== 17# 20000: 4063 rows, 2830557 b C==========C==========C==========C========== 18# 24000: 4810 rows, 3273064 b C==========C==========C==========C========== 19# 28000: 5599 rows, 3730358 b C==========C==========C==========C========== 20# 32000: 6381 rows, 4136253 b C==========C==========C==========C========== 21# 36000: 7200 rows, 4591425 b C==========C==========C==========C========== 22# 40000: 8017 rows, 5117372 b C==========C==========C==========C========== 23# 44000: 8844 rows, 5579832 b C==========C==========C==========C========== 24# 48000: 9640 rows, 6071057 b C==========C==========C==========C========== 25# 52000: 9997 rows, 7158289 b C==========C==========C==========C========== 26# 56000: 9999 rows, 7821411 b C==========C==========C==========C========== 27# 60000: 9999 rows, 8251942 b C==========C==========C==========C========== 28# 64000: 9999 rows, 8560813 b C==========C==========C==========C========== 29# 68000: 10000 rows, 8781565 b C==========C==========C==========C========== 30# 72000: 10003 rows, 8910941 b C==========C==========C==========C========== 31# 76000: 10000 rows, 8975682 b C==========C==========C==========C========== 32# 80000: 9995 rows, 8975682 b C==========C==========C==========C========== 33# 84000: 10002 rows, 8975682 b C==========C==========C==========C========== 34# 88000: 9997 rows, 8975682 b C==========C==========C==========C========== 35# 92000: 10000 rows, 8975682 b C==========C==========C==========C========== 36# 96000: 10002 rows, 8975682 b C==========C==========C==========C========== 37# Done. 38# 39# -jcw, 29-4-2002 40 41if {[catch {load "" Mk4tcl}]} { load ./Mk4tcl.so Mk4tcl } 42 43# returns a random integer less than the specified limit 44proc rand {limit} { 45 return [expr {int(rand() * $limit)}] 46} 47 48# returns true a certain percentage of the time 49proc onavg {percent} { 50 return [expr {rand() * 100 < $percent}] 51} 52 53# use the same random sequence each time around 54expr {srand(1234567)} 55 56# make sure the rand function works 57if 0 { 58 foreach x {a a a a a a a a a a a a a a a a a a a a} { 59 foreach y {a a a a a a a a a a a a a a a a a a a a} { 60 puts -nonewline [rand 10] 61 puts -nonewline [rand 10] 62 puts -nonewline [rand 10] 63 } 64 puts "" 65 } 66 puts "" 67 foreach x {a a a a a a a a a a a a a a a a a a a a} { 68 foreach y {a a a a a a a a a a a a a a a a a a a a} { 69 puts -nonewline [onavg 10] 70 puts -nonewline [onavg 10] 71 puts -nonewline [onavg 10] 72 } 73 puts "" 74 } 75 exit 76} 77 78file delete data.mk 79mk::file open db data.mk -nocommit 80mk::view layout db.v d:B 81 82set mirror {} 83 84set desiredsize 10000 ;# rows 85set minlength 90 ;# bytes 86set maxlength 1100 ;# bytes 87set emptypct 3 ;# percent 88set commitfreq 1000 ;# count 89set checkfreq 100 ;# count 90set displayfreq 4000 ;# count 91set runcount 100000 ;# count 92 93fconfigure stdout -buffering none 94 95set x 10000000 96 97for {set i 0} {$i < $runcount} {incr i} { 98 set n [llength $mirror] 99 if {[expr {$i % $displayfreq == 0}]} { 100 puts -nonewline [format "\n%7d: %6d rows, %8d b " \ 101 $i [mk::view size db.v] [file size data.mk]] 102 } 103 if {[expr {$i % $commitfreq == 0}]} { 104 puts -nonewline C 105 mk::file commit db 106 } 107 if {[expr {$i % $checkfreq == 0}]} { 108 puts -nonewline = 109 if {[mk::view size db.v] != $n} { 110 puts "\n### $i: wrong size [mk::view size db.v] != $n" 111 error mismatch 112 } 113 for {set j 0} {$j < $n} {incr j} { 114 if {[mk::get db.v!$j d] != [lindex $mirror $j]} { 115 puts "\n### $i: mismatch [mk::get db.v!$j d] != [lindex $mirror $j]" 116 error mismatch 117 } 118 } 119 } 120 121 # under 100 rows just add items 122 set a [expr {$n < 100 ? 0 : [rand 5]}] 123 124 # boundary cases 1 and 3 may become adds or deletes to reach desired size 125 switch $a { 126 1 { set a [expr {$n < $desiredsize ? 0 : 2}] } 127 3 { set a [expr {$n > $desiredsize ? 4 : 2}] } 128 } 129 130 # construct a test data value of the specified size 131 set l [expr {int(rand() * ($maxlength - $minlength)) + $minlength - 10}] 132 set t "[incr x]: [string repeat . $l]" 133 if {[onavg $emptypct]} { set t "" } 134 135 # randomly pick an existing row to modify 136 set p [rand $n] 137 138 # now make the change, to the mirror data list and to the view 139 switch $a { 140 0 { # add 141 lappend mirror $t 142 mk::row append db.v d $t 143 } 144 2 { # modify 145 lset mirror $p $t 146 mk::set db.v!$p d $t 147 } 148 4 { # delete 149 set mirror [lreplace $mirror $p $p] 150 mk::row delete db.v!$p 151 } 152 } 153} 154 155puts "\nDone." 156