test/tcl/test011.tcl

   1 # See the file LICENSE for redistribution information.
   2 #
   3 # Copyright (c) 1996, 2012 Oracle and/or its affiliates.  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.
  20 proc 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
 257 proc 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
 285 proc 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
 471 proc test011_check { key data } {
 472         global dlist
 473
 474         error_check_good "get key $key" $data [lindex $dlist $key]
 475 }