proc test011 { method {nentries 10000} {ndups 5} {tnum "011"} args } {
global dlist
global rand_init
source ./include.tcl
set dlist ""
if { [is_rbtree $method] == 1 } {
puts "Test$tnum skipping for method $method"
return
}
if { [is_record_based $method] == 1 } {
test011_recno $method $nentries $tnum $args
return
}
if {$ndups < 5} {
set ndups 5
}
set args [convert_args $method $args]
set omethod [convert_method $method]
berkdb srand $rand_init
set txnenv 0
set eindex [lsearch -exact $args "-env"]
if { $eindex == -1 } {
set testfile $testdir/test$tnum.db
set env NULL
} else {
set testfile test$tnum.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 100
}
reduce_dups nentries ndups
}
set testdir [get_home $env]
}
puts -nonewline "Test$tnum: $method $nentries small $ndups dup "
puts "key/data pairs, cursor ops"
set t1 $testdir/t1
set t2 $testdir/t2
set t3 $testdir/t3
cleanup $testdir $env
set db [eval {berkdb_open -create \
-mode 0644} [concat $args "-dup"] {$omethod $testfile}]
error_check_good dbopen [is_valid_db $db] TRUE
set did [open $dict]
set pflags ""
set gflags ""
set txn ""
set count 0
puts "\tTest$tnum.a: put and get duplicate keys."
set i ""
for { set i 1 } { $i <= $ndups } { incr i 2 } {
lappend dlist $i
}
set maxodd $i
while { [gets $did str] != -1 && $count < $nentries } {
for { set i 1 } { $i <= $ndups } { incr i 2 } {
set datastr $i:$str
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 {$str $datastr}]
error_check_good put $ret 0
if { $txnenv == 1 } {
error_check_good txn [$t commit] 0
}
}
set x 1
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]
for {set ret [$dbc get "-set" $str ]} \
{[llength $ret] != 0} \
{set ret [$dbc get "-next"] } {
if {[llength $ret] == 0} {
break
}
set k [lindex [lindex $ret 0] 0]
if { [string compare $k $str] != 0 } {
break
}
set datastr [lindex [lindex $ret 0] 1]
set d [data_of $datastr]
error_check_good Test$tnum:put $d $str
set id [ id_of $datastr ]
error_check_good Test$tnum:dup incr x 2
}
error_check_good Test$tnum:numdups $x $maxodd
error_check_good curs_close [$dbc close] 0
if { $txnenv == 1 } {
error_check_good txn [$t commit] 0
}
incr count
}
close $did
puts "\tTest$tnum.b: \
traverse entire file checking duplicates before close."
if { $txnenv == 1 } {
set t [$env txn]
error_check_good txn [is_valid_txn $t $env] TRUE
set txn "-txn $t"
}
dup_check $db $txn $t1 $dlist
if { $txnenv == 1 } {
error_check_good txn [$t commit] 0
}
set q q
filehead $nentries $dict $t3
filesort $t3 $t2
filesort $t1 $t3
error_check_good Test$tnum:diff($t3,$t2) \
[filecmp $t3 $t2] 0
error_check_good db_close [$db close] 0
set db [eval {berkdb_open} $args $testfile]
error_check_good dbopen [is_valid_db $db] TRUE
puts "\tTest$tnum.c: \
traverse entire file checking duplicates after close."
if { $txnenv == 1 } {
set t [$env txn]
error_check_good txn [is_valid_txn $t $env] TRUE
set txn "-txn $t"
}
dup_check $db $txn $t1 $dlist
if { $txnenv == 1 } {
error_check_good txn [$t commit] 0
}
filesort $t1 $t3
error_check_good Test$tnum:diff($t3,$t2) \
[filecmp $t3 $t2] 0
puts "\tTest$tnum.d: Testing key_first functionality"
if { $txnenv == 1 } {
set t [$env txn]
error_check_good txn [is_valid_txn $t $env] TRUE
set txn "-txn $t"
}
add_dup $db $txn $nentries "-keyfirst" 0 0
set dlist [linsert $dlist 0 0]
dup_check $db $txn $t1 $dlist
if { $txnenv == 1 } {
error_check_good txn [$t commit] 0
}
puts "\tTest$tnum.e: Testing key_last functionality"
if { $txnenv == 1 } {
set t [$env txn]
error_check_good txn [is_valid_txn $t $env] TRUE
set txn "-txn $t"
}
add_dup $db $txn $nentries "-keylast" [expr $maxodd - 1] 0
lappend dlist [expr $maxodd - 1]
dup_check $db $txn $t1 $dlist
if { $txnenv == 1 } {
error_check_good txn [$t commit] 0
}
puts "\tTest$tnum.f: Testing add_before functionality"
if { $txnenv == 1 } {
set t [$env txn]
error_check_good txn [is_valid_txn $t $env] TRUE
set txn "-txn $t"
}
add_dup $db $txn $nentries "-before" 2 3
set dlist [linsert $dlist 2 2]
dup_check $db $txn $t1 $dlist
if { $txnenv == 1 } {
error_check_good txn [$t commit] 0
}
puts "\tTest$tnum.g: Testing add_after functionality"
if { $txnenv == 1 } {
set t [$env txn]
error_check_good txn [is_valid_txn $t $env] TRUE
set txn "-txn $t"
}
add_dup $db $txn $nentries "-after" 4 4
set dlist [linsert $dlist 4 4]
dup_check $db $txn $t1 $dlist
if { $txnenv == 1 } {
error_check_good txn [$t commit] 0
}
error_check_good db_close [$db close] 0
}
proc add_dup {db txn nentries flag dataval iter} {
source ./include.tcl
set dbc [eval {$db cursor} $txn]
set did [open $dict]
set count 0
while { [gets $did str] != -1 && $count < $nentries } {
set datastr $dataval:$str
set ret [$dbc get "-set" $str]
error_check_bad "cget(SET)" [is_substr $ret Error] 1
for { set i 1 } { $i < $iter } { incr i } {
set ret [$dbc get "-next"]
error_check_bad "cget(NEXT)" [is_substr $ret Error] 1
}
if { [string compare $flag "-before"] == 0 ||
[string compare $flag "-after"] == 0 } {
set ret [$dbc put $flag $datastr]
} else {
set ret [$dbc put $flag $str $datastr]
}
error_check_good "$dbc put $flag" $ret 0
incr count
}
close $did
$dbc close
}
proc test011_recno { method {nentries 10000} {tnum "011"} largs } {
global dlist
source ./include.tcl
set largs [convert_args $method $largs]
set omethod [convert_method $method]
set renum [is_rrecno $method]
puts "Test$tnum: \
$method ($largs) $nentries test cursor insert functionality"
set eindex [lsearch -exact $largs "-env"]
set txnenv 0
if { $eindex == -1 } {
set testfile $testdir/test$tnum.db
set env NULL
} else {
set testfile test$tnum.db
incr eindex
set env [lindex $largs $eindex]
set txnenv [is_txnenv $env]
if { $txnenv == 1 } {
append largs " -auto_commit "
if { $nentries == 10000 } {
set nentries 100
}
}
set testdir [get_home $env]
}
set t1 $testdir/t1
set t2 $testdir/t2
set t3 $testdir/t3
cleanup $testdir $env
if {$renum == 1} {
append largs " -renumber"
}
set db [eval {berkdb_open \
-create -mode 0644} $largs {$omethod $testfile}]
error_check_good dbopen [is_valid_db $db] TRUE
set did [open $dict]
set pflags ""
set gflags ""
set txn ""
set count 0
gets $did str
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 {1 [chop_data $method $str]}]
if { $txnenv == 1 } {
error_check_good txn [$t commit] 0
}
error_check_good put $ret 0
set count 1
set dlist "NULL $str"
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]
puts "\tTest$tnum.a: put and get entries"
while { [gets $did str] != -1 && $count < $nentries } {
set key [berkdb random_int 1 $count]
set ret [$dbc get -set $key]
set k [lindex [lindex $ret 0] 0]
set d [lindex [lindex $ret 0] 1]
error_check_good cget:SET:key $k $key
error_check_good \
cget:SET $d [pad_data $method [lindex $dlist $key]]
set ret [$dbc put -current [chop_data $method $str]]
error_check_good cput:$key $ret 0
set dlist [lreplace $dlist $key $key [pad_data $method $str]]
if { [gets $did str] == -1 } {
continue;
}
if { $renum == 1 } {
set ret [$dbc put \
-before [chop_data $method $str]]
error_check_good cput:$key:BEFORE $ret $key
set dlist [linsert $dlist $key $str]
incr count
if { [gets $did str] == -1 } {
continue;
}
set ret [$dbc put \
-after [chop_data $method $str]]
error_check_good cput:$key:AFTER $ret [expr $key + 1]
set dlist [linsert $dlist [expr $key + 1] $str]
incr count
}
set i 0
for {set ret [$dbc get "-set" $key]} \
{[string length $ret] != 0 && $i < 3} \
{set ret [$dbc get "-next"] } {
set check_key [expr $key + $i]
set k [lindex [lindex $ret 0] 0]
error_check_good cget:$key:loop $k $check_key
set d [lindex [lindex $ret 0] 1]
error_check_good cget:data $d \
[pad_data $method [lindex $dlist $check_key]]
incr i
}
}
close $did
error_check_good cclose [$dbc close] 0
if { $txnenv == 1 } {
error_check_good txn [$t commit] 0
}
set oid [open $t2 w]
for {set i 1} {$i <= $count} {incr i} {
puts $oid $i
}
close $oid
puts "\tTest$tnum.b: dump file"
if { $txnenv == 1 } {
set t [$env txn]
error_check_good txn [is_valid_txn $t $env] TRUE
set txn "-txn $t"
}
dump_file $db $txn $t1 test011_check
if { $txnenv == 1 } {
error_check_good txn [$t commit] 0
}
error_check_good Test$tnum:diff($t2,$t1) \
[filecmp $t2 $t1] 0
error_check_good db_close [$db close] 0
puts "\tTest$tnum.c: close, open, and dump file"
open_and_dump_file $testfile $env $t1 test011_check \
dump_file_direction "-first" "-next"
error_check_good Test$tnum:diff($t2,$t1) \
[filecmp $t2 $t1] 0
puts "\tTest$tnum.d: close, open, and dump file in reverse direction"
open_and_dump_file $testfile $env $t1 test011_check \
dump_file_direction "-last" "-prev"
filesort $t1 $t3 -n
error_check_good Test$tnum:diff($t2,$t3) \
[filecmp $t2 $t3] 0
}
proc test011_check { key data } {
global dlist
error_check_good "get key $key" $data [lindex $dlist $key]
}