gecko-dev/db/test/test031.tcl

# See the file LICENSE for redistribution information.
#
# Copyright (c) 1996, 1997, 1998
#	Sleepycat Software.  All rights reserved.
#
#	@(#)test031.tcl	10.8 (Sleepycat) 4/26/98
#
# DB Test 31 {access method}
# Multiprocess DB test; verify that locking is basically working.
# Use the first "nentries" words from the dictionary.
# Insert each with self as key and a fixed, medium length data string.
# Then fire off multiple processes that bang on the database.  Each
# one should trey to read and write random keys.  When they rewrite
# They'll append their pid to the data string (sometimes doing a rewrite
# sometimes doing a partial put).

set datastr abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz

proc test031 { method {nentries 1000} args } {
global datastr
source ./include.tcl

	set method [convert_method $method]
	if { [string compare $method DB_RECNO] == 0 } {
		puts "Test$reopen skipping for method RECNO"
		return
	}
	puts "Test031: multiprocess db $method $nentries items"

	# Parse options
	set iter 1000
	set procs 5
	set seeds {}
	set do_exit 0
	for { set i 0 } { $i < [llength $args] } {incr i} {
		switch -regexp -- [lindex $args $i] {
			-d.* { incr i; set testdir [lindex $args $i] }
			-i.* { incr i; set iter [lindex $args $i] }
			-p.* { incr i; set procs [lindex $args $i] }
			-s.* { incr i; set seeds [lindex $args $i] }
			-x.* { set do_exit 1 }
			default {
				test031_usage
				return
			}
		}
	}

	if { [file exists $testdir] != 1 } {
		exec $MKDIR $testdir
	} elseif { [file isdirectory $testdir ] != 1 } {
		error "FAIL: $testdir is not a directory"
	}

	# Create the database and open the dictionary
	set testfile test031.db
	set t1 $testdir/t1
	set t2 $testdir/t2
	set t3 $testdir/t3
	cleanup $testdir
	set db [eval [concat dbopen \
	    $testfile [expr $DB_CREATE | $DB_TRUNCATE] 0644 $method $args]]
	error_check_good dbopen [is_valid_db $db] TRUE
	set did [open $dict]

	set flags 0
	set txn 0
	set count 0

	# Here is the loop where we put each key/data pair

	puts "\tTest031.a: put/get loop"
	while { [gets $did str] != -1 && $count < $nentries } {
		if { [string compare $method DB_RECNO] == 0 } {
			set key [expr $count + 1]
			set put putn
		} else {
			set key $str
			set put put
		}
		set ret [$db $put $txn $key $datastr $flags]
		error_check_good put:$db $ret 0
		incr count
	}
	close $did
	error_check_good close:$db [$db close] 0

	# Database is created, now fork off the kids.
	puts "\tTest031.b: forking off $procs children"

	# Remove old mpools and Open/create the lock and mpool regions
	# Test is done, blow away lock and mpool region
	set ret [ lock_unlink $testdir 1 ]
#	error_check_good lock_unlink $ret 0
	set ret [ memp_unlink $testdir 1 ]
#	error_check_good memp_unlink $ret 0

	set lp [lock_open "" $DB_CREATE 0644]
	error_check_bad lock_open $lp NULL
	error_check_good lock_open [is_substr $lp lockmgr] 1
	error_check_good lock_close [$lp close] 0

	set mp [ memp $testdir 0644 $DB_CREATE]
	error_check_bad memp $mp NULL
	error_check_good memp [is_substr $mp mp] 1
	error_check_good memp_close [$mp close] 0

	if { $do_exit == 1 } {
		return
	}

	# Now spawn off processes
	set pidlist {}
	for { set i 0 } {$i < $procs} {incr i} {
		set s -1
		if { [llength $seeds] == $procs } {
			set s [lindex $seeds $i]
		}
		puts "exec ./dbtest ../test/mdbscript.tcl $testdir $testfile \
		    $nentries $iter $i $procs $s > $testdir/test031.$i.log &"
		set p [exec ./dbtest ../test/mdbscript.tcl $testdir $testfile \
		    $nentries $iter $i $procs $s > $testdir/test031.$i.log & ]
		lappend pidlist $p
	}
	puts "Test031: $procs independent processes now running"
	watch_procs $pidlist

	# Test is done, blow away lock and mpool region
	set ret [ lock_unlink $testdir 0 ]
#	error_check_good lock_unlink $ret 0
	set ret [ memp_unlink $testdir 0 ]
#	error_check_good memp_unlink $ret 0
}

proc test031_usage { } {
	puts -nonewline "test031 method nentries [-d directory] [-i iterations]"
	puts " [-p procs] [-s {seeds} ] -x"
}