test/tcl/mdbscript.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 # Process script for the multi-process db tester.
   8
   9 source ./include.tcl
  10 source $test_path/test.tcl
  11 source $test_path/testutils.tcl
  12
  13 global dbenv
  14 global klock
  15 global l_keys
  16 global procid
  17 global alphabet
  18
  19 # In Tcl, when there are multiple catch handlers, *all* handlers
  20 # are called, so we have to resort to this hack.
  21 #
  22 global exception_handled
  23
  24 set exception_handled 0
  25
  26 set datastr $alphabet$alphabet
  27
  28 # Usage: mdbscript dir file nentries iter procid procs seed
  29 # dir: DBHOME directory
  30 # file: db file on which to operate
  31 # nentries: number of entries taken from dictionary
  32 # iter: number of operations to run
  33 # procid: this processes' id number
  34 # procs: total number of processes running
  35 set usage "mdbscript method dir file nentries iter procid procs"
  36
  37 # Verify usage
  38 if { $argc < 7 } {
  39         puts "FAIL:[timestamp] test042: Usage: $usage"
  40         exit
  41 }
  42
  43 # Initialize arguments
  44 set method [lindex $argv 0]
  45 set dir [lindex $argv 1]
  46 set file [lindex $argv 2]
  47 set nentries [ lindex $argv 3 ]
  48 set iter [ lindex $argv 4 ]
  49 set procid [ lindex $argv 5 ]
  50 set procs [ lindex $argv 6 ]
  51 set args [ lindex $argv 7 ]
  52
  53 set pflags ""
  54 set gflags ""
  55 set txn ""
  56
  57 set renum [is_rrecno $method]
  58 set omethod [convert_method $method]
  59
  60 if { [is_record_based $method] == 1 } {
  61    append gflags " -recno"
  62 }
  63
  64 # Initialize seed
  65 global rand_init
  66
  67 # We want repeatable results, but we also want each instance of mdbscript
  68 # to do something different.  So we add the procid to the fixed seed.
  69 # (Note that this is a serial number given by the caller, not a pid.)
  70 berkdb srand [expr $rand_init + $procid]
  71
  72 puts "Beginning execution for [pid] $method"
  73 puts "$dir db_home"
  74 puts "$file database"
  75 puts "$nentries data elements"
  76 puts "$iter iterations"
  77 puts "$procid process id"
  78 puts "$procs processes"
  79 eval set args $args
  80 puts "args: $args"
  81
  82 set klock NOLOCK
  83
  84 # Note: all I/O operations, and especially flush, are expensive
  85 # on Win2000 at least with Tcl version 8.3.2.  So we'll avoid
  86 # flushes in the main part of the loop below.
  87 flush stdout
  88
  89 set dbenv [berkdb_env -create -cdb -home $dir]
  90 #set dbenv [berkdb_env -create -cdb -log -home $dir]
  91 error_check_good dbenv [is_valid_env $dbenv] TRUE
  92
  93 set locker [ $dbenv lock_id ]
  94
  95 set db [eval {berkdb_open} -env $dbenv $omethod $args {$file}]
  96 error_check_good dbopen [is_valid_db $db] TRUE
  97
  98 # Init globals (no data)
  99 set nkeys [db_init $db 0]
 100 puts "Initial number of keys: $nkeys"
 101 tclsleep 5
 102
 103 proc get_lock { k } {
 104         global dbenv
 105         global procid
 106         global locker
 107         global klock
 108         global DB_LOCK_WRITE
 109         global DB_LOCK_NOWAIT
 110         global errorInfo
 111         global exception_handled
 112         # Make sure that the key isn't in the middle of
 113         # a delete operation
 114         if {[catch {$dbenv lock_get -nowait write $locker $k} klock] != 0 } {
 115                 set exception_handled 1
 116
 117                 error_check_good \
 118                     get_lock [is_substr $errorInfo "DB_LOCK_NOTGRANTED"] 1
 119                 puts "Warning: key $k locked"
 120                 set klock NOLOCK
 121                 return 1
 122         } else  {
 123                 error_check_good get_lock [is_valid_lock $klock $dbenv] TRUE
 124         }
 125         return 0
 126 }
 127
 128 # If we are renumbering, then each time we delete an item, the number of
 129 # items in the file is temporarily decreased, so the highest record numbers
 130 # do not exist.  To make sure this doesn't happen, we never generate the
 131 # highest few record numbers as keys.
 132 #
 133 # For record-based methods, record numbers begin at 1, while for other keys,
 134 # we begin at 0 to index into an array.
 135 proc rand_key { method nkeys renum procs} {
 136         if { $renum == 1 } {
 137                 return [berkdb random_int 1 [expr $nkeys - $procs]]
 138         } elseif { [is_record_based $method] == 1 } {
 139                 return [berkdb random_int 1 $nkeys]
 140         } else {
 141                 return [berkdb random_int 0 [expr $nkeys - 1]]
 142         }
 143 }
 144
 145 # On each iteration we're going to randomly pick a key.
 146 # 1. We'll either get it (verifying that its contents are reasonable).
 147 # 2. Put it (using an overwrite to make the data be datastr:ID).
 148 # 3. Get it and do a put through the cursor, tacking our ID on to
 149 # 4. Get it, read forward some random number of keys.
 150 # 5. Get it, read forward some random number of keys and do a put (replace).
 151 # 6. Get it, read forward some random number of keys and do a del.  And then
 152 #       do a put of the key.
 153 set gets 0
 154 set getput 0
 155 set overwrite 0
 156 set seqread 0
 157 set seqput 0
 158 set seqdel 0
 159 set dlen [string length $datastr]
 160
 161 for { set i 0 } { $i < $iter } { incr i } {
 162         set op [berkdb random_int 0 5]
 163         puts "iteration $i operation $op"
 164         set close_cursor 0
 165         if {[catch {
 166         switch $op {
 167                 0 {
 168                         incr gets
 169                         set k [rand_key $method $nkeys $renum $procs]
 170                         if {[is_record_based $method] == 1} {
 171                                 set key $k
 172                         } else  {
 173                                 set key [lindex $l_keys $k]
 174                         }
 175
 176                         if { [get_lock $key] == 1 } {
 177                                 incr i -1
 178                                 continue;
 179                         }
 180
 181                         set rec [eval {$db get} $txn $gflags {$key}]
 182                         error_check_bad "$db get $key" [llength $rec] 0
 183                         set partial [string range \
 184                             [lindex [lindex $rec 0] 1] 0 [expr $dlen - 1]]
 185                         error_check_good \
 186                             "$db get $key" $partial [pad_data $method $datastr]
 187                 }
 188                 1 {
 189                         incr overwrite
 190                         set k [rand_key $method $nkeys $renum $procs]
 191                         if {[is_record_based $method] == 1} {
 192                                 set key $k
 193                         } else  {
 194                                 set key [lindex $l_keys $k]
 195                         }
 196
 197                         set data $datastr:$procid
 198                         set ret [eval {$db put} \
 199                             $txn $pflags {$key [chop_data $method $data]}]
 200                         error_check_good "$db put $key" $ret 0
 201                 }
 202                 2 {
 203                         incr getput
 204                         set dbc [$db cursor -update]
 205                         error_check_good "$db cursor" \
 206                             [is_valid_cursor $dbc $db] TRUE
 207                         set close_cursor 1
 208                         set k [rand_key $method $nkeys $renum $procs]
 209                         if {[is_record_based $method] == 1} {
 210                                 set key $k
 211                         } else  {
 212                                 set key [lindex $l_keys $k]
 213                         }
 214
 215                         if { [get_lock  $key] == 1 } {
 216                                 incr i -1
 217                                 error_check_good "$dbc close" \
 218                                     [$dbc close] 0
 219                                 set close_cursor 0
 220                                 continue;
 221                         }
 222
 223                         set ret [$dbc get -set $key]
 224                         error_check_good \
 225                             "$dbc get $key" [llength [lindex $ret 0]] 2
 226                         set rec [lindex [lindex $ret 0] 1]
 227                         set partial [string range $rec 0 [expr $dlen - 1]]
 228                         error_check_good \
 229                             "$dbc get $key" $partial [pad_data $method $datastr]
 230                         append rec ":$procid"
 231                         set ret [$dbc put \
 232                             -current [chop_data $method $rec]]
 233                         error_check_good "$dbc put $key" $ret 0
 234                         error_check_good "$dbc close" [$dbc close] 0
 235                         set close_cursor 0
 236                 }
 237                 3 -
 238                 4 -
 239                 5 {
 240                         if { $op == 3 } {
 241                                 set flags ""
 242                         } else {
 243                                 set flags -update
 244                         }
 245                         set dbc [eval {$db cursor} $flags]
 246                         error_check_good "$db cursor" \
 247                             [is_valid_cursor $dbc $db] TRUE
 248                         set close_cursor 1
 249                         set k [rand_key $method $nkeys $renum $procs]
 250                         if {[is_record_based $method] == 1} {
 251                                 set key $k
 252                         } else  {
 253                                 set key [lindex $l_keys $k]
 254                         }
 255
 256                         if { [get_lock $key] == 1 } {
 257                                 incr i -1
 258                                 error_check_good "$dbc close" \
 259                                     [$dbc close] 0
 260                                 set close_cursor 0
 261                                 continue;
 262                         }
 263
 264                         set ret [$dbc get -set $key]
 265                         error_check_good \
 266                             "$dbc get $key" [llength [lindex $ret 0]] 2
 267
 268                         # Now read a few keys sequentially
 269                         set nloop [berkdb random_int 0 10]
 270                         if { [berkdb random_int 0 1] == 0 } {
 271                                 set flags -next
 272                         } else {
 273                                 set flags -prev
 274                         }
 275                         while { $nloop > 0 } {
 276                                 set lastret $ret
 277                                 set ret [eval {$dbc get} $flags]
 278                                 # Might read beginning/end of file
 279                                 if { [llength $ret] == 0} {
 280                                         set ret $lastret
 281                                         break
 282                                 }
 283                                 incr nloop -1
 284                         }
 285                         switch $op {
 286                                 3 {
 287                                         incr seqread
 288                                 }
 289                                 4 {
 290                                         incr seqput
 291                                         set rec [lindex [lindex $ret 0] 1]
 292                                         set partial [string range $rec 0 \
 293                                             [expr $dlen - 1]]
 294                                         error_check_good "$dbc get $key" \
 295                                             $partial [pad_data $method $datastr]
 296                                         append rec ":$procid"
 297                                         set ret [$dbc put -current \
 298                                             [chop_data $method $rec]]
 299                                         error_check_good \
 300                                             "$dbc put $key" $ret 0
 301                                 }
 302                                 5 {
 303                                         incr seqdel
 304                                         set k [lindex [lindex $ret 0] 0]
 305                                         # We need to lock the item we're
 306                                         # deleting so that someone else can't
 307                                         # try to do a get while we're
 308                                         # deleting
 309                                         error_check_good "$klock put" \
 310                                             [$klock put] 0
 311                                         set klock NOLOCK
 312                                         set cur [$dbc get -current]
 313                                         error_check_bad get_current \
 314                                             [llength $cur] 0
 315                                         set key [lindex [lindex $cur 0] 0]
 316                                         if { [get_lock $key] == 1 } {
 317                                                 incr i -1
 318                                                 error_check_good "$dbc close" \
 319                                                      [$dbc close] 0
 320                                                 set close_cursor 0
 321                                                 continue
 322                                         }
 323                                         set ret [$dbc del]
 324                                         error_check_good "$dbc del" $ret 0
 325                                         set rec $datastr
 326                                         append rec ":$procid"
 327                                         if { $renum == 1 } {
 328                                                 set ret [$dbc put -before \
 329                                                     [chop_data $method $rec]]
 330                                                 error_check_good \
 331                                                     "$dbc put $k" $ret $k
 332                                         } elseif { \
 333                                             [is_record_based $method] == 1 } {
 334                                                 error_check_good "$dbc close" \
 335                                                     [$dbc close] 0
 336                                                 set close_cursor 0
 337                                                 set ret [$db put $k \
 338                                                     [chop_data $method $rec]]
 339                                                 error_check_good \
 340                                                     "$db put $k" $ret 0
 341                                         } else {
 342                                                 set ret [$dbc put -keylast $k \
 343                                                     [chop_data $method $rec]]
 344                                                 error_check_good \
 345                                                     "$dbc put $k" $ret 0
 346                                         }
 347                                 }
 348                         }
 349                         if { $close_cursor == 1 } {
 350                                 error_check_good \
 351                                     "$dbc close" [$dbc close] 0
 352                                 set close_cursor 0
 353                         }
 354                 }
 355         }
 356         } res] != 0} {
 357                 global errorInfo;
 358                 global exception_handled;
 359
 360 #               puts $errorInfo
 361
 362                 set fnl [string first "\n" $errorInfo]
 363                 set theError [string range $errorInfo 0 [expr $fnl - 1]]
 364
 365                 if { [string compare $klock NOLOCK] != 0 } {
 366                         catch {$klock put}
 367                 }
 368                 if {$close_cursor == 1} {
 369                         catch {$dbc close}
 370                         set close_cursor 0
 371                 }
 372
 373                 if {[string first FAIL $theError] == 0 && \
 374                     $exception_handled != 1} {
 375                         flush stdout
 376                         error "FAIL:[timestamp] test042: key $k: $theError"
 377                 }
 378                 set exception_handled 0
 379         } else {
 380                 if { [string compare $klock NOLOCK] != 0 } {
 381                         error_check_good "$klock put" [$klock put] 0
 382                         set klock NOLOCK
 383                 }
 384         }
 385 }
 386
 387 error_check_good db_close_catch [catch {$db close} ret] 0
 388 error_check_good db_close $ret 0
 389 error_check_good dbenv_close [$dbenv close] 0
 390
 391 flush stdout
 392 exit
 393
 394 puts "[timestamp] [pid] Complete"
 395 puts "Successful ops: "
 396 puts "\t$gets gets"
 397 puts "\t$overwrite overwrites"
 398 puts "\t$getput getputs"
 399 puts "\t$seqread seqread"
 400 puts "\t$seqput seqput"
 401 puts "\t$seqdel seqdel"
 402 flush stdout