# 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 $b1set c1 [btree_cursor $b1 1 1]set btree_trace 0# Do the tests.#set cnt 0for {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 1btree_close_cursor $c1btree_commit $b1btree_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$charsetwhile {[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 1set end 100for {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 $c2btree_commit $b1btree_close $b1finish_test