1# See the file LICENSE for redistribution information.
2#
3# Copyright (c) 1996,2008 Oracle.  All rights reserved.
4#
5# $Id: test042.tcl,v 12.6 2008/01/08 20:58:53 bostic Exp $
6#
7# TEST	test042
8# TEST	Concurrent Data Store test (CDB)
9# TEST
10# TEST	Multiprocess DB test; verify that locking is working for the
11# TEST	concurrent access method product.
12# TEST
13# TEST	Use the first "nentries" words from the dictionary.  Insert each with
14# TEST	self as key and a fixed, medium length data string.  Then fire off
15# TEST	multiple processes that bang on the database.  Each one should try to
16# TEST	read and write random keys.  When they rewrite, they'll append their
17# TEST	pid to the data string (sometimes doing a rewrite sometimes doing a
18# TEST	partial put).  Some will use cursors to traverse through a few keys
19# TEST	before finding one to write.
20
21proc test042 { method {nentries 1000} args } {
22	global encrypt
23
24	#
25	# If we are using an env, then skip this test.  It needs its own.
26	set eindex [lsearch -exact $args "-env"]
27	if { $eindex != -1 } {
28		incr eindex
29		set env [lindex $args $eindex]
30		puts "Test042 skipping for env $env"
31		return
32	}
33
34	set args [convert_args $method $args]
35	if { $encrypt != 0 } {
36		puts "Test042 skipping for security"
37		return
38	}
39	test042_body $method $nentries 0 $args
40	test042_body $method $nentries 1 $args
41}
42
43proc test042_body { method nentries alldb args } {
44	source ./include.tcl
45
46	if { $alldb } {
47		set eflag "-cdb -cdb_alldb"
48	} else {
49		set eflag "-cdb"
50	}
51	puts "Test042: CDB Test ($eflag) $method $nentries"
52
53	# Set initial parameters
54	set do_exit 0
55	set iter 10000
56	set procs 5
57
58	# Process arguments
59	set oargs ""
60	for { set i 0 } { $i < [llength $args] } {incr i} {
61		switch -regexp -- [lindex $args $i] {
62			-dir	{ incr i; set testdir [lindex $args $i] }
63			-iter	{ incr i; set iter [lindex $args $i] }
64			-procs	{ incr i; set procs [lindex $args $i] }
65			-exit	{ set do_exit 1 }
66			default { append oargs " " [lindex $args $i] }
67		}
68	}
69
70	# Create the database and open the dictionary
71	set basename test042
72	set t1 $testdir/t1
73	set t2 $testdir/t2
74	set t3 $testdir/t3
75
76	env_cleanup $testdir
77
78	set env [eval {berkdb_env -create} $eflag -home $testdir]
79	error_check_good dbenv [is_valid_env $env] TRUE
80
81	# Env is created, now set up database
82	test042_dbinit $env $nentries $method $oargs $basename.0.db
83	if { $alldb } {
84		for { set i 1 } {$i < $procs} {incr i} {
85			test042_dbinit $env $nentries $method $oargs \
86			    $basename.$i.db
87		}
88	}
89
90	# Remove old mpools and Open/create the lock and mpool regions
91	error_check_good env:close:$env [$env close] 0
92	set ret [berkdb envremove -home $testdir]
93	error_check_good env_remove $ret 0
94
95	set env [eval {berkdb_env \
96	    -create -cachesize {0 1048576 1}} $eflag -home $testdir]
97	error_check_good dbenv [is_valid_widget $env env] TRUE
98
99	if { $do_exit == 1 } {
100		return
101	}
102
103	# Now spawn off processes
104	berkdb debug_check
105	puts "\tTest042.b: forking off $procs children"
106	set pidlist {}
107
108	for { set i 0 } {$i < $procs} {incr i} {
109		if { $alldb } {
110			set tf $basename.$i.db
111		} else {
112			set tf $basename.0.db
113		}
114		puts "exec $tclsh_path $test_path/wrap.tcl \
115		    mdbscript.tcl $testdir/test042.$i.log \
116		    $method $testdir $tf $nentries $iter $i $procs &"
117		set p [exec $tclsh_path $test_path/wrap.tcl \
118		    mdbscript.tcl $testdir/test042.$i.log $method \
119		    $testdir $tf $nentries $iter $i $procs &]
120		lappend pidlist $p
121	}
122	puts "Test042: $procs independent processes now running"
123	watch_procs $pidlist
124
125	# Make sure we haven't added or lost any entries.
126	set dblist [glob $testdir/$basename.*.db]
127	foreach file $dblist {
128		set tf [file tail $file]
129		set db [eval {berkdb_open -env $env $tf}]
130		set statret [$db stat]
131		foreach pair $statret {
132			set fld [lindex $pair 0]
133			if { [string compare $fld {Number of records}] == 0 } {
134				set numrecs [lindex $pair 1]
135				break
136			}
137		}
138		error_check_good nentries $numrecs $nentries
139		error_check_good db_close [$db close] 0
140	}
141
142	# Check for test failure
143	set errstrings [eval findfail [glob $testdir/test042.*.log]]
144	foreach str $errstrings {
145		puts "FAIL: error message in log file: $str"
146	}
147
148	# Test is done, blow away lock and mpool region
149	reset_env $env
150}
151
152proc test042_dbinit { env nentries method oargs tf } {
153	global datastr
154	source ./include.tcl
155
156	set omethod [convert_method $method]
157	set db [eval {berkdb_open -env $env -create \
158	    -mode 0644 $omethod} $oargs $tf]
159	error_check_good dbopen [is_valid_db $db] TRUE
160
161	set did [open $dict]
162
163	set pflags ""
164	set gflags ""
165	set txn ""
166	set count 0
167
168	# Here is the loop where we put each key/data pair
169	puts "\tTest042.a: put loop $tf"
170	while { [gets $did str] != -1 && $count < $nentries } {
171		if { [is_record_based $method] == 1 } {
172			set key [expr $count + 1]
173		} else {
174			set key $str
175		}
176		set ret [eval {$db put} \
177		    $txn $pflags {$key [chop_data $method $datastr]}]
178		error_check_good put:$db $ret 0
179		incr count
180	}
181	close $did
182	error_check_good close:$db [$db close] 0
183}
184