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