1# See the file LICENSE for redistribution information. 2# 3# Copyright (c) 1996,2008 Oracle. All rights reserved. 4# 5# $Id: dbscript.tcl,v 12.6 2008/01/08 20:58:53 bostic Exp $ 6# 7# Random db tester. 8# Usage: dbscript file numops min_del max_add key_avg data_avgdups 9# method: method (we pass this in so that fixed-length records work) 10# file: db file on which to operate 11# numops: number of operations to do 12# ncurs: number of cursors 13# min_del: minimum number of keys before you disable deletes. 14# max_add: maximum number of keys before you disable adds. 15# key_avg: average key size 16# data_avg: average data size 17# dups: 1 indicates dups allowed, 0 indicates no dups 18# errpct: What percent of operations should generate errors 19# seed: Random number generator seed (-1 means use pid) 20 21source ./include.tcl 22source $test_path/test.tcl 23source $test_path/testutils.tcl 24 25set usage "dbscript file numops ncurs min_del max_add key_avg data_avg dups errpcnt" 26 27# Verify usage 28if { $argc != 10 } { 29 puts stderr "FAIL:[timestamp] Usage: $usage" 30 exit 31} 32 33# Initialize arguments 34set method [lindex $argv 0] 35set file [lindex $argv 1] 36set numops [ lindex $argv 2 ] 37set ncurs [ lindex $argv 3 ] 38set min_del [ lindex $argv 4 ] 39set max_add [ lindex $argv 5 ] 40set key_avg [ lindex $argv 6 ] 41set data_avg [ lindex $argv 7 ] 42set dups [ lindex $argv 8 ] 43set errpct [ lindex $argv 9 ] 44 45berkdb srand $rand_init 46 47puts "Beginning execution for [pid]" 48puts "$file database" 49puts "$numops Operations" 50puts "$ncurs cursors" 51puts "$min_del keys before deletes allowed" 52puts "$max_add or fewer keys to add" 53puts "$key_avg average key length" 54puts "$data_avg average data length" 55if { $dups != 1 } { 56 puts "No dups" 57} else { 58 puts "Dups allowed" 59} 60puts "$errpct % Errors" 61 62flush stdout 63 64set db [berkdb_open $file] 65set cerr [catch {error_check_good dbopen [is_substr $db db] 1} cret] 66if {$cerr != 0} { 67 puts $cret 68 return 69} 70# set method [$db get_type] 71set record_based [is_record_based $method] 72 73# Initialize globals including data 74global nkeys 75global l_keys 76global a_keys 77 78set nkeys [db_init $db 1] 79puts "Initial number of keys: $nkeys" 80 81set pflags "" 82set gflags "" 83set txn "" 84 85# Open the cursors 86set curslist {} 87for { set i 0 } { $i < $ncurs } { incr i } { 88 set dbc [$db cursor] 89 set cerr [catch {error_check_good dbopen [is_substr $dbc $db.c] 1} cret] 90 if {$cerr != 0} { 91 puts $cret 92 return 93 } 94 set cerr [catch {error_check_bad cursor_create $dbc NULL} cret] 95 if {$cerr != 0} { 96 puts $cret 97 return 98 } 99 lappend curslist $dbc 100 101} 102 103# On each iteration we're going to generate random keys and 104# data. We'll select either a get/put/delete operation unless 105# we have fewer than min_del keys in which case, delete is not 106# an option or more than max_add in which case, add is not 107# an option. The tcl global arrays a_keys and l_keys keep track 108# of key-data pairs indexed by key and a list of keys, accessed 109# by integer. 110set adds 0 111set puts 0 112set gets 0 113set dels 0 114set bad_adds 0 115set bad_puts 0 116set bad_gets 0 117set bad_dels 0 118 119for { set iter 0 } { $iter < $numops } { incr iter } { 120 set op [pick_op $min_del $max_add $nkeys] 121 set err [is_err $errpct] 122 123 # The op0's indicate that there aren't any duplicates, so we 124 # exercise regular operations. If dups is 1, then we'll use 125 # cursor ops. 126 switch $op$dups$err { 127 add00 { 128 incr adds 129 130 set k [random_data $key_avg 1 a_keys $record_based] 131 set data [random_data $data_avg 0 0] 132 set data [chop_data $method $data] 133 set ret [eval {$db put} $txn $pflags \ 134 {-nooverwrite $k $data}] 135 set cerr [catch {error_check_good put $ret 0} cret] 136 if {$cerr != 0} { 137 puts $cret 138 return 139 } 140 newpair $k [pad_data $method $data] 141 } 142 add01 { 143 incr bad_adds 144 set k [random_key] 145 set data [random_data $data_avg 0 0] 146 set data [chop_data $method $data] 147 set ret [eval {$db put} $txn $pflags \ 148 {-nooverwrite $k $data}] 149 set cerr [catch {error_check_good put $ret 0} cret] 150 if {$cerr != 0} { 151 puts $cret 152 return 153 } 154 # Error case so no change to data state 155 } 156 add10 { 157 incr adds 158 set dbcinfo [random_cursor $curslist] 159 set dbc [lindex $dbcinfo 0] 160 if { [berkdb random_int 1 2] == 1 } { 161 # Add a new key 162 set k [random_data $key_avg 1 a_keys \ 163 $record_based] 164 set data [random_data $data_avg 0 0] 165 set data [chop_data $method $data] 166 set ret [eval {$dbc put} $txn \ 167 {-keyfirst $k $data}] 168 newpair $k [pad_data $method $data] 169 } else { 170 # Add a new duplicate 171 set dbc [lindex $dbcinfo 0] 172 set k [lindex $dbcinfo 1] 173 set data [random_data $data_avg 0 0] 174 175 set op [pick_cursput] 176 set data [chop_data $method $data] 177 set ret [eval {$dbc put} $txn {$op $k $data}] 178 adddup $k [lindex $dbcinfo 2] $data 179 } 180 } 181 add11 { 182 # TODO 183 incr bad_adds 184 set ret 1 185 } 186 put00 { 187 incr puts 188 set k [random_key] 189 set data [random_data $data_avg 0 0] 190 set data [chop_data $method $data] 191 set ret [eval {$db put} $txn {$k $data}] 192 changepair $k [pad_data $method $data] 193 } 194 put01 { 195 incr bad_puts 196 set k [random_key] 197 set data [random_data $data_avg 0 0] 198 set data [chop_data $method $data] 199 set ret [eval {$db put} $txn $pflags \ 200 {-nooverwrite $k $data}] 201 set cerr [catch {error_check_good put $ret 0} cret] 202 if {$cerr != 0} { 203 puts $cret 204 return 205 } 206 # Error case so no change to data state 207 } 208 put10 { 209 incr puts 210 set dbcinfo [random_cursor $curslist] 211 set dbc [lindex $dbcinfo 0] 212 set k [lindex $dbcinfo 1] 213 set data [random_data $data_avg 0 0] 214 set data [chop_data $method $data] 215 216 set ret [eval {$dbc put} $txn {-current $data}] 217 changedup $k [lindex $dbcinfo 2] $data 218 } 219 put11 { 220 incr bad_puts 221 set k [random_key] 222 set data [random_data $data_avg 0 0] 223 set data [chop_data $method $data] 224 set dbc [$db cursor] 225 set ret [eval {$dbc put} $txn {-current $data}] 226 set cerr [catch {error_check_good curs_close \ 227 [$dbc close] 0} cret] 228 if {$cerr != 0} { 229 puts $cret 230 return 231 } 232 # Error case so no change to data state 233 } 234 get00 { 235 incr gets 236 set k [random_key] 237 set val [eval {$db get} $txn {$k}] 238 set data [pad_data $method [lindex [lindex $val 0] 1]] 239 if { $data == $a_keys($k) } { 240 set ret 0 241 } else { 242 set ret "FAIL: Error got |$data| expected |$a_keys($k)|" 243 } 244 # Get command requires no state change 245 } 246 get01 { 247 incr bad_gets 248 set k [random_data $key_avg 1 a_keys $record_based] 249 set ret [eval {$db get} $txn {$k}] 250 # Error case so no change to data state 251 } 252 get10 { 253 incr gets 254 set dbcinfo [random_cursor $curslist] 255 if { [llength $dbcinfo] == 3 } { 256 set ret 0 257 else 258 set ret 0 259 } 260 # Get command requires no state change 261 } 262 get11 { 263 incr bad_gets 264 set k [random_key] 265 set dbc [$db cursor] 266 if { [berkdb random_int 1 2] == 1 } { 267 set dir -next 268 } else { 269 set dir -prev 270 } 271 set ret [eval {$dbc get} $txn {-next $k}] 272 set cerr [catch {error_check_good curs_close \ 273 [$dbc close] 0} cret] 274 if {$cerr != 0} { 275 puts $cret 276 return 277 } 278 # Error and get case so no change to data state 279 } 280 del00 { 281 incr dels 282 set k [random_key] 283 set ret [eval {$db del} $txn {$k}] 284 rempair $k 285 } 286 del01 { 287 incr bad_dels 288 set k [random_data $key_avg 1 a_keys $record_based] 289 set ret [eval {$db del} $txn {$k}] 290 # Error case so no change to data state 291 } 292 del10 { 293 incr dels 294 set dbcinfo [random_cursor $curslist] 295 set dbc [lindex $dbcinfo 0] 296 set ret [eval {$dbc del} $txn] 297 remdup [lindex dbcinfo 1] [lindex dbcinfo 2] 298 } 299 del11 { 300 incr bad_dels 301 set c [$db cursor] 302 set ret [eval {$c del} $txn] 303 set cerr [catch {error_check_good curs_close \ 304 [$c close] 0} cret] 305 if {$cerr != 0} { 306 puts $cret 307 return 308 } 309 # Error case so no change to data state 310 } 311 } 312 if { $err == 1 } { 313 # Verify failure. 314 set cerr [catch {error_check_good $op$dups$err:$k \ 315 [is_substr Error $ret] 1} cret] 316 if {$cerr != 0} { 317 puts $cret 318 return 319 } 320 } else { 321 # Verify success 322 set cerr [catch {error_check_good $op$dups$err:$k $ret 0} cret] 323 if {$cerr != 0} { 324 puts $cret 325 return 326 } 327 } 328 329 flush stdout 330} 331 332# Close cursors and file 333foreach i $curslist { 334 set r [$i close] 335 set cerr [catch {error_check_good cursor_close:$i $r 0} cret] 336 if {$cerr != 0} { 337 puts $cret 338 return 339 } 340} 341 342set r [$db close] 343set cerr [catch {error_check_good db_close:$db $r 0} cret] 344if {$cerr != 0} { 345 puts $cret 346 return 347} 348 349puts "[timestamp] [pid] Complete" 350puts "Successful ops: $adds adds $gets gets $puts puts $dels dels" 351puts "Error ops: $bad_adds adds $bad_gets gets $bad_puts puts $bad_dels dels" 352flush stdout 353 354filecheck $file $txn 355 356exit 357