зеркало из https://github.com/mozilla/gecko-dev.git
326 строки
7.5 KiB
Tcl
326 строки
7.5 KiB
Tcl
# See the file LICENSE for redistribution information.
|
|
#
|
|
# Copyright (c) 1996, 1997, 1998
|
|
# Sleepycat Software. All rights reserved.
|
|
#
|
|
# @(#)test.tcl 10.28 (Sleepycat) 5/31/98
|
|
|
|
source ./include.tcl
|
|
source ../test/testutils.tcl
|
|
source ../test/byteorder.tcl
|
|
|
|
set testdir ./TESTDIR
|
|
if { [file exists $testdir] != 1 } {
|
|
exec $MKDIR $testdir
|
|
}
|
|
|
|
set is_windows_test 0
|
|
|
|
set parms(test001) 10000
|
|
set parms(test002) 10000
|
|
set parms(test003) ""
|
|
set parms(test004) {10000 4 0}
|
|
set parms(test005) 10000
|
|
set parms(test006) {10000 6}
|
|
set parms(test007) 10000
|
|
set parms(test008) {10000 8 0}
|
|
set parms(test009) 10000
|
|
set parms(test010) {10000 5 10}
|
|
set parms(test011) {10000 5 11}
|
|
set parms(test012) ""
|
|
set parms(test013) 10000
|
|
set parms(test014) 10000
|
|
set parms(test015) {7500 0}
|
|
set parms(test016) 10000
|
|
set parms(test017) 10000
|
|
set parms(test018) 10000
|
|
set parms(test019) 10000
|
|
set parms(test020) 10000
|
|
set parms(test021) 10000
|
|
set parms(test022) ""
|
|
set parms(test023) ""
|
|
set parms(test024) 10000
|
|
set parms(test025) 10000
|
|
set parms(test026) {2000 5 26}
|
|
set parms(test027) {100}
|
|
set parms(test028) ""
|
|
set parms(test029) 10000
|
|
|
|
set dict ../test/wordlist
|
|
set alphabet "abcdefghijklmnopqrstuvwxyz"
|
|
set recd_debug 0
|
|
|
|
set loadtests 33
|
|
set runtests 29
|
|
set recdtests 5
|
|
set deadtests 2
|
|
set bugtests 7
|
|
set rsrctests 1
|
|
for { set i 1 } { $i <= $loadtests } {incr i} {
|
|
set name [format "test%03d.tcl" $i]
|
|
source ../test/$name
|
|
}
|
|
for { set i 1 } { $i <= $recdtests } {incr i} {
|
|
set name [format "recd%03d.tcl" $i]
|
|
source ../test/$name
|
|
}
|
|
for { set i 1 } { $i <= $deadtests } {incr i} {
|
|
set name [format "dead%03d.tcl" $i]
|
|
source ../test/$name
|
|
}
|
|
for { set i 1 } { $i <= $bugtests } {incr i} {
|
|
set name [format "bug%03d.tcl" $i]
|
|
source ../test/$name
|
|
}
|
|
for { set i 1 } { $i <= $rsrctests } {incr i} {
|
|
set name [format "rsrc%03d.tcl" $i]
|
|
source ../test/$name
|
|
}
|
|
|
|
source ../test/archive.tcl
|
|
source ../test/dbm.tcl
|
|
source ../test/hsearch.tcl
|
|
source ../test/lock.tcl
|
|
source ../test/mpool.tcl
|
|
source ../test/mlock.tcl
|
|
source ../test/mutex.tcl
|
|
source ../test/ndbm.tcl
|
|
source ../test/randomlock.tcl
|
|
source ../test/log.tcl
|
|
source ../test/txn.tcl
|
|
|
|
# Test driver programs
|
|
|
|
# Use args for options
|
|
proc run_method { method {start 1} {stop 0} args } {
|
|
global parms
|
|
global debug_print
|
|
global debug_on
|
|
global runtests
|
|
if { $stop == 0 } {
|
|
set stop $runtests
|
|
}
|
|
puts "run_method: $method $start $stop $args"
|
|
|
|
for { set i $start } { $i <= $stop } {incr i} {
|
|
puts "[timestamp]"
|
|
set name [format "test%03d" $i]
|
|
eval $name $method $parms($name) $args
|
|
if { $debug_print != 0 } {
|
|
puts ""
|
|
}
|
|
if { $debug_on != 0 } {
|
|
debug
|
|
}
|
|
flush stdout
|
|
flush stderr
|
|
}
|
|
}
|
|
|
|
proc r { args } {
|
|
global recdtests
|
|
|
|
set l [ lindex $args 0 ]
|
|
switch $l {
|
|
ampool { eval mpool -shmem anon [lrange $args 1 end] }
|
|
archive { eval archive [lrange $args 1 end] }
|
|
byte {
|
|
foreach method "DB_HASH DB_BTREE DB_RECNO DB_RRECNO" {
|
|
byteorder $method
|
|
}
|
|
}
|
|
dbm { eval dbm }
|
|
dead {
|
|
eval dead001 [lrange $args 1 end]
|
|
eval dead002 [lrange $args 1 end]
|
|
}
|
|
hsearch { eval htest }
|
|
lock { eval locktest [lrange $args 1 end] }
|
|
log { eval logtest [lrange $args 1 end] }
|
|
mpool { eval mpool [lrange $args 1 end] }
|
|
nmpool { eval mpool -shmem named [lrange $args 1 end] }
|
|
mutex { eval mutex [lrange $args 1 end] }
|
|
ndbm { eval ndbm }
|
|
recd {
|
|
foreach method "DB_HASH DB_BTREE DB_RECNO DB_RRECNO" {
|
|
for { set i 1 } {$i <= $recdtests} {incr i} {
|
|
set name [format "recd%03d" $i]
|
|
eval $name $method
|
|
flush stdout
|
|
flush stderr
|
|
}
|
|
}
|
|
}
|
|
rsrc {
|
|
eval rsrc001
|
|
}
|
|
txn { eval txntest [lrange $args 1 end] }
|
|
default { eval run_method $args }
|
|
}
|
|
flush stdout
|
|
flush stderr
|
|
}
|
|
|
|
proc run_all { } {
|
|
source include.tcl
|
|
global runtests
|
|
global recdtests
|
|
exec $RM -rf ALL.OUT
|
|
foreach i "archive byte lock log mpool ampool nmpool mutex txn" {
|
|
puts "Running $i tests"
|
|
if [catch {exec ./dbtest << "r $i" >>& ALL.OUT } res] {
|
|
set o [open ALL.OUT a]
|
|
puts $o "FAIL: $i test"
|
|
close $o
|
|
}
|
|
}
|
|
|
|
# Add deadlock detector tests
|
|
puts "Running deadlock detection tests."
|
|
if [catch {exec ./dbtest << "r dead" >>& ALL.OUT} res] {
|
|
set o [open ALL.OUT a]
|
|
puts $o "FAIL: deadlock detector test"
|
|
close $o
|
|
}
|
|
|
|
|
|
foreach i "DB_BTREE DB_RBTREE DB_HASH DB_RECNO DB_RRECNO" {
|
|
puts "Running $i tests"
|
|
for { set j 1 } { $j <= $runtests } {incr j} {
|
|
if [catch {exec ./dbtest << "run_method $i $j $j" \
|
|
>>& ALL.OUT } res] {
|
|
set o [open ALL.OUT a]
|
|
puts $o "FAIL: [format "test%03d" $j] $i"
|
|
close $o
|
|
}
|
|
}
|
|
}
|
|
|
|
puts "Running RECNO source tests"
|
|
if [catch {exec ./dbtest << "r rsrc" >>& ALL.OUT } res] {
|
|
set o [open ALL.OUT a]
|
|
puts $o "FAIL: $i test"
|
|
close $o
|
|
}
|
|
|
|
# Run recovery tests
|
|
foreach method "DB_HASH DB_BTREE DB_RECNO DB_RRECNO" {
|
|
puts "Running recovery tests for $method"
|
|
for { set i 1 } {$i <= $recdtests} {incr i} {
|
|
set name [format "recd%03d" $i]
|
|
if [catch {exec ./dbtest << "$name $method" \
|
|
>>& ALL.OUT } res] {
|
|
set o [open ALL.OUT a]
|
|
puts $o "FAIL: $name $method"
|
|
close $o
|
|
}
|
|
}
|
|
}
|
|
|
|
# Check historic interfaces
|
|
foreach t "dbm ndbm hsearch" {
|
|
if [catch {exec ./dbtest << "r $t" >>& ALL.OUT} res] {
|
|
set o [open ALL.OUT a]
|
|
puts $o "FAIL: $t test"
|
|
close $o
|
|
}
|
|
}
|
|
|
|
catch { exec $SED -e /^FAIL/p -e d ALL.OUT } res
|
|
if { [string length $res] == 0 } {
|
|
puts "Regression Tests Succeeded"
|
|
} else {
|
|
puts "Regression Tests Failed; see ALL.OUT for log"
|
|
}
|
|
}
|
|
|
|
proc convert_method { method } {
|
|
switch $method {
|
|
rrecno { return DB_RECNO }
|
|
RRECNO { return DB_RECNO }
|
|
db_rrecno { return DB_RECNO }
|
|
DB_RRECNO { return DB_RECNO }
|
|
rrec { return DB_RECNO }
|
|
recno { return DB_RECNO }
|
|
RECNO { return DB_RECNO }
|
|
db_recno { return DB_RECNO }
|
|
DB_RECNO { return DB_RECNO }
|
|
rec { return DB_RECNO }
|
|
btree { return DB_BTREE }
|
|
BTREE { return DB_BTREE }
|
|
db_btree { return DB_BTREE }
|
|
DB_BTREE { return DB_BTREE }
|
|
bt { return DB_BTREE }
|
|
rbtree { return DB_BTREE }
|
|
RBTREE { return DB_BTREE }
|
|
db_rbtree { return DB_BTREE }
|
|
DB_RBTREE { return DB_BTREE }
|
|
rbt { return DB_BTREE }
|
|
hash { return DB_HASH }
|
|
HASH { return DB_HASH }
|
|
db_hash { return DB_HASH }
|
|
DB_HASH { return DB_HASH }
|
|
h { return DB_HASH }
|
|
}
|
|
}
|
|
|
|
proc is_rrecno { method } {
|
|
set names { rrecno RRECNO db_rrecno DB_RRECNO rrec }
|
|
if { [lsearch $names $method] >= 0 } {
|
|
return 1
|
|
} else {
|
|
return 0
|
|
}
|
|
}
|
|
|
|
proc is_rbtree { method } {
|
|
set names { rbtree RBTREE db_rbtree DB_RBTREE rbt }
|
|
if { [lsearch $names $method] >= 0 } {
|
|
return 1
|
|
} else {
|
|
return 0
|
|
}
|
|
}
|
|
|
|
|
|
# If recno-with-renumbering or btree-with-renumbering is specified, then
|
|
# fix the arguments to specify the DB_RENUMBER/DB_RECNUM option for the
|
|
# -flags argument.
|
|
proc convert_args { method {largs ""} } {
|
|
source ./include.tcl
|
|
set do_flags 0
|
|
if { [is_rrecno $method] == 1 } {
|
|
return [add_to_args $DB_RENUMBER $largs]
|
|
} elseif { [is_rbtree $method] == 1 } {
|
|
return [add_to_args $DB_RECNUM $largs]
|
|
}
|
|
return $largs
|
|
}
|
|
|
|
# Make sure the DB_RECNUM flag is set if we are doing btree.
|
|
proc number_btree { method {largs ""} } {
|
|
source ./include.tcl
|
|
if { [string compare $method "DB_BTREE"] == 0 } {
|
|
return [add_to_args $DB_RECNUM $largs]
|
|
}
|
|
return $largs
|
|
}
|
|
|
|
# We want to set a flag value. Since there already might be one in
|
|
# args, we need to add to it.
|
|
proc add_to_args { flag_val {largs ""} } {
|
|
source ./include.tcl
|
|
set ndx [lsearch $largs -flags]
|
|
if { $ndx >= 0 } {
|
|
# There is already a flags argument
|
|
incr ndx
|
|
set f [lindex $largs $ndx]
|
|
set f [expr $f | $flag_val]
|
|
set largs [lreplace $largs $ndx $ndx $f]
|
|
} else {
|
|
# There is no flags argument
|
|
lappend largs -flags $flag_val
|
|
}
|
|
return $largs
|
|
}
|