1# See the file LICENSE for redistribution information. 2# 3# Copyright (c) 1996-2009 Oracle. All rights reserved. 4# 5# $Id$ 6# 7# TEST test011 8# TEST Duplicate test 9# TEST Small key/data pairs. 10# TEST Test DB_KEYFIRST, DB_KEYLAST, DB_BEFORE and DB_AFTER. 11# TEST To test off-page duplicates, run with small pagesize. 12# TEST 13# TEST Use the first 10,000 entries from the dictionary. 14# TEST Insert each with self as key and data; add duplicate records for each. 15# TEST Then do some key_first/key_last add_before, add_after operations. 16# TEST This does not work for recno 17# TEST 18# TEST To test if dups work when they fall off the main page, run this with 19# TEST a very tiny page size. 20proc test011 { method {nentries 10000} {ndups 5} {tnum "011"} args } { 21 global dlist 22 global rand_init 23 source ./include.tcl 24 25 set dlist "" 26 27 # Btree with compression does not support unsorted duplicates. 28 if { [is_compressed $args] == 1 } { 29 puts "Test$tnum skipping for btree with compression." 30 return 31 } 32 33 if { [is_rbtree $method] == 1 } { 34 puts "Test$tnum skipping for method $method" 35 return 36 } 37 if { [is_record_based $method] == 1 } { 38 test011_recno $method $nentries $tnum $args 39 return 40 } 41 if {$ndups < 5} { 42 set ndups 5 43 } 44 45 set args [convert_args $method $args] 46 set omethod [convert_method $method] 47 48 berkdb srand $rand_init 49 50 # Create the database and open the dictionary 51 set txnenv 0 52 set eindex [lsearch -exact $args "-env"] 53 # 54 # If we are using an env, then testfile should just be the db name. 55 # Otherwise it is the test directory and the name. 56 if { $eindex == -1 } { 57 set testfile $testdir/test$tnum.db 58 set env NULL 59 } else { 60 set testfile test$tnum.db 61 incr eindex 62 set env [lindex $args $eindex] 63 set txnenv [is_txnenv $env] 64 if { $txnenv == 1 } { 65 append args " -auto_commit " 66 # 67 # If we are using txns and running with the 68 # default, set the default down a bit. 69 # 70 if { $nentries == 10000 } { 71 set nentries 100 72 } 73 reduce_dups nentries ndups 74 } 75 set testdir [get_home $env] 76 } 77 78 puts -nonewline "Test$tnum: $method $nentries small $ndups dup " 79 puts "key/data pairs, cursor ops" 80 81 set t1 $testdir/t1 82 set t2 $testdir/t2 83 set t3 $testdir/t3 84 cleanup $testdir $env 85 86 set db [eval {berkdb_open -create \ 87 -mode 0644} [concat $args "-dup"] {$omethod $testfile}] 88 error_check_good dbopen [is_valid_db $db] TRUE 89 90 set did [open $dict] 91 92 set pflags "" 93 set gflags "" 94 set txn "" 95 set count 0 96 97 # Here is the loop where we put and get each key/data pair 98 # We will add dups with values 1, 3, ... $ndups. Then we'll add 99 # 0 and $ndups+1 using keyfirst/keylast. We'll add 2 and 4 using 100 # add before and add after. 101 puts "\tTest$tnum.a: put and get duplicate keys." 102 set i "" 103 for { set i 1 } { $i <= $ndups } { incr i 2 } { 104 lappend dlist $i 105 } 106 set maxodd $i 107 while { [gets $did str] != -1 && $count < $nentries } { 108 for { set i 1 } { $i <= $ndups } { incr i 2 } { 109 set datastr $i:$str 110 if { $txnenv == 1 } { 111 set t [$env txn] 112 error_check_good txn [is_valid_txn $t $env] TRUE 113 set txn "-txn $t" 114 } 115 set ret [eval {$db put} $txn $pflags {$str $datastr}] 116 error_check_good put $ret 0 117 if { $txnenv == 1 } { 118 error_check_good txn [$t commit] 0 119 } 120 } 121 122 # Now retrieve all the keys matching this key 123 set x 1 124 if { $txnenv == 1 } { 125 set t [$env txn] 126 error_check_good txn [is_valid_txn $t $env] TRUE 127 set txn "-txn $t" 128 } 129 set dbc [eval {$db cursor} $txn] 130 for {set ret [$dbc get "-set" $str ]} \ 131 {[llength $ret] != 0} \ 132 {set ret [$dbc get "-next"] } { 133 if {[llength $ret] == 0} { 134 break 135 } 136 set k [lindex [lindex $ret 0] 0] 137 if { [string compare $k $str] != 0 } { 138 break 139 } 140 set datastr [lindex [lindex $ret 0] 1] 141 set d [data_of $datastr] 142 143 error_check_good Test$tnum:put $d $str 144 set id [ id_of $datastr ] 145 error_check_good Test$tnum:dup# $id $x 146 incr x 2 147 } 148 error_check_good Test$tnum:numdups $x $maxodd 149 error_check_good curs_close [$dbc close] 0 150 if { $txnenv == 1 } { 151 error_check_good txn [$t commit] 0 152 } 153 incr count 154 } 155 close $did 156 157 # Now we will get each key from the DB and compare the results 158 # to the original. 159 puts "\tTest$tnum.b: \ 160 traverse entire file checking duplicates before close." 161 if { $txnenv == 1 } { 162 set t [$env txn] 163 error_check_good txn [is_valid_txn $t $env] TRUE 164 set txn "-txn $t" 165 } 166 dup_check $db $txn $t1 $dlist 167 if { $txnenv == 1 } { 168 error_check_good txn [$t commit] 0 169 } 170 171 # Now compare the keys to see if they match the dictionary entries 172 set q q 173 filehead $nentries $dict $t3 174 filesort $t3 $t2 175 filesort $t1 $t3 176 177 error_check_good Test$tnum:diff($t3,$t2) \ 178 [filecmp $t3 $t2] 0 179 180 error_check_good db_close [$db close] 0 181 182 set db [eval {berkdb_open} $args $testfile] 183 error_check_good dbopen [is_valid_db $db] TRUE 184 185 puts "\tTest$tnum.c: \ 186 traverse entire file checking duplicates after close." 187 if { $txnenv == 1 } { 188 set t [$env txn] 189 error_check_good txn [is_valid_txn $t $env] TRUE 190 set txn "-txn $t" 191 } 192 dup_check $db $txn $t1 $dlist 193 if { $txnenv == 1 } { 194 error_check_good txn [$t commit] 0 195 } 196 197 # Now compare the keys to see if they match the dictionary entries 198 filesort $t1 $t3 199 error_check_good Test$tnum:diff($t3,$t2) \ 200 [filecmp $t3 $t2] 0 201 202 puts "\tTest$tnum.d: Testing key_first functionality" 203 if { $txnenv == 1 } { 204 set t [$env txn] 205 error_check_good txn [is_valid_txn $t $env] TRUE 206 set txn "-txn $t" 207 } 208 add_dup $db $txn $nentries "-keyfirst" 0 0 209 set dlist [linsert $dlist 0 0] 210 dup_check $db $txn $t1 $dlist 211 if { $txnenv == 1 } { 212 error_check_good txn [$t commit] 0 213 } 214 215 puts "\tTest$tnum.e: Testing key_last functionality" 216 if { $txnenv == 1 } { 217 set t [$env txn] 218 error_check_good txn [is_valid_txn $t $env] TRUE 219 set txn "-txn $t" 220 } 221 add_dup $db $txn $nentries "-keylast" [expr $maxodd - 1] 0 222 lappend dlist [expr $maxodd - 1] 223 dup_check $db $txn $t1 $dlist 224 if { $txnenv == 1 } { 225 error_check_good txn [$t commit] 0 226 } 227 228 puts "\tTest$tnum.f: Testing add_before functionality" 229 if { $txnenv == 1 } { 230 set t [$env txn] 231 error_check_good txn [is_valid_txn $t $env] TRUE 232 set txn "-txn $t" 233 } 234 add_dup $db $txn $nentries "-before" 2 3 235 set dlist [linsert $dlist 2 2] 236 dup_check $db $txn $t1 $dlist 237 if { $txnenv == 1 } { 238 error_check_good txn [$t commit] 0 239 } 240 241 puts "\tTest$tnum.g: Testing add_after functionality" 242 if { $txnenv == 1 } { 243 set t [$env txn] 244 error_check_good txn [is_valid_txn $t $env] TRUE 245 set txn "-txn $t" 246 } 247 add_dup $db $txn $nentries "-after" 4 4 248 set dlist [linsert $dlist 4 4] 249 dup_check $db $txn $t1 $dlist 250 if { $txnenv == 1 } { 251 error_check_good txn [$t commit] 0 252 } 253 254 error_check_good db_close [$db close] 0 255} 256 257proc add_dup {db txn nentries flag dataval iter} { 258 source ./include.tcl 259 260 set dbc [eval {$db cursor} $txn] 261 set did [open $dict] 262 set count 0 263 while { [gets $did str] != -1 && $count < $nentries } { 264 set datastr $dataval:$str 265 set ret [$dbc get "-set" $str] 266 error_check_bad "cget(SET)" [is_substr $ret Error] 1 267 for { set i 1 } { $i < $iter } { incr i } { 268 set ret [$dbc get "-next"] 269 error_check_bad "cget(NEXT)" [is_substr $ret Error] 1 270 } 271 272 if { [string compare $flag "-before"] == 0 || 273 [string compare $flag "-after"] == 0 } { 274 set ret [$dbc put $flag $datastr] 275 } else { 276 set ret [$dbc put $flag $str $datastr] 277 } 278 error_check_good "$dbc put $flag" $ret 0 279 incr count 280 } 281 close $did 282 $dbc close 283} 284 285proc test011_recno { method {nentries 10000} {tnum "011"} largs } { 286 global dlist 287 source ./include.tcl 288 289 set largs [convert_args $method $largs] 290 set omethod [convert_method $method] 291 set renum [is_rrecno $method] 292 293 puts "Test$tnum: \ 294 $method ($largs) $nentries test cursor insert functionality" 295 296 # Create the database and open the dictionary 297 set eindex [lsearch -exact $largs "-env"] 298 # 299 # If we are using an env, then testfile should just be the db name. 300 # Otherwise it is the test directory and the name. 301 set txnenv 0 302 if { $eindex == -1 } { 303 set testfile $testdir/test$tnum.db 304 set env NULL 305 } else { 306 set testfile test$tnum.db 307 incr eindex 308 set env [lindex $largs $eindex] 309 set txnenv [is_txnenv $env] 310 if { $txnenv == 1 } { 311 append largs " -auto_commit " 312 # 313 # If we are using txns and running with the 314 # default, set the default down a bit. 315 # 316 if { $nentries == 10000 } { 317 set nentries 100 318 } 319 } 320 set testdir [get_home $env] 321 } 322 set t1 $testdir/t1 323 set t2 $testdir/t2 324 set t3 $testdir/t3 325 cleanup $testdir $env 326 327 if {$renum == 1} { 328 append largs " -renumber" 329 } 330 set db [eval {berkdb_open \ 331 -create -mode 0644} $largs {$omethod $testfile}] 332 error_check_good dbopen [is_valid_db $db] TRUE 333 334 set did [open $dict] 335 336 set pflags "" 337 set gflags "" 338 set txn "" 339 set count 0 340 341 # The basic structure of the test is that we pick a random key 342 # in the database and then add items before, after, ?? it. The 343 # trickiness is that with RECNO, these are not duplicates, they 344 # are creating new keys. Therefore, every time we do this, the 345 # keys assigned to other values change. For this reason, we'll 346 # keep the database in tcl as a list and insert properly into 347 # it to verify that the right thing is happening. If we do not 348 # have renumber set, then the BEFORE and AFTER calls should fail. 349 350 # Seed the database with an initial record 351 gets $did str 352 if { $txnenv == 1 } { 353 set t [$env txn] 354 error_check_good txn [is_valid_txn $t $env] TRUE 355 set txn "-txn $t" 356 } 357 set ret [eval {$db put} $txn {1 [chop_data $method $str]}] 358 if { $txnenv == 1 } { 359 error_check_good txn [$t commit] 0 360 } 361 error_check_good put $ret 0 362 set count 1 363 364 set dlist "NULL $str" 365 366 # Open a cursor 367 if { $txnenv == 1 } { 368 set t [$env txn] 369 error_check_good txn [is_valid_txn $t $env] TRUE 370 set txn "-txn $t" 371 } 372 set dbc [eval {$db cursor} $txn] 373 puts "\tTest$tnum.a: put and get entries" 374 while { [gets $did str] != -1 && $count < $nentries } { 375 # Pick a random key 376 set key [berkdb random_int 1 $count] 377 set ret [$dbc get -set $key] 378 set k [lindex [lindex $ret 0] 0] 379 set d [lindex [lindex $ret 0] 1] 380 error_check_good cget:SET:key $k $key 381 error_check_good \ 382 cget:SET $d [pad_data $method [lindex $dlist $key]] 383 384 # Current 385 set ret [$dbc put -current [chop_data $method $str]] 386 error_check_good cput:$key $ret 0 387 set dlist [lreplace $dlist $key $key [pad_data $method $str]] 388 389 # Before 390 if { [gets $did str] == -1 } { 391 continue; 392 } 393 394 if { $renum == 1 } { 395 set ret [$dbc put \ 396 -before [chop_data $method $str]] 397 error_check_good cput:$key:BEFORE $ret $key 398 set dlist [linsert $dlist $key $str] 399 incr count 400 401 # After 402 if { [gets $did str] == -1 } { 403 continue; 404 } 405 set ret [$dbc put \ 406 -after [chop_data $method $str]] 407 error_check_good cput:$key:AFTER $ret [expr $key + 1] 408 set dlist [linsert $dlist [expr $key + 1] $str] 409 incr count 410 } 411 412 # Now verify that the keys are in the right place 413 set i 0 414 for {set ret [$dbc get "-set" $key]} \ 415 {[string length $ret] != 0 && $i < 3} \ 416 {set ret [$dbc get "-next"] } { 417 set check_key [expr $key + $i] 418 419 set k [lindex [lindex $ret 0] 0] 420 error_check_good cget:$key:loop $k $check_key 421 422 set d [lindex [lindex $ret 0] 1] 423 error_check_good cget:data $d \ 424 [pad_data $method [lindex $dlist $check_key]] 425 incr i 426 } 427 } 428 close $did 429 error_check_good cclose [$dbc close] 0 430 if { $txnenv == 1 } { 431 error_check_good txn [$t commit] 0 432 } 433 434 # Create check key file. 435 set oid [open $t2 w] 436 for {set i 1} {$i <= $count} {incr i} { 437 puts $oid $i 438 } 439 close $oid 440 441 puts "\tTest$tnum.b: dump file" 442 if { $txnenv == 1 } { 443 set t [$env txn] 444 error_check_good txn [is_valid_txn $t $env] TRUE 445 set txn "-txn $t" 446 } 447 dump_file $db $txn $t1 test011_check 448 if { $txnenv == 1 } { 449 error_check_good txn [$t commit] 0 450 } 451 error_check_good Test$tnum:diff($t2,$t1) \ 452 [filecmp $t2 $t1] 0 453 454 error_check_good db_close [$db close] 0 455 456 puts "\tTest$tnum.c: close, open, and dump file" 457 eval open_and_dump_file $testfile $env $t1 test011_check \ 458 dump_file_direction "-first" "-next" $largs 459 error_check_good Test$tnum:diff($t2,$t1) \ 460 [filecmp $t2 $t1] 0 461 462 puts "\tTest$tnum.d: close, open, and dump file in reverse direction" 463 eval open_and_dump_file $testfile $env $t1 test011_check \ 464 dump_file_direction "-last" "-prev" $largs 465 466 filesort $t1 $t3 -n 467 error_check_good Test$tnum:diff($t2,$t3) \ 468 [filecmp $t2 $t3] 0 469} 470 471proc test011_check { key data } { 472 global dlist 473 474 error_check_good "get key $key" $data [lindex $dlist $key] 475} 476