1# See the file LICENSE for redistribution information. 2# 3# Copyright (c) 1999,2008 Oracle. All rights reserved. 4# 5# $Id: test067.tcl,v 12.6 2008/01/08 20:58:53 bostic Exp $ 6# 7# TEST test067 8# TEST Test of DB_CURRENT partial puts onto almost empty duplicate 9# TEST pages, with and without DB_DUP_SORT. 10# TEST 11# TEST Test of DB_CURRENT partial puts on almost-empty duplicate pages. 12# TEST This test was written to address the following issue, #2 in the 13# TEST list of issues relating to bug #0820: 14# TEST 15# TEST 2. DBcursor->put, DB_CURRENT flag, off-page duplicates, hash and btree: 16# TEST In Btree, the DB_CURRENT overwrite of off-page duplicate records 17# TEST first deletes the record and then puts the new one -- this could 18# TEST be a problem if the removal of the record causes a reverse split. 19# TEST Suggested solution is to acquire a cursor to lock down the current 20# TEST record, put a new record after that record, and then delete using 21# TEST the held cursor. 22# TEST 23# TEST It also tests the following, #5 in the same list of issues: 24# TEST 5. DBcursor->put, DB_AFTER/DB_BEFORE/DB_CURRENT flags, DB_DBT_PARTIAL 25# TEST set, duplicate comparison routine specified. 26# TEST The partial change does not change how data items sort, but the 27# TEST record to be put isn't built yet, and that record supplied is the 28# TEST one that's checked for ordering compatibility. 29proc test067 { method {ndups 1000} {tnum "067"} args } { 30 source ./include.tcl 31 global alphabet 32 global errorCode 33 global is_je_test 34 35 set args [convert_args $method $args] 36 set omethod [convert_method $method] 37 38 set txn "" 39 set txnenv 0 40 set eindex [lsearch -exact $args "-env"] 41 42 # If we are using an env, then testfile should just be the db name. 43 # Otherwise it is the test directory and the name. 44 if { $eindex == -1 } { 45 set testfile $testdir/test$tnum.db 46 set env NULL 47 } else { 48 set testfile test$tnum.db 49 incr eindex 50 set env [lindex $args $eindex] 51 set txnenv [is_txnenv $env] 52 if { $txnenv == 1 } { 53 append args " -auto_commit " 54 if { $ndups == 1000 } { 55 set ndups 100 56 } 57 } 58 set testdir [get_home $env] 59 } 60 61 cleanup $testdir $env 62 if { [is_record_based $method] == 1 || [is_rbtree $method] == 1 } { 63 puts "\tTest$tnum: skipping for method $method." 64 return 65 } 66 67 puts "Test$tnum:\ 68 $method ($args) Partial puts on near-empty duplicate pages." 69 70 foreach dupopt { "-dup" "-dup -dupsort" } { 71 if { $is_je_test && $dupopt == "-dup" } { 72 continue 73 } 74 75 # 76 # Testdir might get reset from the env's home dir back 77 # to the default if this calls something that sources 78 # include.tcl, since testdir is a global. Set it correctly 79 # here each time through the loop. 80 # 81 if { $env != "NULL" } { 82 set testdir [get_home $env] 83 } 84 cleanup $testdir $env 85 set db [eval {berkdb_open -create -mode 0644 \ 86 $omethod} $args $dupopt {$testfile}] 87 error_check_good db_open [is_valid_db $db] TRUE 88 89 puts "\tTest$tnum.a ($dupopt): Put $ndups duplicates." 90 91 set key "key_test$tnum" 92 93 for { set ndx 0 } { $ndx < $ndups } { incr ndx } { 94 set data $alphabet$ndx 95 96 if { $txnenv == 1 } { 97 set t [$env txn] 98 error_check_good txn [is_valid_txn $t $env] TRUE 99 set txn "-txn $t" 100 } 101 # No need for pad_data since we're skipping recno. 102 set ret [eval {$db put} $txn {$key $data}] 103 error_check_good put($key,$data) $ret 0 104 if { $txnenv == 1 } { 105 error_check_good txn [$t commit] 0 106 } 107 } 108 109 # Sync so we can inspect database if the next section bombs. 110 error_check_good db_sync [$db sync] 0 111 puts "\tTest$tnum.b ($dupopt):\ 112 Deleting dups (last first), overwriting each." 113 114 if { $txnenv == 1 } { 115 set t [$env txn] 116 error_check_good txn [is_valid_txn $t $env] TRUE 117 set txn "-txn $t" 118 } 119 set dbc [eval {$db cursor} $txn] 120 error_check_good cursor_create [is_valid_cursor $dbc $db] TRUE 121 122 set count 0 123 while { $count < $ndups - 1 } { 124 # set cursor to last item in db 125 set ret [$dbc get -last] 126 error_check_good \ 127 verify_key [lindex [lindex $ret 0] 0] $key 128 129 # for error reporting 130 set currdatum [lindex [lindex $ret 0] 1] 131 132 # partial-overwrite it 133 # (overwrite offsets 1-4 with "bcde"--which they 134 # already are) 135 136 # Even though we expect success, we catch this 137 # since it might return EINVAL, and we want that 138 # to FAIL. 139 set errorCode NONE 140 set ret [catch {eval $dbc put -current \ 141 {-partial [list 1 4]} "bcde"} \ 142 res] 143 error_check_good \ 144 partial_put_valid($currdatum) $errorCode NONE 145 error_check_good partial_put($currdatum) $res 0 146 147 # delete it 148 error_check_good dbc_del [$dbc del] 0 149 150 #puts $currdatum 151 152 incr count 153 } 154 155 error_check_good dbc_close [$dbc close] 0 156 if { $txnenv == 1 } { 157 error_check_good txn [$t commit] 0 158 } 159 error_check_good db_close [$db close] 0 160 } 161} 162