proc test023 { method args } {
global alphabet
global dupnum
global dupstr
global errorInfo
source ./include.tcl
set args [convert_args $method $args]
set omethod [convert_method $method]
puts "Test023: $method delete duplicates/check cursor operations"
if { [is_record_based $method] == 1 || \
[is_rbtree $method] == 1 } {
puts "Test023: skipping for method $omethod"
return
}
set txnenv 0
set eindex [lsearch -exact $args "-env"]
if { $eindex == -1 } {
set testfile $testdir/test023.db
set env NULL
} else {
set testfile test023.db
incr eindex
set env [lindex $args $eindex]
set txnenv [is_txnenv $env]
if { $txnenv == 1 } {
append args " -auto_commit "
}
set testdir [get_home $env]
}
set t1 $testdir/t1
cleanup $testdir $env
set db [eval {berkdb_open \
-create -mode 0644 -dup} $args {$omethod $testfile}]
error_check_good dbopen [is_valid_db $db] TRUE
set pflags ""
set gflags ""
set txn ""
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
foreach i { onpage offpage } {
if { $i == "onpage" } {
set dupstr DUP
} else {
set dupstr [repeat $alphabet 50]
}
puts "\tTest023.a: Insert key w/$i dups"
set key "duplicate_val_test"
for { set count 0 } { $count < 20 } { incr count } {
set ret \
[eval {$db put} $txn $pflags {$key $count$dupstr}]
error_check_good db_put $ret 0
}
puts "\tTest023.b: Check initial duplicates"
set dupnum 0
dump_file $db $txn $t1 test023.check
set ret [$dbc get -set $key]
error_check_bad dbc_get:SET [llength $ret] 0
puts "\tTest023.c: Delete first and try gets"
error_check_good \
dbc_get:SET $ret [list [list duplicate_val_test 0$dupstr]]
set ret [$dbc del]
error_check_good dbc_del:FIRST $ret 0
set ret [$dbc get -current]
error_check_good dbc_get:CURRENT $ret ""
set ret [$dbc get -prev]
error_check_good dbc_get:prev0 [llength $ret] 0
for { set j 1 } { $j <= 10 } { incr j } {
set ret [$dbc get -next]
error_check_good \
dbc_get:next [llength [lindex $ret 0]] 2
error_check_good \
dbc_get:next [lindex [lindex $ret 0] 1] $j$dupstr
}
puts "\tTest023.d: Delete middle and try gets"
set ret [$dbc del]
error_check_good dbc_del:10 $ret 0
set ret [$dbc get -current]
error_check_good dbc_get:deleted $ret ""
set ret [$dbc get -next]
error_check_good dbc_get:next [llength [lindex $ret 0]] 2
error_check_good \
dbc_get:next [lindex [lindex $ret 0] 1] 11$dupstr
set ret [$dbc get -prev]
error_check_good dbc_get:next [llength [lindex $ret 0]] 2
error_check_good \
dbc_get:next [lindex [lindex $ret 0] 1] 9$dupstr
for { set j 11 } { $j <= 19 } { incr j } {
set ret [$dbc get -next]
error_check_good \
dbc_get:next [llength [lindex $ret 0]] 2
error_check_good \
dbc_get:next [lindex [lindex $ret 0] 1] $j$dupstr
}
puts "\tTest023.e: Delete last and try gets"
set ret [$dbc del]
error_check_good dbc_del:LAST $ret 0
set ret [$dbc get -current]
error_check_good dbc_get:deleted $ret ""
set ret [$dbc get -next]
error_check_good dbc_get:next19 [llength $ret] 0
set ret [$dbc get -prev]
error_check_good dbc_get:next [llength [lindex $ret 0]] 2
error_check_good \
dbc_get:next [lindex [lindex $ret 0] 1] 18$dupstr
puts "\tTest023.f: Count keys, overwrite current, count again"
set dbc2 [eval {$db cursor} $txn]
error_check_good db_cursor:2 [is_substr $dbc2 $db] 1
set count_check 0
for { set rec [$dbc2 get -first] } {
[llength $rec] != 0 } { set rec [$dbc2 get -next] } {
incr count_check
}
error_check_good numdups $count_check 17
set ret [$dbc put -current OVERWRITE]
error_check_good dbc_put:current $ret 0
set count_check 0
for { set rec [$dbc2 get -first] } {
[llength $rec] != 0 } { set rec [$dbc2 get -next] } {
incr count_check
}
error_check_good numdups $count_check 17
error_check_good dbc2_close [$dbc2 close] 0
set ret [eval {$db del} $txn {$key}]
error_check_good db_delete $ret 0
set ret [$dbc get -first]
error_check_good first_after_empty [llength $ret] 0
}
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
}
proc test023.check { key data } {
global dupnum
global dupstr
error_check_good "bad key" $key duplicate_val_test
error_check_good "data mismatch for $key" $data $dupnum$dupstr
incr dupnum
}