# 2001 September 15 # # The author disclaims copyright to this source code. In place of # a legal notice, here is a blessing: # # May you do good and not evil. # May you find forgiveness for yourself and forgive others. # May you share freely, never taking more than you give. # #*********************************************************************** # This file implements regression tests for SQLite library. The # focus of this script is btree database backend # # $Id: btree2.test,v 1.14 2005/01/11 10:25:07 danielk1977 Exp $ set testdir [file dirname $argv0] source $testdir/tester.tcl if {[info commands btree_open]!=""} { # Create a new database file containing no entries. The database should # contain 5 tables: # # 2 The descriptor table # 3 The foreground table # 4 The background table # 5 The long key table # 6 The long data table # # An explanation for what all these tables are used for is provided below. # do_test btree2-1.1 { expr srand(1) file delete -force test2.bt file delete -force test2.bt-journal set ::b [btree_open test2.bt 2000 0] btree_begin_transaction $::b btree_create_table $::b 0 } {2} do_test btree2-1.2 { btree_create_table $::b 0 } {3} do_test btree2-1.3 { btree_create_table $::b 0 } {4} do_test btree2-1.4 { btree_create_table $::b 0 } {5} do_test btree2-1.5 { btree_create_table $::b 0 } {6} do_test btree2-1.6 { set ::c2 [btree_cursor $::b 2 1] btree_insert $::c2 {one} {1} btree_move_to $::c2 {one} btree_delete $::c2 btree_close_cursor $::c2 btree_commit $::b btree_integrity_check $::b 1 2 3 4 5 6 } {} # This test module works by making lots of pseudo-random changes to a # database while simultaneously maintaining an invariant on that database. # Periodically, the script does a sanity check on the database and verifies # that the invariant is satisfied. # # The invariant is as follows: # # 1. The descriptor table always contains 2 enters. An entry keyed by # "N" is the number of elements in the foreground and background tables # combined. The entry keyed by "L" is the number of digits in the keys # for foreground and background tables. # # 2. The union of the foreground an background tables consists of N entries # where each entry has an L-digit key. (Actually, some keys can be longer # than L characters, but they always start with L digits.) The keys # cover all integers between 1 and N. Whenever an entry is added to # the foreground it is removed form the background and vice versa. # # 3. Some entries in the foreground and background tables have keys that # begin with an L-digit number but are followed by additional characters. # For each such entry there is a corresponding entry in the long key # table. The long key table entry has a key which is just the L-digit # number and data which is the length of the key in the foreground and # background tables. # # 4. The data for both foreground and background entries is usually a # short string. But some entries have long data strings. For each # such entries there is an entry in the long data type. The key to # long data table is an L-digit number. (The extension on long keys # is omitted.) The data is the number of charaters in the data of the # foreground or background entry. # # The following function builds a database that satisfies all of the above # invariants. # proc build_db {N L} { for {set i 2} {$i<=6} {incr i} { catch {btree_close_cursor [set ::c$i]} btree_clear_table $::b $i set ::c$i [btree_cursor $::b $i 1] } btree_insert $::c2 N $N btree_insert $::c2 L $L set format %0${L}d for {set i 1} {$i<=$N} {incr i} { set key [format $format $i] set data $key btree_insert $::c3 $key $data } } # Given a base key number and a length, construct the full text of the key # or data. # proc make_payload {keynum L len} { set key [format %0${L}d $keynum] set r $key set i 1 while {[string length $r]<$len} { append r " ($i) $key" incr i } return [string range $r 0 [expr {$len-1}]] } # Verify the invariants on the database. Return an empty string on # success or an error message if something is amiss. # proc check_invariants {} { set ck [btree_integrity_check $::b 1 2 3 4 5 6] if {$ck!=""} { puts "\n*** SANITY:\n$ck" exit return $ck } btree_move_to $::c3 {} btree_move_to $::c4 {} btree_move_to $::c2 N set N [btree_data $::c2] btree_move_to $::c2 L set L [btree_data $::c2] set LM1 [expr {$L-1}] for {set i 1} {$i<=$N} {incr i} { set key {} if {![btree_eof $::c3]} { set key [btree_key $::c3] } if {[scan $key %d k]<1} {set k 0} if {$k!=$i} { set key {} if {![btree_eof $::c4]} { set key [btree_key $::c4] } if {[scan $key %d k]<1} {set k 0} if {$k!=$i} { return "Key $i is missing from both foreground and background" } set data [btree_data $::c4] btree_next $::c4 } else { set data [btree_data $::c3] btree_next $::c3 } set skey [string range $key 0 $LM1] if {[btree_move_to $::c5 $skey]==0} { set keylen [btree_data $::c5] } else { set keylen $L } if {[string length $key]!=$keylen} { return "Key $i is the wrong size.\ Is \"$key\" but should be \"[make_payload $k $L $keylen]\"" } if {[make_payload $k $L $keylen]!=$key} { return "Key $i has an invalid extension" } if {[btree_move_to $::c6 $skey]==0} { set datalen [btree_data $::c6] } else { set datalen $L } if {[string length $data]!=$datalen} { return "Data for $i is the wrong size.\ Is [string length $data] but should be $datalen" } if {[make_payload $k $L $datalen]!=$data} { return "Entry $i has an incorrect data" } } } # Look at all elements in both the foreground and background tables. # Make sure the key is always the same as the prefix of the data. # # This routine was used for hunting bugs. It is not a part of standard # tests. # proc check_data {n key} { global c3 c4 incr n -1 foreach c [list $c3 $c4] { btree_first $c ;# move_to $c $key set cnt 0 while {![btree_eof $c]} { set key [btree_key $c] set data [btree_data $c] if {[string range $key 0 $n] ne [string range $data 0 $n]} { puts "key=[list $key] data=[list $data] n=$n" puts "cursor info = [btree_cursor_info $c]" btree_page_dump $::b [lindex [btree_cursor_info $c] 0] exit } btree_next $c } } } # Make random changes to the database such that each change preserves # the invariants. The number of changes is $n*N where N is the parameter # from the descriptor table. Each changes begins with a random key. # the entry with that key is put in the foreground table with probability # $I and it is put in background with probability (1.0-$I). It gets # a long key with probability $K and long data with probability $D. # set chngcnt 0 proc random_changes {n I K D} { global chngcnt btree_move_to $::c2 N set N [btree_data $::c2] btree_move_to $::c2 L set L [btree_data $::c2] set LM1 [expr {$L-1}] set total [expr {int($N*$n)}] set format %0${L}d for {set i 0} {$i<$total} {incr i} { set k [expr {int(rand()*$N)+1}] set insert [expr {rand()<=$I}] set longkey [expr {rand()<=$K}] set longdata [expr {rand()<=$D}] if {$longkey} { set x [expr {rand()}] set keylen [expr {int($x*$x*$x*$x*3000)+10}] } else { set keylen $L } set key [make_payload $k $L $keylen] if {$longdata} { set x [expr {rand()}] set datalen [expr {int($x*$x*$x*$x*3000)+10}] } else { set datalen $L } set data [make_payload $k $L $datalen] set basekey [format $format $k] if {[set c [btree_move_to $::c3 $basekey]]==0} { btree_delete $::c3 } else { if {$c<0} {btree_next $::c3} if {![btree_eof $::c3]} { if {[string match $basekey* [btree_key $::c3]]} { btree_delete $::c3 } } } if {[set c [btree_move_to $::c4 $basekey]]==0} { btree_delete $::c4 } else { if {$c<0} {btree_next $::c4} if {![btree_eof $::c4]} { if {[string match $basekey* [btree_key $::c4]]} { btree_delete $::c4 } } } set kx -1 if {![btree_eof $::c4]} { if {[scan [btree_key $::c4] %d kx]<1} {set kx -1} } if {$kx==$k} { btree_delete $::c4 } # For debugging - change the "0" to "1" to integrity check after # every change. if 0 { incr chngcnt puts check----$chngcnt set ck [btree_integrity_check $::b 1 2 3 4 5 6] if {$ck!=""} { puts "\nSANITY CHECK FAILED!\n$ck" exit } } if {$insert} { btree_insert $::c3 $key $data } else { btree_insert $::c4 $key $data } if {$longkey} { btree_insert $::c5 $basekey $keylen } elseif {[btree_move_to $::c5 $basekey]==0} { btree_delete $::c5 } if {$longdata} { btree_insert $::c6 $basekey $datalen } elseif {[btree_move_to $::c6 $basekey]==0} { btree_delete $::c6 } # For debugging - change the "0" to "1" to integrity check after # every change. if 0 { incr chngcnt puts check----$chngcnt set ck [btree_integrity_check $::b 1 2 3 4 5 6] if {$ck!=""} { puts "\nSANITY CHECK FAILED!\n$ck" exit } } } } set btree_trace 0 # Repeat this test sequence on database of various sizes # set testno 2 foreach {N L} { 10 2 50 2 200 3 2000 5 } { puts "**** N=$N L=$L ****" set hash [md5file test2.bt] do_test btree2-$testno.1 [subst -nocommands { set ::c2 [btree_cursor $::b 2 1] set ::c3 [btree_cursor $::b 3 1] set ::c4 [btree_cursor $::b 4 1] set ::c5 [btree_cursor $::b 5 1] set ::c6 [btree_cursor $::b 6 1] btree_begin_transaction $::b build_db $N $L check_invariants }] {} do_test btree2-$testno.2 { btree_close_cursor $::c2 btree_close_cursor $::c3 btree_close_cursor $::c4 btree_close_cursor $::c5 btree_close_cursor $::c6 btree_rollback $::b md5file test2.bt } $hash do_test btree2-$testno.3 [subst -nocommands { btree_begin_transaction $::b set ::c2 [btree_cursor $::b 2 1] set ::c3 [btree_cursor $::b 3 1] set ::c4 [btree_cursor $::b 4 1] set ::c5 [btree_cursor $::b 5 1] set ::c6 [btree_cursor $::b 6 1] build_db $N $L check_invariants }] {} do_test btree2-$testno.4 { btree_commit $::b check_invariants } {} do_test btree2-$testno.5 { lindex [btree_pager_stats $::b] 1 } {6} do_test btree2-$testno.6 { btree_close_cursor $::c2 btree_close_cursor $::c3 btree_close_cursor $::c4 btree_close_cursor $::c5 btree_close_cursor $::c6 lindex [btree_pager_stats $::b] 1 } {0} do_test btree2-$testno.7 { btree_close $::b } {} # For each database size, run various changes tests. # set num2 1 foreach {n I K D} { 0.5 0.5 0.1 0.1 1.0 0.2 0.1 0.1 1.0 0.8 0.1 0.1 2.0 0.0 0.1 0.1 2.0 1.0 0.1 0.1 2.0 0.0 0.0 0.0 2.0 1.0 0.0 0.0 } { set testid btree2-$testno.8.$num2 set hash [md5file test2.bt] do_test $testid.0 { set ::b [btree_open test2.bt 2000 0] set ::c2 [btree_cursor $::b 2 1] set ::c3 [btree_cursor $::b 3 1] set ::c4 [btree_cursor $::b 4 1] set ::c5 [btree_cursor $::b 5 1] set ::c6 [btree_cursor $::b 6 1] check_invariants } {} set cnt 6 for {set i 2} {$i<=6} {incr i} { if {[lindex [btree_cursor_info [set ::c$i]] 0]!=$i} {incr cnt} } do_test $testid.1 { btree_begin_transaction $::b lindex [btree_pager_stats $::b] 1 } $cnt do_test $testid.2 [subst { random_changes $n $I $K $D }] {} do_test $testid.3 { check_invariants } {} do_test $testid.4 { btree_close_cursor $::c2 btree_close_cursor $::c3 btree_close_cursor $::c4 btree_close_cursor $::c5 btree_close_cursor $::c6 btree_rollback $::b md5file test2.bt } $hash btree_begin_transaction $::b set ::c2 [btree_cursor $::b 2 1] set ::c3 [btree_cursor $::b 3 1] set ::c4 [btree_cursor $::b 4 1] set ::c5 [btree_cursor $::b 5 1] set ::c6 [btree_cursor $::b 6 1] do_test $testid.5 [subst { random_changes $n $I $K $D }] {} do_test $testid.6 { check_invariants } {} do_test $testid.7 { btree_commit $::b check_invariants } {} set hash [md5file test2.bt] do_test $testid.8 { btree_close_cursor $::c2 btree_close_cursor $::c3 btree_close_cursor $::c4 btree_close_cursor $::c5 btree_close_cursor $::c6 lindex [btree_pager_stats $::b] 1 } {0} do_test $testid.9 { btree_close $::b set ::b [btree_open test2.bt 2000 0] set ::c2 [btree_cursor $::b 2 1] set ::c3 [btree_cursor $::b 3 1] set ::c4 [btree_cursor $::b 4 1] set ::c5 [btree_cursor $::b 5 1] set ::c6 [btree_cursor $::b 6 1] check_invariants } {} do_test $testid.10 { btree_close_cursor $::c2 btree_close_cursor $::c3 btree_close_cursor $::c4 btree_close_cursor $::c5 btree_close_cursor $::c6 lindex [btree_pager_stats $::b] 1 } {0} do_test $testid.11 { btree_close $::b } {} incr num2 } incr testno set ::b [btree_open test2.bt 2000 0] } # Testing is complete. Shut everything down. # do_test btree-999.1 { lindex [btree_pager_stats $::b] 1 } {0} do_test btree-999.2 { btree_close $::b } {} do_test btree-999.3 { file delete -force test2.bt file exists test2.bt-journal } {0} } ;# end if( not mem: and has pager_open command ); finish_test