diff options
Diffstat (limited to 'storage/bdb/test/dbscript.tcl')
| -rw-r--r-- | storage/bdb/test/dbscript.tcl | 357 |
1 files changed, 357 insertions, 0 deletions
diff --git a/storage/bdb/test/dbscript.tcl b/storage/bdb/test/dbscript.tcl new file mode 100644 index 00000000000..5decc493e9e --- /dev/null +++ b/storage/bdb/test/dbscript.tcl @@ -0,0 +1,357 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1996-2002 +# Sleepycat Software. All rights reserved. +# +# $Id: dbscript.tcl,v 11.14 2002/04/01 16:28:16 bostic Exp $ +# +# Random db tester. +# Usage: dbscript file numops min_del max_add key_avg data_avgdups +# method: method (we pass this in so that fixed-length records work) +# file: db file on which to operate +# numops: number of operations to do +# ncurs: number of cursors +# min_del: minimum number of keys before you disable deletes. +# max_add: maximum number of keys before you disable adds. +# key_avg: average key size +# data_avg: average data size +# dups: 1 indicates dups allowed, 0 indicates no dups +# errpct: What percent of operations should generate errors +# seed: Random number generator seed (-1 means use pid) + +source ./include.tcl +source $test_path/test.tcl +source $test_path/testutils.tcl + +set usage "dbscript file numops ncurs min_del max_add key_avg data_avg dups errpcnt" + +# Verify usage +if { $argc != 10 } { + puts stderr "FAIL:[timestamp] Usage: $usage" + exit +} + +# Initialize arguments +set method [lindex $argv 0] +set file [lindex $argv 1] +set numops [ lindex $argv 2 ] +set ncurs [ lindex $argv 3 ] +set min_del [ lindex $argv 4 ] +set max_add [ lindex $argv 5 ] +set key_avg [ lindex $argv 6 ] +set data_avg [ lindex $argv 7 ] +set dups [ lindex $argv 8 ] +set errpct [ lindex $argv 9 ] + +berkdb srand $rand_init + +puts "Beginning execution for [pid]" +puts "$file database" +puts "$numops Operations" +puts "$ncurs cursors" +puts "$min_del keys before deletes allowed" +puts "$max_add or fewer keys to add" +puts "$key_avg average key length" +puts "$data_avg average data length" +if { $dups != 1 } { + puts "No dups" +} else { + puts "Dups allowed" +} +puts "$errpct % Errors" + +flush stdout + +set db [berkdb_open $file] +set cerr [catch {error_check_good dbopen [is_substr $db db] 1} cret] +if {$cerr != 0} { + puts $cret + return +} +# set method [$db get_type] +set record_based [is_record_based $method] + +# Initialize globals including data +global nkeys +global l_keys +global a_keys + +set nkeys [db_init $db 1] +puts "Initial number of keys: $nkeys" + +set pflags "" +set gflags "" +set txn "" + +# Open the cursors +set curslist {} +for { set i 0 } { $i < $ncurs } { incr i } { + set dbc [$db cursor] + set cerr [catch {error_check_good dbopen [is_substr $dbc $db.c] 1} cret] + if {$cerr != 0} { + puts $cret + return + } + set cerr [catch {error_check_bad cursor_create $dbc NULL} cret] + if {$cerr != 0} { + puts $cret + return + } + lappend curslist $dbc + +} + +# On each iteration we're going to generate random keys and +# data. We'll select either a get/put/delete operation unless +# we have fewer than min_del keys in which case, delete is not +# an option or more than max_add in which case, add is not +# an option. The tcl global arrays a_keys and l_keys keep track +# of key-data pairs indexed by key and a list of keys, accessed +# by integer. +set adds 0 +set puts 0 +set gets 0 +set dels 0 +set bad_adds 0 +set bad_puts 0 +set bad_gets 0 +set bad_dels 0 + +for { set iter 0 } { $iter < $numops } { incr iter } { + set op [pick_op $min_del $max_add $nkeys] + set err [is_err $errpct] + + # The op0's indicate that there aren't any duplicates, so we + # exercise regular operations. If dups is 1, then we'll use + # cursor ops. + switch $op$dups$err { + add00 { + incr adds + + set k [random_data $key_avg 1 a_keys $record_based] + set data [random_data $data_avg 0 0] + set data [chop_data $method $data] + set ret [eval {$db put} $txn $pflags \ + {-nooverwrite $k $data}] + set cerr [catch {error_check_good put $ret 0} cret] + if {$cerr != 0} { + puts $cret + return + } + newpair $k [pad_data $method $data] + } + add01 { + incr bad_adds + set k [random_key] + set data [random_data $data_avg 0 0] + set data [chop_data $method $data] + set ret [eval {$db put} $txn $pflags \ + {-nooverwrite $k $data}] + set cerr [catch {error_check_good put $ret 0} cret] + if {$cerr != 0} { + puts $cret + return + } + # Error case so no change to data state + } + add10 { + incr adds + set dbcinfo [random_cursor $curslist] + set dbc [lindex $dbcinfo 0] + if { [berkdb random_int 1 2] == 1 } { + # Add a new key + set k [random_data $key_avg 1 a_keys \ + $record_based] + set data [random_data $data_avg 0 0] + set data [chop_data $method $data] + set ret [eval {$dbc put} $txn \ + {-keyfirst $k $data}] + newpair $k [pad_data $method $data] + } else { + # Add a new duplicate + set dbc [lindex $dbcinfo 0] + set k [lindex $dbcinfo 1] + set data [random_data $data_avg 0 0] + + set op [pick_cursput] + set data [chop_data $method $data] + set ret [eval {$dbc put} $txn {$op $k $data}] + adddup $k [lindex $dbcinfo 2] $data + } + } + add11 { + # TODO + incr bad_adds + set ret 1 + } + put00 { + incr puts + set k [random_key] + set data [random_data $data_avg 0 0] + set data [chop_data $method $data] + set ret [eval {$db put} $txn {$k $data}] + changepair $k [pad_data $method $data] + } + put01 { + incr bad_puts + set k [random_key] + set data [random_data $data_avg 0 0] + set data [chop_data $method $data] + set ret [eval {$db put} $txn $pflags \ + {-nooverwrite $k $data}] + set cerr [catch {error_check_good put $ret 0} cret] + if {$cerr != 0} { + puts $cret + return + } + # Error case so no change to data state + } + put10 { + incr puts + set dbcinfo [random_cursor $curslist] + set dbc [lindex $dbcinfo 0] + set k [lindex $dbcinfo 1] + set data [random_data $data_avg 0 0] + set data [chop_data $method $data] + + set ret [eval {$dbc put} $txn {-current $data}] + changedup $k [lindex $dbcinfo 2] $data + } + put11 { + incr bad_puts + set k [random_key] + set data [random_data $data_avg 0 0] + set data [chop_data $method $data] + set dbc [$db cursor] + set ret [eval {$dbc put} $txn {-current $data}] + set cerr [catch {error_check_good curs_close \ + [$dbc close] 0} cret] + if {$cerr != 0} { + puts $cret + return + } + # Error case so no change to data state + } + get00 { + incr gets + set k [random_key] + set val [eval {$db get} $txn {$k}] + set data [pad_data $method [lindex [lindex $val 0] 1]] + if { $data == $a_keys($k) } { + set ret 0 + } else { + set ret "FAIL: Error got |$data| expected |$a_keys($k)|" + } + # Get command requires no state change + } + get01 { + incr bad_gets + set k [random_data $key_avg 1 a_keys $record_based] + set ret [eval {$db get} $txn {$k}] + # Error case so no change to data state + } + get10 { + incr gets + set dbcinfo [random_cursor $curslist] + if { [llength $dbcinfo] == 3 } { + set ret 0 + else + set ret 0 + } + # Get command requires no state change + } + get11 { + incr bad_gets + set k [random_key] + set dbc [$db cursor] + if { [berkdb random_int 1 2] == 1 } { + set dir -next + } else { + set dir -prev + } + set ret [eval {$dbc get} $txn {-next $k}] + set cerr [catch {error_check_good curs_close \ + [$dbc close] 0} cret] + if {$cerr != 0} { + puts $cret + return + } + # Error and get case so no change to data state + } + del00 { + incr dels + set k [random_key] + set ret [eval {$db del} $txn {$k}] + rempair $k + } + del01 { + incr bad_dels + set k [random_data $key_avg 1 a_keys $record_based] + set ret [eval {$db del} $txn {$k}] + # Error case so no change to data state + } + del10 { + incr dels + set dbcinfo [random_cursor $curslist] + set dbc [lindex $dbcinfo 0] + set ret [eval {$dbc del} $txn] + remdup [lindex dbcinfo 1] [lindex dbcinfo 2] + } + del11 { + incr bad_dels + set c [$db cursor] + set ret [eval {$c del} $txn] + set cerr [catch {error_check_good curs_close \ + [$c close] 0} cret] + if {$cerr != 0} { + puts $cret + return + } + # Error case so no change to data state + } + } + if { $err == 1 } { + # Verify failure. + set cerr [catch {error_check_good $op$dups$err:$k \ + [is_substr Error $ret] 1} cret] + if {$cerr != 0} { + puts $cret + return + } + } else { + # Verify success + set cerr [catch {error_check_good $op$dups$err:$k $ret 0} cret] + if {$cerr != 0} { + puts $cret + return + } + } + + flush stdout +} + +# Close cursors and file +foreach i $curslist { + set r [$i close] + set cerr [catch {error_check_good cursor_close:$i $r 0} cret] + if {$cerr != 0} { + puts $cret + return + } +} + +set r [$db close] +set cerr [catch {error_check_good db_close:$db $r 0} cret] +if {$cerr != 0} { + puts $cret + return +} + +puts "[timestamp] [pid] Complete" +puts "Successful ops: $adds adds $gets gets $puts puts $dels dels" +puts "Error ops: $bad_adds adds $bad_gets gets $bad_puts puts $bad_dels dels" +flush stdout + +filecheck $file $txn + +exit |