1#
2# 2001 September 15
3#
4# The author disclaims copyright to this source code.  In place of
5# a legal notice, here is a blessing:
6#
7#    May you do good and not evil.
8#    May you find forgiveness for yourself and forgive others.
9#    May you share freely, never taking more than you give.
10#
11#***********************************************************************
12# This file implements regression tests for SQLite library.  The
13# focus of this script is btree database backend
14#
15# $Id: btree2.test,v 1.10 2002/02/19 13:39:23 drh Exp $
16
17
18set testdir [file dirname $argv0]
19source $testdir/tester.tcl
20
21if {[info commands btree_open]!=""} {
22
23# Create a new database file containing no entries.  The database should
24# contain 5 tables:
25#
26#     2   The descriptor table
27#     3   The foreground table
28#     4   The background table
29#     5   The long key table
30#     6   The long data table
31#
32# An explanation for what all these tables are used for is provided below.
33#
34do_test btree2-1.1 {
35  expr srand(1)
36  file delete -force test2.bt
37  file delete -force test2.bt-journal
38  set ::b [btree_open test2.bt]
39  btree_begin_transaction $::b
40  btree_create_table $::b
41} {3}
42do_test btree2-1.2 {
43  btree_create_table $::b
44} {4}
45do_test btree2-1.3 {
46  btree_create_table $::b
47} {5}
48do_test btree2-1.4 {
49  btree_create_table $::b
50} {6}
51do_test btree2-1.5 {
52  set ::c2 [btree_cursor $::b 2 1]
53  btree_insert $::c2 {one} {1}
54  btree_delete $::c2
55  btree_close_cursor $::c2
56  btree_commit $::b
57  btree_integrity_check $::b 2 3 4 5 6
58} {}
59
60# This test module works by making lots of pseudo-random changes to a
61# database while simultaneously maintaining an invariant on that database.
62# Periodically, the script does a sanity check on the database and verifies
63# that the invariant is satisfied.
64#
65# The invariant is as follows:
66#
67#   1.  The descriptor table always contains 2 enters.  An entry keyed by
68#       "N" is the number of elements in the foreground and background tables
69#       combined.  The entry keyed by "L" is the number of digits in the keys
70#       for foreground and background tables.
71#
72#   2.  The union of the foreground an background tables consists of N entries
73#       where each entry an L-digit key.  (Actually, some keys can be longer
74#       than L characters, but they always start with L digits.)  The keys
75#       cover all integers between 1 and N.  Whenever an entry is added to
76#       the foreground it is removed form the background and vice versa.
77#
78#   3.  Some entries in the foreground and background tables have keys that
79#       begin with an L-digit number but are followed by additional characters.
80#       For each such entry there is a corresponding entry in the long key
81#       table.  The long key table entry has a key which is just the L-digit
82#       number and data which is the length of the key in the foreground and
83#       background tables.
84#
85#   4.  The data for both foreground and background entries is usually a
86#       short string.  But some entries have long data strings.  For each
87#       such entries there is an entry in the long data type.  The key to
88#       long data table is an L-digit number.  (The extension on long keys
89#       is omitted.)  The data is the number of charaters in the data of the
90#       foreground or background entry.
91#
92# The following function builds a database that satisfies all of the above
93# invariants.
94#
95proc build_db {N L} {
96  for {set i 2} {$i<=6} {incr i} {
97    catch {btree_close_cursor [set ::c$i]}
98    btree_clear_table $::b $i
99    set ::c$i [btree_cursor $::b $i 1]
100  }
101  btree_insert $::c2 N $N
102  btree_insert $::c2 L $L
103  set format %0${L}d
104  for {set i 1} {$i<=$N} {incr i} {
105    set key [format $format $i]
106    set data $key
107    btree_insert $::c3 $key $data
108  }
109}
110
111# Given a base key number and a length, construct the full text of the key
112# or data.
113#
114proc make_payload {keynum L len} {
115  set key [format %0${L}d $keynum]
116  set r $key
117  set i 1
118  while {[string length $r]<$len} {
119    append r " ($i) $key"
120    incr i
121  }
122  return [string range $r 0 [expr {$len-1}]]
123}
124
125# Verify the invariants on the database.  Return an empty string on
126# success or an error message if something is amiss.
127#
128proc check_invariants {} {
129  set ck [btree_integrity_check $::b 2 3 4 5 6]
130  if {$ck!=""} {
131    puts "\n*** SANITY:\n$ck"
132    exit
133    return $ck
134  }
135  btree_move_to $::c3 {}
136  btree_move_to $::c4 {}
137  btree_move_to $::c2 N
138  set N [btree_data $::c2]
139  btree_move_to $::c2 L
140  set L [btree_data $::c2]
141  set LM1 [expr {$L-1}]
142  for {set i 1} {$i<=$N} {incr i} {
143    set key [btree_key $::c3]
144    if {[scan $key %d k]<1} {set k 0}
145    if {$k!=$i} {
146      set key [btree_key $::c4]
147      if {[scan $key %d k]<1} {set k 0}
148      if {$k!=$i} {
149        # puts "MISSING $i"
150        # puts {Page 3:}; btree_page_dump $::b 3
151        # puts {Page 4:}; btree_page_dump $::b 4
152        # exit
153        return "Key $i is missing from both foreground and background"
154      }
155      set data [btree_data $::c4]
156      btree_next $::c4
157    } else {
158      set data [btree_data $::c3]
159      btree_next $::c3
160    }
161    set skey [string range $key 0 $LM1]
162    if {[btree_move_to $::c5 $skey]==0} {
163      set keylen [btree_data $::c5]
164    } else {
165      set keylen $L
166    }
167    if {[string length $key]!=$keylen} {
168      return "Key $i is the wrong size.\
169              Is \"$key\" but should be \"[make_payload $k $L $keylen]\""
170    }
171    if {[make_payload $k $L $keylen]!=$key} {
172      return "Key $i has an invalid extension"
173    }
174    if {[btree_move_to $::c6 $skey]==0} {
175      set datalen [btree_data $::c6]
176    } else {
177      set datalen $L
178    }
179    if {[string length $data]!=$datalen} {
180      return "Data for $i is the wrong size.\
181              Is [string length $data] but should be $datalen"
182    }
183    if {[make_payload $k $L $datalen]!=$data} {
184      return "Entry $i has an incorrect data"
185    }
186  }
187}
188
189# Make random changes to the database such that each change preserves
190# the invariants.  The number of changes is $n*N where N is the parameter
191# from the descriptor table.  Each changes begins with a random key.
192# the entry with that key is put in the foreground table with probability
193# $I and it is put in background with probability (1.0-$I).  It gets
194# a long key with probability $K and long data with probability $D.
195#
196set chngcnt 0
197proc random_changes {n I K D} {
198  btree_move_to $::c2 N
199  set N [btree_data $::c2]
200  btree_move_to $::c2 L
201  set L [btree_data $::c2]
202  set LM1 [expr {$L-1}]
203  set total [expr {int($N*$n)}]
204  set format %0${L}d
205  for {set i 0} {$i<$total} {incr i} {
206    set k [expr {int(rand()*$N)+1}]
207    set insert [expr {rand()<=$I}]
208    set longkey [expr {rand()<=$K}]
209    set longdata [expr {rand()<=$D}]
210    # incr ::chngcnt
211    # if {$::chngcnt==251} {btree_tree_dump $::b 3}
212    # puts "CHANGE $::chngcnt: $k $insert $longkey $longdata"
213    if {$longkey} {
214      set x [expr {rand()}]
215      set keylen [expr {int($x*$x*$x*$x*3000)+10}]
216    } else {
217      set keylen $L
218    }
219    set key [make_payload $k $L $keylen]
220    if {$longdata} {
221      set x [expr {rand()}]
222      set datalen [expr {int($x*$x*$x*$x*3000)+10}]
223    } else {
224      set datalen $L
225    }
226    set data [make_payload $k $L $datalen]
227    set basekey [format $format $k]
228    if {[set c [btree_move_to $::c3 $basekey]]==0} {
229      btree_delete $::c3
230    } else {
231      if {$c<0} {btree_next $::c3}
232      if {[string match $basekey* [btree_key $::c3]]} {
233        btree_delete $::c3
234      }
235    }
236    if {[set c [btree_move_to $::c4 $basekey]]==0} {
237      btree_delete $::c4
238    } else {
239      if {$c<0} {btree_next $::c4}
240      if {[string match $basekey* [btree_key $::c4]]} {
241        btree_delete $::c4
242      }
243    }
244    if {[scan [btree_key $::c4] %d kx]<1} {set kx -1}
245    if {$kx==$k} {
246      btree_delete $::c4
247    }
248    if {$insert} {
249      btree_insert $::c3 $key $data
250    } else {
251      btree_insert $::c4 $key $data
252    }
253    if {$longkey} {
254      btree_insert $::c5 $basekey $keylen
255    } elseif {[btree_move_to $::c5 $basekey]==0} {
256      btree_delete $::c5
257    }
258    if {$longdata} {
259      btree_insert $::c6 $basekey $datalen
260    } elseif {[btree_move_to $::c6 $basekey]==0} {
261      btree_delete $::c6
262    }
263    # set ck [btree_integrity_check $::b 2 3 4 5 6]
264    # if {$ck!=""} {
265    #   puts "\nSANITY CHECK FAILED!\n$ck"
266    #   exit
267    # }
268    # puts "PAGE 3:"; btree_page_dump $::b 3
269    # puts "PAGE 4:"; btree_page_dump $::b 4
270  }
271}
272
273# Repeat this test sequence on database of various sizes
274#
275set testno 2
276foreach {N L} {
277  10 2
278  50 2
279  200 3
280  2000 5
281} {
282  puts "**** N=$N L=$L ****"
283  set hash [md5file test2.bt]
284  do_test btree2-$testno.1 [subst -nocommands {
285    set ::c2 [btree_cursor $::b 2 1]
286    set ::c3 [btree_cursor $::b 3 1]
287    set ::c4 [btree_cursor $::b 4 1]
288    set ::c5 [btree_cursor $::b 5 1]
289    set ::c6 [btree_cursor $::b 6 1]
290    btree_begin_transaction $::b
291    build_db $N $L
292    check_invariants
293  }] {}
294  do_test btree2-$testno.2 {
295    btree_close_cursor $::c2
296    btree_close_cursor $::c3
297    btree_close_cursor $::c4
298    btree_close_cursor $::c5
299    btree_close_cursor $::c6
300    btree_rollback $::b
301    md5file test2.bt
302  } $hash
303  do_test btree2-$testno.3 [subst -nocommands {
304    btree_begin_transaction $::b
305    set ::c2 [btree_cursor $::b 2 1]
306    set ::c3 [btree_cursor $::b 3 1]
307    set ::c4 [btree_cursor $::b 4 1]
308    set ::c5 [btree_cursor $::b 5 1]
309    set ::c6 [btree_cursor $::b 6 1]
310    build_db $N $L
311    check_invariants
312  }] {}
313  do_test btree2-$testno.4 {
314    btree_commit $::b
315    check_invariants
316  } {}
317  do_test btree2-$testno.5  {
318    lindex [btree_pager_stats $::b] 1
319  } {6}
320  do_test btree2-$testno.6  {
321    btree_close_cursor $::c2
322    btree_close_cursor $::c3
323    btree_close_cursor $::c4
324    btree_close_cursor $::c5
325    btree_close_cursor $::c6
326    lindex [btree_pager_stats $::b] 1
327  } {0}
328  do_test btree2-$testno.7 {
329    btree_close $::b
330  } {}
331after 100
332  # For each database size, run various changes tests.
333  #
334  set num2 1
335  foreach {n I K D} {
336    0.5 0.5 0.1 0.1
337    1.0 0.2 0.1 0.1
338    1.0 0.8 0.1 0.1
339    2.0 0.0 0.1 0.1
340    2.0 1.0 0.1 0.1
341    2.0 0.0 0.0 0.0
342    2.0 1.0 0.0 0.0
343  } {
344    set testid btree2-$testno.8.$num2
345    set hash [md5file test2.bt]
346    do_test $testid.0 {
347      set ::b [btree_open test2.bt]
348      set ::c2 [btree_cursor $::b 2 1]
349      set ::c3 [btree_cursor $::b 3 1]
350      set ::c4 [btree_cursor $::b 4 1]
351      set ::c5 [btree_cursor $::b 5 1]
352      set ::c6 [btree_cursor $::b 6 1]
353      check_invariants
354    } {}
355    set cnt 6
356    for {set i 2} {$i<=6} {incr i} {
357      if {[lindex [btree_cursor_dump [set ::c$i]] 0]!=$i} {incr cnt}
358    }
359    do_test $testid.1 {
360      btree_begin_transaction $::b
361      lindex [btree_pager_stats $::b] 1
362    } $cnt
363    # exec cp test2.bt test2.bt.bu1
364    do_test $testid.2 [subst {
365      random_changes $n $I $K $D
366    }] {}
367    do_test $testid.3 {
368      check_invariants
369    } {}
370    do_test $testid.4 {
371      btree_close_cursor $::c2
372      btree_close_cursor $::c3
373      btree_close_cursor $::c4
374      btree_close_cursor $::c5
375      btree_close_cursor $::c6
376      btree_rollback $::b
377      md5file test2.bt
378    } $hash
379    # exec cp test2.bt test2.bt.bu2
380    btree_begin_transaction $::b
381    set ::c2 [btree_cursor $::b 2 1]
382    set ::c3 [btree_cursor $::b 3 1]
383    set ::c4 [btree_cursor $::b 4 1]
384    set ::c5 [btree_cursor $::b 5 1]
385    set ::c6 [btree_cursor $::b 6 1]
386    do_test $testid.5 [subst {
387      random_changes $n $I $K $D
388    }] {}
389    do_test $testid.6 {
390      check_invariants
391    } {}
392    do_test $testid.7 {
393      btree_commit $::b
394      check_invariants
395    } {}
396    set hash [md5file test2.bt]
397    do_test $testid.8 {
398      btree_close_cursor $::c2
399      btree_close_cursor $::c3
400      btree_close_cursor $::c4
401      btree_close_cursor $::c5
402      btree_close_cursor $::c6
403      lindex [btree_pager_stats $::b] 1
404    } {0}
405    do_test $testid.9 {
406      btree_close $::b
407      set ::b [btree_open test2.bt]
408      set ::c2 [btree_cursor $::b 2 1]
409      set ::c3 [btree_cursor $::b 3 1]
410      set ::c4 [btree_cursor $::b 4 1]
411      set ::c5 [btree_cursor $::b 5 1]
412      set ::c6 [btree_cursor $::b 6 1]
413      check_invariants
414    } {}
415    do_test $testid.10 {
416      btree_close_cursor $::c2
417      btree_close_cursor $::c3
418      btree_close_cursor $::c4
419      btree_close_cursor $::c5
420      btree_close_cursor $::c6
421      lindex [btree_pager_stats $::b] 1
422    } {0}
423    do_test $testid.11 {
424      btree_close $::b
425    } {}
426    incr num2
427  }
428  incr testno
429  set ::b [btree_open test2.bt]
430}
431
432# Testing is complete.  Shut everything down.
433#
434do_test btree-999.1 {
435  lindex [btree_pager_stats $::b] 1
436} {0}
437do_test btree-999.2 {
438  btree_close $::b
439} {}
440do_test btree-999.3 {
441  file delete -force test2.bt
442  file exists test2.bt-journal
443} {0}
444
445} ;# end if( not mem: and has pager_open command );
446
447finish_test
448