| # 2004 May 10 |
| # |
| # 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: btree5.test,v 1.5 2004/05/14 12:17:46 drh Exp $ |
| |
| |
| set testdir [file dirname $argv0] |
| source $testdir/tester.tcl |
| |
| # Attempting to read table 1 of an empty file gives an SQLITE_EMPTY |
| # error. |
| # |
| do_test btree5-1.1 { |
| file delete -force test1.bt |
| file delete -force test1.bt-journal |
| set rc [catch {btree_open test1.bt 2000 0} ::b1] |
| } {0} |
| do_test btree5-1.2 { |
| set rc [catch {btree_cursor $::b1 1 0} ::c1] |
| } {1} |
| do_test btree5-1.3 { |
| set ::c1 |
| } {SQLITE_EMPTY} |
| do_test btree5-1.4 { |
| set rc [catch {btree_cursor $::b1 1 1} ::c1] |
| } {1} |
| do_test btree5-1.5 { |
| set ::c1 |
| } {SQLITE_EMPTY} |
| |
| # Starting a transaction initializes the first page of the database |
| # and the error goes away. |
| # |
| do_test btree5-1.6 { |
| btree_begin_transaction $b1 |
| set rc [catch {btree_cursor $b1 1 0} c1] |
| } {0} |
| do_test btree5-1.7 { |
| btree_first $c1 |
| } {1} |
| do_test btree5-1.8 { |
| btree_close_cursor $c1 |
| btree_rollback $b1 |
| set rc [catch {btree_cursor $b1 1 0} c1] |
| } {1} |
| do_test btree5-1.9 { |
| set c1 |
| } {SQLITE_EMPTY} |
| do_test btree5-1.10 { |
| btree_begin_transaction $b1 |
| set rc [catch {btree_cursor $b1 1 0} c1] |
| } {0} |
| do_test btree5-1.11 { |
| btree_first $c1 |
| } {1} |
| do_test btree5-1.12 { |
| btree_close_cursor $c1 |
| btree_commit $b1 |
| set rc [catch {btree_cursor $b1 1 0} c1] |
| } {0} |
| do_test btree5-1.13 { |
| btree_first $c1 |
| } {1} |
| do_test btree5-1.14 { |
| btree_close_cursor $c1 |
| btree_integrity_check $b1 1 |
| } {} |
| |
| # Insert many entries into table 1. This is designed to test the |
| # virtual-root logic that comes into play for page one. It is also |
| # a good test of INTKEY tables. |
| # |
| # Stagger the inserts. After the inserts complete, go back and do |
| # deletes. Stagger the deletes too. Repeat this several times. |
| # |
| |
| # Do N inserts into table 1 using random keys between 0 and 1000000 |
| # |
| proc random_inserts {N} { |
| global c1 |
| while {$N>0} { |
| set k [expr {int(rand()*1000000)}] |
| if {[btree_move_to $c1 $k]==0} continue; # entry already exists |
| btree_insert $c1 $k data-for-$k |
| incr N -1 |
| } |
| } |
| |
| # Do N delete from table 1 |
| # |
| proc random_deletes {N} { |
| global c1 |
| while {$N>0} { |
| set k [expr {int(rand()*1000000)}] |
| btree_move_to $c1 $k |
| btree_delete $c1 |
| incr N -1 |
| } |
| } |
| |
| # Make sure the table has exactly N entries. Make sure the data for |
| # each entry agrees with its key. |
| # |
| proc check_table {N} { |
| global c1 |
| btree_first $c1 |
| set cnt 0 |
| while {![btree_eof $c1]} { |
| if {[set data [btree_data $c1]] ne "data-for-[btree_key $c1]"} { |
| return "wrong data for entry $cnt" |
| } |
| set n [string length $data] |
| set fdata1 [btree_fetch_data $c1 $n] |
| set fdata2 [btree_fetch_data $c1 -1] |
| if {$fdata1 ne "" && $fdata1 ne $data} { |
| return "DataFetch returned the wrong value with amt=$n" |
| } |
| if {$fdata1 ne $fdata2} { |
| return "DataFetch returned the wrong value when amt=-1" |
| } |
| if {$n>10} { |
| set fdata3 [btree_fetch_data $c1 10] |
| if {$fdata3 ne [string range $data 0 9]} { |
| return "DataFetch returned the wrong value when amt=10" |
| } |
| } |
| incr cnt |
| btree_next $c1 |
| } |
| if {$cnt!=$N} { |
| return "wrong number of entries" |
| } |
| return {} |
| } |
| |
| # Initialize the database |
| # |
| btree_begin_transaction $b1 |
| set c1 [btree_cursor $b1 1 1] |
| set btree_trace 0 |
| |
| # Do the tests. |
| # |
| set cnt 0 |
| for {set i 1} {$i<=100} {incr i} { |
| do_test btree5-2.$i.1 { |
| random_inserts 200 |
| incr cnt 200 |
| check_table $cnt |
| } {} |
| do_test btree5-2.$i.2 { |
| btree_integrity_check $b1 1 |
| } {} |
| do_test btree5-2.$i.3 { |
| random_deletes 190 |
| incr cnt -190 |
| check_table $cnt |
| } {} |
| do_test btree5-2.$i.4 { |
| btree_integrity_check $b1 1 |
| } {} |
| } |
| |
| #btree_tree_dump $b1 1 |
| btree_close_cursor $c1 |
| btree_commit $b1 |
| btree_begin_transaction $b1 |
| |
| # This procedure converts an integer into a variable-length text key. |
| # The conversion is reversible. |
| # |
| # The first two characters of the string are alphabetics derived from |
| # the least significant bits of the number. Because they are derived |
| # from least significant bits, the sort order of the resulting string |
| # is different from numeric order. After the alphabetic prefix comes |
| # the original number. A variable-length suffix follows. The length |
| # of the suffix is based on a hash of the original number. |
| # |
| proc num_to_key {n} { |
| global charset ncharset suffix |
| set c1 [string index $charset [expr {$n%$ncharset}]] |
| set c2 [string index $charset [expr {($n/$ncharset)%$ncharset}]] |
| set nsuf [expr {($n*211)%593}] |
| return $c1$c2-$n-[string range $suffix 0 $nsuf] |
| } |
| set charset {abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ} |
| set ncharset [string length $charset] |
| set suffix $charset$charset |
| while {[string length $suffix]<1000} {append suffix $suffix} |
| |
| # This procedures extracts the original integer used to create |
| # a key by num_to_key |
| # |
| proc key_to_num {key} { |
| regexp {^..-([0-9]+)} $key all n |
| return $n |
| } |
| |
| # Insert into table $tab keys corresponding to all values between |
| # $start and $end, inclusive. |
| # |
| proc insert_range {tab start end} { |
| for {set i $start} {$i<=$end} {incr i} { |
| btree_insert $tab [num_to_key $i] {} |
| } |
| } |
| |
| # Delete from table $tab keys corresponding to all values between |
| # $start and $end, inclusive. |
| # |
| proc delete_range {tab start end} { |
| for {set i $start} {$i<=$end} {incr i} { |
| if {[btree_move_to $tab [num_to_key $i]]==0} { |
| btree_delete $tab |
| } |
| } |
| } |
| |
| # Make sure table $tab contains exactly those keys corresponding |
| # to values between $start and $end |
| # |
| proc check_range {tab start end} { |
| btree_first $tab |
| while {![btree_eof $tab]} { |
| set key [btree_key $tab] |
| set i [key_to_num $key] |
| if {[num_to_key $i] ne $key} { |
| return "malformed key: $key" |
| } |
| set got($i) 1 |
| btree_next $tab |
| } |
| set all [lsort -integer [array names got]] |
| if {[llength $all]!=$end+1-$start} { |
| return "table contains wrong number of values" |
| } |
| if {[lindex $all 0]!=$start} { |
| return "wrong starting value" |
| } |
| if {[lindex $all end]!=$end} { |
| return "wrong ending value" |
| } |
| return {} |
| } |
| |
| # Create a zero-data table and test it out. |
| # |
| do_test btree5-3.1 { |
| set rc [catch {btree_create_table $b1 2} t2] |
| } {0} |
| do_test btree5-3.2 { |
| set rc [catch {btree_cursor $b1 $t2 1} c2] |
| } {0} |
| set start 1 |
| set end 100 |
| for {set i 1} {$i<=100} {incr i} { |
| do_test btree5-3.3.$i.1 { |
| insert_range $c2 $start $end |
| btree_integrity_check $b1 1 $t2 |
| } {} |
| do_test btree5-3.3.$i.2 { |
| check_range $c2 $start $end |
| } {} |
| set nstart $start |
| incr nstart 89 |
| do_test btree5-3.3.$i.3 { |
| delete_range $c2 $start $nstart |
| btree_integrity_check $b1 1 $t2 |
| } {} |
| incr start 90 |
| do_test btree5-3.3.$i.4 { |
| check_range $c2 $start $end |
| } {} |
| incr end 100 |
| } |
| |
| |
| btree_close_cursor $c2 |
| btree_commit $b1 |
| btree_close $b1 |
| |
| finish_test |