1# See the file LICENSE for redistribution information. 2# 3# Copyright (c) 1999,2008 Oracle. All rights reserved. 4# 5# $Id: test047.tcl,v 12.6 2008/01/08 20:58:53 bostic Exp $ 6# 7# TEST test047 8# TEST DBcursor->c_get get test with SET_RANGE option. 9proc test047 { method args } { 10 source ./include.tcl 11 12 set tnum 047 13 set args [convert_args $method $args] 14 15 if { [is_btree $method] != 1 } { 16 puts "Test$tnum skipping for method $method" 17 return 18 } 19 20 set method "-btree" 21 22 puts "\tTest$tnum: Test of SET_RANGE interface to DB->c_get ($method)." 23 24 set key "key" 25 set data "data" 26 set txn "" 27 set flags "" 28 29 puts "\tTest$tnum.a: Create $method database." 30 set eindex [lsearch -exact $args "-env"] 31 set txnenv 0 32 # 33 # If we are using an env, then testfile should just be the db name. 34 # Otherwise it is the test directory and the name. 35 if { $eindex == -1 } { 36 set testfile $testdir/test$tnum.db 37 set testfile1 $testdir/test$tnum.a.db 38 set testfile2 $testdir/test$tnum.b.db 39 set env NULL 40 } else { 41 set testfile test$tnum.db 42 set testfile1 test$tnum.a.db 43 set testfile2 test$tnum.b.db 44 incr eindex 45 set env [lindex $args $eindex] 46 set txnenv [is_txnenv $env] 47 if { $txnenv == 1 } { 48 append args " -auto_commit " 49 } 50 set testdir [get_home $env] 51 } 52 set t1 $testdir/t1 53 cleanup $testdir $env 54 55 set oflags "-create -mode 0644 -dup $args $method" 56 set db [eval {berkdb_open} $oflags $testfile] 57 error_check_good dbopen [is_valid_db $db] TRUE 58 59 set nkeys 20 60 # Fill page w/ small key/data pairs 61 # 62 puts "\tTest$tnum.b: Fill page with $nkeys small key/data pairs." 63 for { set i 0 } { $i < $nkeys } { incr i } { 64 if { $txnenv == 1 } { 65 set t [$env txn] 66 error_check_good txn [is_valid_txn $t $env] TRUE 67 set txn "-txn $t" 68 } 69 set ret [eval {$db put} $txn {$key$i $data$i}] 70 error_check_good dbput $ret 0 71 if { $txnenv == 1 } { 72 error_check_good txn [$t commit] 0 73 } 74 } 75 76 if { $txnenv == 1 } { 77 set t [$env txn] 78 error_check_good txn [is_valid_txn $t $env] TRUE 79 set txn "-txn $t" 80 } 81 # open curs to db 82 set dbc [eval {$db cursor} $txn] 83 error_check_good db_cursor [is_valid_cursor $dbc $db] TRUE 84 85 puts "\tTest$tnum.c: Get data with SET_RANGE, then delete by cursor." 86 set i 0 87 set ret [$dbc get -set_range $key$i] 88 error_check_bad dbc_get:set_range [llength $ret] 0 89 set curr $ret 90 91 # delete by cursor, make sure it is gone 92 error_check_good dbc_del [$dbc del] 0 93 94 set ret [$dbc get -set_range $key$i] 95 error_check_bad dbc_get(post-delete):set_range [llength $ret] 0 96 error_check_bad dbc_get(no-match):set_range $ret $curr 97 98 puts "\tTest$tnum.d: \ 99 Use another cursor to fix item on page, delete by db." 100 set dbcurs2 [eval {$db cursor} $txn] 101 error_check_good db:cursor2 [is_valid_cursor $dbcurs2 $db] TRUE 102 103 set ret [$dbcurs2 get -set [lindex [lindex $ret 0] 0]] 104 error_check_bad dbc_get(2):set [llength $ret] 0 105 set curr $ret 106 error_check_good db:del [eval {$db del} $txn \ 107 {[lindex [lindex $ret 0] 0]}] 0 108 109 # make sure item is gone 110 set ret [$dbcurs2 get -set_range [lindex [lindex $curr 0] 0]] 111 error_check_bad dbc2_get:set_range [llength $ret] 0 112 error_check_bad dbc2_get:set_range $ret $curr 113 114 puts "\tTest$tnum.e: Close for second part of test, close db/cursors." 115 error_check_good dbc:close [$dbc close] 0 116 error_check_good dbc2:close [$dbcurs2 close] 0 117 if { $txnenv == 1 } { 118 error_check_good txn [$t commit] 0 119 } 120 error_check_good dbclose [$db close] 0 121 122 # open db 123 set db [eval {berkdb_open} $oflags $testfile1] 124 error_check_good dbopen2 [is_valid_db $db] TRUE 125 126 set nkeys 10 127 puts "\tTest$tnum.f: Fill page with $nkeys pairs, one set of dups." 128 for {set i 0} { $i < $nkeys } {incr i} { 129 # a pair 130 if { $txnenv == 1 } { 131 set t [$env txn] 132 error_check_good txn [is_valid_txn $t $env] TRUE 133 set txn "-txn $t" 134 } 135 set ret [eval {$db put} $txn {$key$i $data$i}] 136 error_check_good dbput($i) $ret 0 137 if { $txnenv == 1 } { 138 error_check_good txn [$t commit] 0 139 } 140 } 141 142 set j 0 143 for {set i 0} { $i < $nkeys } {incr i} { 144 # a dup set for same 1 key 145 if { $txnenv == 1 } { 146 set t [$env txn] 147 error_check_good txn [is_valid_txn $t $env] TRUE 148 set txn "-txn $t" 149 } 150 set ret [eval {$db put} $txn {$key$i DUP_$data$i}] 151 error_check_good dbput($i):dup $ret 0 152 if { $txnenv == 1 } { 153 error_check_good txn [$t commit] 0 154 } 155 } 156 157 puts "\tTest$tnum.g: \ 158 Get dups key w/ SET_RANGE, pin onpage with another cursor." 159 set i 0 160 if { $txnenv == 1 } { 161 set t [$env txn] 162 error_check_good txn [is_valid_txn $t $env] TRUE 163 set txn "-txn $t" 164 } 165 set dbc [eval {$db cursor} $txn] 166 error_check_good db_cursor [is_valid_cursor $dbc $db] TRUE 167 set ret [$dbc get -set_range $key$i] 168 error_check_bad dbc_get:set_range [llength $ret] 0 169 170 set dbc2 [eval {$db cursor} $txn] 171 error_check_good db_cursor [is_valid_cursor $dbc2 $db] TRUE 172 set ret2 [$dbc2 get -set_range $key$i] 173 error_check_bad dbc2_get:set_range [llength $ret] 0 174 175 error_check_good dbc_compare $ret $ret2 176 puts "\tTest$tnum.h: \ 177 Delete duplicates' key, use SET_RANGE to get next dup." 178 set ret [$dbc2 del] 179 error_check_good dbc2_del $ret 0 180 set ret [$dbc get -set_range $key$i] 181 error_check_bad dbc_get:set_range [llength $ret] 0 182 error_check_bad dbc_get:set_range $ret $ret2 183 184 error_check_good dbc_close [$dbc close] 0 185 error_check_good dbc2_close [$dbc2 close] 0 186 if { $txnenv == 1 } { 187 error_check_good txn [$t commit] 0 188 } 189 error_check_good db_close [$db close] 0 190 191 set db [eval {berkdb_open} $oflags $testfile2] 192 error_check_good dbopen [is_valid_db $db] TRUE 193 194 set nkeys 10 195 set ndups 1000 196 197 puts "\tTest$tnum.i: Fill page with $nkeys pairs and $ndups dups." 198 for {set i 0} { $i < $nkeys } { incr i} { 199 # a pair 200 if { $txnenv == 1 } { 201 set t [$env txn] 202 error_check_good txn [is_valid_txn $t $env] TRUE 203 set txn "-txn $t" 204 } 205 set ret [eval {$db put} $txn {$key$i $data$i}] 206 error_check_good dbput $ret 0 207 208 # dups for single pair 209 if { $i == 0} { 210 for {set j 0} { $j < $ndups } { incr j } { 211 set ret [eval {$db put} $txn \ 212 {$key$i DUP_$data$i:$j}] 213 error_check_good dbput:dup $ret 0 214 } 215 } 216 if { $txnenv == 1 } { 217 error_check_good txn [$t commit] 0 218 } 219 } 220 set i 0 221 if { $txnenv == 1 } { 222 set t [$env txn] 223 error_check_good txn [is_valid_txn $t $env] TRUE 224 set txn "-txn $t" 225 } 226 set dbc [eval {$db cursor} $txn] 227 error_check_good db_cursor [is_valid_cursor $dbc $db] TRUE 228 set dbc2 [eval {$db cursor} $txn] 229 error_check_good db_cursor [is_valid_cursor $dbc2 $db] TRUE 230 puts "\tTest$tnum.j: \ 231 Get key of first dup with SET_RANGE, fix with 2 curs." 232 set ret [$dbc get -set_range $key$i] 233 error_check_bad dbc_get:set_range [llength $ret] 0 234 235 set ret2 [$dbc2 get -set_range $key$i] 236 error_check_bad dbc2_get:set_range [llength $ret] 0 237 set curr $ret2 238 239 error_check_good dbc_compare $ret $ret2 240 241 puts "\tTest$tnum.k: Delete item by cursor, use SET_RANGE to verify." 242 set ret [$dbc2 del] 243 error_check_good dbc2_del $ret 0 244 set ret [$dbc get -set_range $key$i] 245 error_check_bad dbc_get:set_range [llength $ret] 0 246 error_check_bad dbc_get:set_range $ret $curr 247 248 puts "\tTest$tnum.l: Cleanup." 249 error_check_good dbc_close [$dbc close] 0 250 error_check_good dbc2_close [$dbc2 close] 0 251 if { $txnenv == 1 } { 252 error_check_good txn [$t commit] 0 253 } 254 error_check_good db_close [$db close] 0 255 256 puts "\tTest$tnum complete." 257} 258