forked from Mirrors/freeswitch
165f180162
git-svn-id: http://svn.freeswitch.org/svn/freeswitch/trunk@3735 d0543943-73ff-0310-b7d9-9358b9ac24b2
503 lines
14 KiB
Plaintext
503 lines
14 KiB
Plaintext
# 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.15 2006/03/19 13:00:25 drh 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_cursor_info $::c2
|
|
btree_cursor_info $::c3
|
|
btree_cursor_info $::c4
|
|
btree_cursor_info $::c5
|
|
btree_cursor_info $::c6
|
|
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
|