gecko-dev/db/test/dbscript.tcl

276 строки
6.8 KiB
Tcl

# See the file LICENSE for redistribution information.
#
# Copyright (c) 1996, 1997, 1998
# Sleepycat Software. All rights reserved.
#
# @(#)dbscript.tcl 8.12 (Sleepycat) 4/10/98
#
# Random db tester.
# Usage: dbscript file numops min_del max_add key_avg data_avgdups
# 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/testutils.tcl
set alphabet "abcdefghijklmnopqrstuvwxyz"
set usage "dbscript file numops ncurs min_del max_add key_avg data_avg dups errpcnt seed"
# Verify usage
if { $argc != 10 } {
puts stderr $usage
exit
}
# Initialize arguments
set file [lindex $argv 0]
set numops [ lindex $argv 1 ]
set ncurs [ lindex $argv 2 ]
set min_del [ lindex $argv 3 ]
set max_add [ lindex $argv 4 ]
set key_avg [ lindex $argv 5 ]
set data_avg [ lindex $argv 6 ]
set dups [ lindex $argv 7 ]
set errpct [ lindex $argv 8 ]
set seed [ lindex $argv 9 ]
# Initialize seed
if { $seed == -1 } {
set seed [pid]
}
srand $seed
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"
puts "$seed seed"
flush stdout
set db [record dbopen $file 0 0 DB_UNKNOWN]
error_check_bad dbopen $db NULL
error_check_good dbopen [is_substr $db db] 1
# Initialize globals including data
set nkeys [db_init $db 1]
puts "Initial number of keys: $nkeys"
set txn 0
# Open the cursors
set curslist {}
for { set i 0 } { $i < $ncurs } { incr i } {
set dbc [record $db cursor]
error_check_bad cursor_create $dbc NULL
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 ]
set data [random_data $data_avg 0 0]
set ret [record $db put $txn $k $data $DB_NOOVERWRITE ]
newpair $k $data
}
add01 {
incr bad_adds
set k [random_key]
set data [random_data $data_avg 0 0]
set ret [record $db put $txn $k $data $DB_NOOVERWRITE ]
# Error case so no change to data state
}
add10 {
incr adds
set dbcinfo [random_cursor $curslist]
set dbc [lindex $dbcinfo 0]
if { [random_int 1 2] == 1 } {
# Add a new key
set k [random_data $key_avg 1 a_keys ]
set data [random_data $data_avg 0 0]
set ret [record $dbc put $txn $k $data \
$DB_KEYFIRST ]
newpair $k $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 ret [record $dbc put $txn $k $data $op]
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 ret [record $db put $txn $k $data 0]
changepair $k $data
}
put01 {
incr bad_puts
set k [random_key]
set data [random_data $data_avg 0 0]
set ret [record $db put $txn $k $data $DB_NOOVERWRITE]
# 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 ret [record $dbc put $txn $k $data $DB_CURRENT]
changedup $k [lindex $dbcinfo 2] $data
}
put11 {
incr bad_puts
set k [random_key]
set data [random_data $data_avg 0 0]
set dbc [record $db cursor]
set ret [record $dbc put $txn $k $data $DB_CURRENT]
error_check_good curs_close [record $dbc close] 0
# Error case so no change to data state
}
get00 {
incr gets
set k [random_key]
set val [record $db get $txn $k 0]
if { $val == $a_keys($k) } {
set ret 0
} else {
set ret "Error got |$val| expected |$a_keys($k)|"
}
# Get command requires no state change
}
get01 {
incr bad_gets
set k [random_data $key_avg 1 a_keys ]
set ret [record $db get $txn $k 0]
# 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 [record $db cursor]
if { [random_int 1 2] == 1 } {
set dir $DB_NEXT
} else {
set dir $DB_PREV
}
set ret [record $dbc get $txn $k $DB_NEXT]
error_check_good curs_close [record $dbc close] 0
# Error and get case so no change to data state
}
del00 {
incr dels
set k [random_key]
set ret [record $db del $txn $k 0]
rempair $k
}
del01 {
incr bad_dels
set k [random_data $key_avg 1 a_keys ]
set ret [record $db del $txn $k 0]
# Error case so no change to data state
}
del10 {
incr dels
set dbcinfo [random_cursor $curslist]
set dbc [lindex $dbcinfo 0]
set ret [record $dbc del $txn 0]
remdup [lindex dbcinfo 1] [lindex dbcinfo 2]
}
del11 {
incr bad_dels
set c [record $db cursor]
set ret [record $c del $txn 0]
error_check_good curs_close [record $c close] 0
# Error case so no change to data state
}
}
if { $err == 1 } {
# Verify failure.
error_check_good $op$dups$err:$k [is_substr Error $ret] 1
} else {
# Verify success
error_check_good $op$dups$err:$k $ret 0
}
flush stdout
}
# Close cursors and file
foreach i $curslist {
set r [record $i close]
error_check_good cursor_close:$i $r 0
}
set r [record $db close]
error_check_good db_close:$db $r 0
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