diff options
Diffstat (limited to 'libdb/test/test085.tcl')
| -rw-r--r-- | libdb/test/test085.tcl | 332 |
1 files changed, 0 insertions, 332 deletions
diff --git a/libdb/test/test085.tcl b/libdb/test/test085.tcl deleted file mode 100644 index 078e6c265..000000000 --- a/libdb/test/test085.tcl +++ /dev/null @@ -1,332 +0,0 @@ -# See the file LICENSE for redistribution information. -# -# Copyright (c) 2000-2002 -# Sleepycat Software. All rights reserved. -# -# $Id$ -# -# TEST test085 -# TEST Test of cursor behavior when a cursor is pointing to a deleted -# TEST btree key which then has duplicates added. [#2473] -proc test085 { method {pagesize 512} {onp 3} {offp 10} {tnum 85} args } { - source ./include.tcl - global alphabet - - set omethod [convert_method $method] - set args [convert_args $method $args] - set encargs "" - set args [split_encargs $args encargs] - - set txnenv 0 - set eindex [lsearch -exact $args "-env"] - # - # If we are using an env, then testfile should just be the db name. - # Otherwise it is the test directory and the name. - if { $eindex == -1 } { - set testfile $testdir/test0$tnum.db - set env NULL - } else { - set testfile test0$tnum.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 pgindex [lsearch -exact $args "-pagesize"] - if { $pgindex != -1 } { - puts "Test085: skipping for specific pagesizes" - return - } - cleanup $testdir $env - - # Keys must sort $prekey < $key < $postkey. - set prekey "AA" - set key "BBB" - set postkey "CCCC" - - # Make these distinguishable from each other and from the - # alphabets used for the $key's data. - set predatum "1234567890" - set datum $alphabet - set postdatum "0987654321" - set txn "" - - append args " -pagesize $pagesize -dup" - - puts -nonewline "Test0$tnum $omethod ($args): " - - # Skip for all non-btrees. (Rbtrees don't count as btrees, for - # now, since they don't support dups.) - if { [is_btree $method] != 1 } { - puts "Skipping for method $method." - return - } else { - puts "Duplicates w/ deleted item cursor." - } - - # Repeat the test with both on-page and off-page numbers of dups. - foreach ndups "$onp $offp" { - # Put operations we want to test on a cursor set to the - # deleted item, the key to use with them, and what should - # come before and after them given a placement of - # the deleted item at the beginning or end of the dupset. - set final [expr $ndups - 1] - set putops { - {{-before} "" $predatum {[test085_ddatum 0]} beginning} - {{-before} "" {[test085_ddatum $final]} $postdatum end} - {{-current} "" $predatum {[test085_ddatum 0]} beginning} - {{-current} "" {[test085_ddatum $final]} $postdatum end} - {{-keyfirst} $key $predatum {[test085_ddatum 0]} beginning} - {{-keyfirst} $key $predatum {[test085_ddatum 0]} end} - {{-keylast} $key {[test085_ddatum $final]} $postdatum beginning} - {{-keylast} $key {[test085_ddatum $final]} $postdatum end} - {{-after} "" $predatum {[test085_ddatum 0]} beginning} - {{-after} "" {[test085_ddatum $final]} $postdatum end} - } - - # Get operations we want to test on a cursor set to the - # deleted item, any args to get, and the expected key/data pair. - set getops { - {{-current} "" "" "" beginning} - {{-current} "" "" "" end} - {{-next} "" $key {[test085_ddatum 0]} beginning} - {{-next} "" $postkey $postdatum end} - {{-prev} "" $prekey $predatum beginning} - {{-prev} "" $key {[test085_ddatum $final]} end} - {{-first} "" $prekey $predatum beginning} - {{-first} "" $prekey $predatum end} - {{-last} "" $postkey $postdatum beginning} - {{-last} "" $postkey $postdatum end} - {{-nextdup} "" $key {[test085_ddatum 0]} beginning} - {{-nextdup} "" EMPTYLIST "" end} - {{-nextnodup} "" $postkey $postdatum beginning} - {{-nextnodup} "" $postkey $postdatum end} - {{-prevnodup} "" $prekey $predatum beginning} - {{-prevnodup} "" $prekey $predatum end} - } - - set txn "" - foreach pair $getops { - set op [lindex $pair 0] - puts "\tTest0$tnum: Get ($op) with $ndups duplicates,\ - cursor at the [lindex $pair 4]." - set db [eval {berkdb_open -create \ - -mode 0644} $omethod $encargs $args $testfile] - error_check_good "db open" [is_valid_db $db] TRUE - - if { $txnenv == 1 } { - set t [$env txn] - error_check_good txn \ - [is_valid_txn $t $env] TRUE - set txn "-txn $t" - } - set dbc [test085_setup $db $txn] - - set beginning [expr [string compare \ - [lindex $pair 4] "beginning"] == 0] - - for { set i 0 } { $i < $ndups } { incr i } { - if { $beginning } { - error_check_good db_put($i) \ - [eval {$db put} $txn \ - {$key [test085_ddatum $i]}] 0 - } else { - set c [eval {$db cursor} $txn] - set j [expr $ndups - $i - 1] - error_check_good db_cursor($j) \ - [is_valid_cursor $c $db] TRUE - set d [test085_ddatum $j] - error_check_good dbc_put($j) \ - [$c put -keyfirst $key $d] 0 - error_check_good c_close [$c close] 0 - } - } - - set gargs [lindex $pair 1] - set ekey "" - set edata "" - eval set ekey [lindex $pair 2] - eval set edata [lindex $pair 3] - - set dbt [eval $dbc get $op $gargs] - if { [string compare $ekey EMPTYLIST] == 0 } { - error_check_good dbt($op,$ndups) \ - [llength $dbt] 0 - } else { - error_check_good dbt($op,$ndups) $dbt \ - [list [list $ekey $edata]] - } - 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 - verify_dir $testdir "\t\t" - - # Remove testfile so we can do without truncate flag. - # This is okay because we've already done verify and - # dump/load. - if { $env == "NULL" } { - set ret [eval {berkdb dbremove} \ - $encargs $testfile] - } elseif { $txnenv == 1 } { - set ret [eval "$env dbremove" \ - -auto_commit $encargs $testfile] - } else { - set ret [eval {berkdb dbremove} \ - -env $env $encargs $testfile] - } - error_check_good dbremove $ret 0 - - } - - foreach pair $putops { - # Open and set up database. - set op [lindex $pair 0] - puts "\tTest0$tnum: Put ($op) with $ndups duplicates,\ - cursor at the [lindex $pair 4]." - set db [eval {berkdb_open -create \ - -mode 0644} $omethod $args $encargs $testfile] - error_check_good "db open" [is_valid_db $db] TRUE - - set beginning [expr [string compare \ - [lindex $pair 4] "beginning"] == 0] - - if { $txnenv == 1 } { - set t [$env txn] - error_check_good txn [is_valid_txn $t $env] TRUE - set txn "-txn $t" - } - set dbc [test085_setup $db $txn] - - # Put duplicates. - for { set i 0 } { $i < $ndups } { incr i } { - if { $beginning } { - error_check_good db_put($i) \ - [eval {$db put} $txn \ - {$key [test085_ddatum $i]}] 0 - } else { - set c [eval {$db cursor} $txn] - set j [expr $ndups - $i - 1] - error_check_good db_cursor($j) \ - [is_valid_cursor $c $db] TRUE - set d [test085_ddatum $j] - error_check_good dbc_put($j) \ - [$c put -keyfirst $key $d] 0 - error_check_good c_close [$c close] 0 - } - } - - # Set up cursors for stability test. - set pre_dbc [eval {$db cursor} $txn] - error_check_good pre_set [$pre_dbc get -set $prekey] \ - [list [list $prekey $predatum]] - set post_dbc [eval {$db cursor} $txn] - error_check_good post_set [$post_dbc get -set $postkey]\ - [list [list $postkey $postdatum]] - set first_dbc [eval {$db cursor} $txn] - error_check_good first_set \ - [$first_dbc get -get_both $key [test085_ddatum 0]] \ - [list [list $key [test085_ddatum 0]]] - set last_dbc [eval {$db cursor} $txn] - error_check_good last_set \ - [$last_dbc get -get_both $key [test085_ddatum \ - [expr $ndups - 1]]] \ - [list [list $key [test085_ddatum [expr $ndups -1]]]] - - set k [lindex $pair 1] - set d_before "" - set d_after "" - eval set d_before [lindex $pair 2] - eval set d_after [lindex $pair 3] - set newdatum "NewDatum" - error_check_good dbc_put($op,$ndups) \ - [eval $dbc put $op $k $newdatum] 0 - error_check_good dbc_prev($op,$ndups) \ - [lindex [lindex [$dbc get -prev] 0] 1] \ - $d_before - error_check_good dbc_current($op,$ndups) \ - [lindex [lindex [$dbc get -next] 0] 1] \ - $newdatum - - error_check_good dbc_next($op,$ndups) \ - [lindex [lindex [$dbc get -next] 0] 1] \ - $d_after - - # Verify stability of pre- and post- cursors. - error_check_good pre_stable [$pre_dbc get -current] \ - [list [list $prekey $predatum]] - error_check_good post_stable [$post_dbc get -current] \ - [list [list $postkey $postdatum]] - error_check_good first_stable \ - [$first_dbc get -current] \ - [list [list $key [test085_ddatum 0]]] - error_check_good last_stable \ - [$last_dbc get -current] \ - [list [list $key [test085_ddatum [expr $ndups -1]]]] - - foreach c "$pre_dbc $post_dbc $first_dbc $last_dbc" { - error_check_good ${c}_close [$c close] 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 - verify_dir $testdir "\t\t" - - # Remove testfile so we can do without truncate flag. - # This is okay because we've already done verify and - # dump/load. - if { $env == "NULL" } { - set ret [eval {berkdb dbremove} \ - $encargs $testfile] - } elseif { $txnenv == 1 } { - set ret [eval "$env dbremove" \ - -auto_commit $encargs $testfile] - } else { - set ret [eval {berkdb dbremove} \ - -env $env $encargs $testfile] - } - error_check_good dbremove $ret 0 - } - } -} - -# Set up the test database; put $prekey, $key, and $postkey with their -# respective data, and then delete $key with a new cursor. Return that -# cursor, still pointing to the deleted item. -proc test085_setup { db txn } { - upvar key key - upvar prekey prekey - upvar postkey postkey - upvar predatum predatum - upvar postdatum postdatum - - # no one else should ever see this one! - set datum "bbbbbbbb" - - error_check_good pre_put [eval {$db put} $txn {$prekey $predatum}] 0 - error_check_good main_put [eval {$db put} $txn {$key $datum}] 0 - error_check_good post_put [eval {$db put} $txn {$postkey $postdatum}] 0 - - set dbc [eval {$db cursor} $txn] - error_check_good db_cursor [is_valid_cursor $dbc $db] TRUE - - error_check_good dbc_getset [$dbc get -get_both $key $datum] \ - [list [list $key $datum]] - - error_check_good dbc_del [$dbc del] 0 - - return $dbc -} - -proc test085_ddatum { a } { - global alphabet - return $a$alphabet -} |