proc test029 { method {nentries 10000} args} {
source ./include.tcl
set do_renumber [is_rrecno $method]
set args [convert_args $method $args]
set omethod [convert_method $method]
puts "Test029: $method ($args)"
if { [string compare $omethod "-hash"] == 0 } {
puts "Test029 skipping for method HASH"
return
}
if { [is_record_based $method] == 1 && $do_renumber != 1 } {
puts "Test029 skipping for method RECNO (w/out renumbering)"
return
}
set txnenv 0
set eindex [lsearch -exact $args "-env"]
if { $eindex == -1 } {
set testfile $testdir/test029.db
set env NULL
} else {
set testfile test029.db
incr eindex
set env [lindex $args $eindex]
set txnenv [is_txnenv $env]
if { $txnenv == 1 } {
append args " -auto_commit "
if { $nentries == 10000 } {
set nentries 1000
}
}
set testdir [get_home $env]
}
cleanup $testdir $env
puts "\tTest029.a: initialization"
set keys ""
set did [open $dict]
set count 0
while { [gets $did str] != -1 && $count < $nentries } {
lappend keys [reverse $str]
incr count
}
close $did
set sorted_keys [lsort $keys]
set last_key [lindex $sorted_keys end]
set last_keynum [llength $sorted_keys]
set first_key [lindex $sorted_keys 0]
set first_keynum 1
if { [string compare $omethod "-btree"] == 0 } {
set db [eval {berkdb_open -create \
-mode 0644 -recnum} $args {$omethod $testfile}]
error_check_good dbopen [is_valid_db $db] TRUE
} else {
set db [eval {berkdb_open -create \
-mode 0644} $args {$omethod $testfile}]
error_check_good dbopen [is_valid_db $db] TRUE
}
set pflags ""
set gflags ""
set txn ""
if { [is_record_based $method] == 1 } {
append gflags " -recno"
}
puts "\tTest029.b: put/get loop"
foreach k $keys {
if { [is_record_based $method] == 1 } {
set key [lsearch $sorted_keys $k]
incr key
} else {
set key $k
}
if { $txnenv == 1 } {
set t [$env txn]
error_check_good txn [is_valid_txn $t $env] TRUE
set txn "-txn $t"
}
set ret [eval {$db put} \
$txn $pflags {$key [chop_data $method $k]}]
error_check_good dbput $ret 0
set ret [eval {$db get} $txn $gflags {$key}]
error_check_good dbget [lindex [lindex $ret 0] 1] $k
if { $txnenv == 1 } {
error_check_good txn [$t commit] 0
}
}
puts "\tTest029.c: delete and verify renumber"
if { [is_record_based $method] == 1 } {
set key $first_keynum
} else {
set key $first_key
}
if { $txnenv == 1 } {
set t [$env txn]
error_check_good txn [is_valid_txn $t $env] TRUE
set txn "-txn $t"
}
set ret [eval {$db del} $txn {$key}]
error_check_good db_del $ret 0
if { $txnenv == 1 } {
error_check_good txn [$t commit] 0
}
if { [string compare $omethod "-btree"] == 0 } {
append gflags " -recno"
}
if { $txnenv == 1 } {
set t [$env txn]
error_check_good txn [is_valid_txn $t $env] TRUE
set txn "-txn $t"
}
set ret [eval {$db get} $txn $gflags {$last_keynum}]
error_check_good get_after_del $ret [list]
if { $txnenv == 1 } {
error_check_good txn [$t commit] 0
}
if { $txnenv == 1 } {
set t [$env txn]
error_check_good txn [is_valid_txn $t $env] TRUE
set txn "-txn $t"
}
set ret [eval {$db get} $txn $gflags {[expr $last_keynum - 1]}]
error_check_good \
getn_last_after_del [lindex [lindex $ret 0] 1] $last_key
if { $txnenv == 1 } {
error_check_good txn [$t commit] 0
}
if { $txnenv == 1 } {
set t [$env txn]
error_check_good txn [is_valid_txn $t $env] TRUE
set txn "-txn $t"
}
set dbc [eval {$db cursor} $txn]
error_check_good db_cursor [is_valid_cursor $dbc $db] TRUE
if { [string compare $omethod "-btree"] == 0 } {
set ret [eval {$db put} $txn \
{$key [chop_data $method $first_key]}]
error_check_good db_put $ret 0
} else {
set ret [$dbc get -first]
set ret [eval {$dbc put} $pflags {-before $first_key}]
error_check_bad dbc_put:DB_BEFORE $ret 0
}
set ret [eval {$db get} $txn $gflags {$last_keynum}]
error_check_good \
getn_last_after_put [lindex [lindex $ret 0] 1] $last_key
puts "\tTest029.d: delete with cursor and verify renumber"
set ret [$dbc get -first]
error_check_good dbc_first $ret [list [list $key $first_key]]
set ret [$dbc del]
error_check_good dbc_del $ret 0
set ret [eval {$db get} $txn $gflags {$last_keynum}]
error_check_good get_last_after_cursor_del:$ret $ret [list]
set ret [eval {$db get} $txn $gflags {[expr $last_keynum - 1]}]
error_check_good \
getn_after_cursor_del [lindex [lindex $ret 0] 1] $last_key
if { [string compare $omethod "-btree"] == 0 } {
puts "\tTest029.e: put (non-cursor) and verify renumber"
set ret [eval {$db put} $txn \
{$key [chop_data $method $first_key]}]
error_check_good db_put $ret 0
} else {
puts "\tTest029.e: put with cursor and verify renumber"
set ret [eval {$dbc put} $pflags {-before $first_key}]
error_check_bad dbc_put:DB_BEFORE $ret 0
}
set ret [eval {$db get} $txn $gflags {$last_keynum}]
error_check_good \
get_after_cursor_reput [lindex [lindex $ret 0] 1] $last_key
error_check_good dbc_close [$dbc close] 0
if { $txnenv == 1 } {
error_check_good txn [$t commit] 0
}
error_check_good db_close [$db close] 0
}