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