1# See the file LICENSE for redistribution information.
2#
3# Copyright (c) 1999,2008 Oracle.  All rights reserved.
4#
5# $Id: t106script.tcl,v 12.6 2008/01/08 20:58:53 bostic Exp $
6#
7
8proc t106_initial { nitems nprod id tnum dbenv order args } {
9	source ./include.tcl
10
11	set pid [pid]
12	puts "\tTest$tnum: Producer $pid initializing DBs"
13
14	# Each producer initially loads a small number of items to
15	# each btree database, then enters a RMW loop where it randomly
16	# selects and executes a cursor operations which either:
17	# 1.  Read-modify-write an item in db2; or
18	# 2.  Read-modify-write an item in both db2 and db3, randomly
19	# selecting between db2 and db3 on which to open first, which to
20	# read first, which to write first, which to close first.  This
21	# may create deadlocks so keep trying until it's successful.
22
23	# Open queue database
24	set dbq [eval {berkdb_open -create -queue -env $dbenv\
25	    -auto_commit -len 32 queue.db} ]
26	error_check_good dbq_open [is_valid_db $dbq] TRUE
27
28	# Open four btree databases
29	set db1 [berkdb_open \
30	    -create -btree -env $dbenv -auto_commit testfile1.db]
31	error_check_good db1_open [is_valid_db $db1] TRUE
32	set db2 [berkdb_open \
33	    -create -btree -env $dbenv -auto_commit testfile2.db]
34	error_check_good db2_open [is_valid_db $db2] TRUE
35	set db3 [berkdb_open \
36	    -create -btree -env $dbenv -auto_commit testfile3.db]
37	error_check_good db3_open [is_valid_db $db3] TRUE
38	set db4 [berkdb_open \
39	    -create -btree -env $dbenv -auto_commit testfile4.db]
40	error_check_good db4_open [is_valid_db $db4] TRUE
41
42	# Initialize databases with $nitems items from each producer.
43	set did [open $dict]
44	for { set i 1 } { $i <= $nitems } { incr i } {
45		set db2data [read $did [berkdb random_int 300 700]]
46		set db3data [read $did [berkdb random_int 500 1000]]
47		set qdata [read $did 32]
48		set suffix _0_$i
49		set db23key "testclient$id$suffix"
50		set suffix _$i
51		set db4key key$id$suffix
52
53		set t [$dbenv txn]
54		set txn "-txn $t"
55		error_check_good db2_put [eval {$db2 put} $txn\
56		    {$db23key $db2data}] 0
57		error_check_good db3_put [eval {$db3 put} $txn\
58		    {$db23key $db3data}] 0
59		error_check_good db4_put [eval {$db4 put} $txn\
60		    {$db4key $db23key}] 0
61
62		set c [$dbenv txn -parent $t]
63		set ctxn "-txn $c"
64		set qrecno [eval {$dbq put -append} $ctxn {$qdata}]
65		error_check_good db1_put [eval {$db1 put} $ctxn\
66		    {$qrecno $db2data}] 0
67		error_check_good commit_child [$c commit] 0
68		error_check_good commit_parent [$t commit] 0
69	}
70	close $did
71
72	set ret [catch {$dbq close} res]
73	error_check_good dbq_close:$pid $ret 0
74	set ret [catch {$db1 close} res]
75	error_check_good db1_close:$pid $ret 0
76	set ret [catch {$db2 close} res]
77	error_check_good db2_close:$pid $ret 0
78	set ret [catch {$db3 close} res]
79	error_check_good db3_close:$pid $ret 0
80	set ret [catch {$db4 close} res]
81	error_check_good db4_close:$pid $ret 0
82
83	puts "\t\tTest$tnum: Initializer $pid finished."
84}
85
86proc t106_produce { nitems nprod id tnum dbenv order niter args } {
87	source ./include.tcl
88
89	set pid [pid]
90	set did [open $dict]
91	puts "\tTest$tnum: Producer $pid initializing DBs"
92
93	# Open queue database
94	set dbq [eval {berkdb_open -create -queue -env $dbenv\
95	    -auto_commit -len 32 queue.db} ]
96	error_check_good dbq_open [is_valid_db $dbq] TRUE
97
98	# Open four btree databases
99	set db1 [berkdb_open \
100	    -create -btree -env $dbenv -auto_commit testfile1.db]
101	error_check_good db1_open [is_valid_db $db1] TRUE
102	set db2 [berkdb_open \
103	    -create -btree -env $dbenv -auto_commit testfile2.db]
104	error_check_good db2_open [is_valid_db $db2] TRUE
105	set db3 [berkdb_open \
106	    -create -btree -env $dbenv -auto_commit testfile3.db]
107	error_check_good db3_open [is_valid_db $db3] TRUE
108	set db4 [berkdb_open \
109	    -create -btree -env $dbenv -auto_commit testfile4.db]
110	error_check_good db4_open [is_valid_db $db4] TRUE
111
112	# Now go into RMW phase.
113	for { set i 1 } { $i <= $niter } { incr i } {
114
115		set op [berkdb random_int 1 2]
116		set newdb2data [read $did [berkdb random_int 300 700]]
117		set qdata [read $did 32]
118
119		if { $order == "ordered" } {
120			set n [expr $i % $nitems]
121			if { $n == 0 } {
122				set n $nitems
123			}
124			set suffix _0_$n
125		} else {
126			# Retrieve a random key from the list
127			set suffix _0_[berkdb random_int 1 $nitems]
128		}
129		set key "testclient$id$suffix"
130
131		set t [$dbenv txn]
132		set txn "-txn $t"
133
134		# Now execute op1 or op2
135		if { $op == 1 } {
136			op1 $db2 $key $newdb2data $txn
137		} elseif { $op == 2 } {
138			set newdb3data [read $did [berkdb random_int 500 1000]]
139			op2 $db2 $db3 $key $newdb2data $newdb3data $txn $dbenv
140		} else {
141			puts "FAIL: unrecogized op $op"
142		}
143		set c [$dbenv txn -parent $t]
144		set ctxn "-txn $c"
145		set qrecno [eval {$dbq put -append} $ctxn {$qdata}]
146		error_check_good db1_put [eval {$db1 put} $ctxn\
147		    {$qrecno $newdb2data}] 0
148		error_check_good child_commit [$c commit] 0
149		error_check_good parent_commit [$t commit] 0
150	}
151	close $did
152
153	set ret [catch {$dbq close} res]
154	error_check_good dbq_close:$pid $ret 0
155	set ret [catch {$db1 close} res]
156	error_check_good db1_close:$pid $ret 0
157	set ret [catch {$db2 close} res]
158	error_check_good db2_close:$pid $ret 0
159	set ret [catch {$db3 close} res]
160	error_check_good db3_close:$pid $ret 0
161	set ret [catch {$db4 close} res]
162	error_check_good db4_close:$pid $ret 0
163
164	puts "\t\tTest$tnum: Producer $pid finished."
165}
166
167proc t106_consume { nitems tnum outputfile mode dbenv niter args } {
168	source ./include.tcl
169	set pid [pid]
170	puts "\tTest$tnum: Consumer $pid starting ($niter iterations)."
171
172	# Open queue database and btree database 1.
173	set dbq [eval {berkdb_open \
174	    -create -queue -env $dbenv -auto_commit -len 32 queue.db} ]
175	error_check_good dbq_open:$pid [is_valid_db $dbq] TRUE
176
177	set db1 [eval {berkdb_open \
178	    -create -btree -env $dbenv -auto_commit testfile1.db} ]
179	error_check_good db1_open:$pid [is_valid_db $db1] TRUE
180
181	set oid [open $outputfile a]
182
183	for { set i 1 } { $i <= $nitems } {incr i } {
184		set t [$dbenv txn]
185		set txn "-txn $t"
186		set ret [eval {$dbq get $mode} $txn]
187		set qrecno [lindex [lindex $ret 0] 0]
188		set db1curs [eval {$db1 cursor} $txn]
189		if {[catch {eval $db1curs get -set -rmw $qrecno} res]} {
190			puts "FAIL: $db1curs get: $res"
191		}
192		error_check_good db1curs_del [$db1curs del] 0
193		error_check_good db1curs_close [$db1curs close] 0
194		error_check_good txn_commit [$t commit] 0
195	}
196
197	error_check_good output_close:$pid [close $oid] ""
198
199	set ret [catch {$dbq close} res]
200	error_check_good dbq_close:$pid $ret 0
201	set ret [catch {$db1 close} res]
202	error_check_good db1_close:$pid $ret 0
203	puts "\t\tTest$tnum: Consumer $pid finished."
204}
205
206# op1 overwrites one data item in db2.
207proc op1 { db2 key newdata txn } {
208
209	set db2c [eval {$db2 cursor} $txn]
210puts "in op1, key is $key"
211	set ret [eval {$db2c get -set -rmw $key}]
212	# Make sure we retrieved something
213	error_check_good db2c_get [llength $ret] 1
214	error_check_good db2c_put [eval {$db2c put} -current {$newdata}] 0
215	error_check_good db2c_close [$db2c close] 0
216}
217
218# op 2
219proc op2 { db2 db3 key newdata2 newdata3 txn dbenv } {
220
221	# Randomly choose whether to work on db2 or db3 first for
222	# each operation: open cursor, get, put, close.
223	set open1 [berkdb random_int 0 1]
224	set get1 [berkdb random_int 0 1]
225	set put1 [berkdb random_int 0 1]
226	set close1 [berkdb random_int 0 1]
227puts "open [expr $open1 + 2] first, get [expr $get1 + 2] first,\
228    put [expr $put1 + 2] first, close [expr $close1 + 2] first"
229puts "in op2, key is $key"
230
231	# Open cursor
232	if { $open1 == 0 } {
233		set db2c [eval {$db2 cursor} $txn]
234		set db3c [eval {$db3 cursor} $txn]
235	} else {
236		set db3c [eval {$db3 cursor} $txn]
237		set db2c [eval {$db2 cursor} $txn]
238	}
239	error_check_good db2_cursor [is_valid_cursor $db2c $db2] TRUE
240	error_check_good db3_cursor [is_valid_cursor $db3c $db3] TRUE
241
242	# Do the following until we succeed and don't get DB_DEADLOCK:
243	if { $get1 == 0 } {
244		get_set_rmw $db2c $key $dbenv
245		get_set_rmw $db3c $key $dbenv
246	} else {
247		get_set_rmw $db3c $key $dbenv
248		get_set_rmw $db2c $key $dbenv
249	}
250
251	# Put new data.
252	if { $put1 == 0 } {
253		error_check_good db2c_put [eval {$db2c put} \
254		    -current {$newdata2}] 0
255		error_check_good db3c_put [eval {$db3c put} \
256		    -current {$newdata3}] 0
257	} else {
258		error_check_good db3c_put [eval {$db3c put} \
259		    -current {$newdata3}] 0
260		error_check_good db2c_put [eval {$db2c put} \
261		    -current {$newdata2}] 0
262	}
263	if { $close1 == 0 } {
264		error_check_good db2c_close [$db2c close] 0
265		error_check_good db3c_close [$db3c close] 0
266	} else {
267		error_check_good db3c_close [$db3c close] 0
268		error_check_good db2c_close [$db2c close] 0
269	}
270}
271
272proc get_set_rmw { dbcursor key dbenv } {
273
274	while { 1 } {
275		if {[catch {set ret [eval {$dbcursor get -set -rmw} $key]}\
276		    res ]} {
277			# If the get failed, break if it failed for any
278			# reason other than deadlock.  If we have deadlock,
279			# the deadlock detector should break the deadlock
280			# as we keep trying.
281			if { [is_substr $res DB_LOCK_DEADLOCK] != 1 } {
282				puts "FAIL: get_set_rmw: $res"
283				break
284			}
285		} else {
286			# We succeeded.  Go back to the body of the test.
287			break
288		}
289	}
290}
291
292source ./include.tcl
293source $test_path/test.tcl
294
295# Verify usage
296set usage "t106script.tcl dir runtype nitems nprod outputfile id tnum order"
297if { $argc < 10 } {
298	puts stderr "FAIL:[timestamp] Usage: $usage"
299	exit
300}
301
302# Initialize arguments
303set dir [lindex $argv 0]
304set runtype [lindex $argv 1]
305set nitems [lindex $argv 2]
306set nprod [lindex $argv 3]
307set outputfile [lindex $argv 4]
308set id [lindex $argv 5]
309set tnum [lindex $argv 6]
310set order [lindex $argv 7]
311set niter [lindex $argv 8]
312# args is the string "{ -len 20 -pad 0}", so we need to extract the
313# " -len 20 -pad 0" part.
314set args [lindex [lrange $argv 9 end] 0]
315
316# Open env
317set dbenv [berkdb_env -home $dir -txn]
318error_check_good dbenv_open [is_valid_env $dbenv] TRUE
319
320# Invoke initial, produce or consume based on $runtype
321if { $runtype == "INITIAL" } {
322	t106_initial $nitems $nprod $id $tnum $dbenv $order $args
323} elseif { $runtype == "PRODUCE" } {
324	t106_produce $nitems $nprod $id $tnum $dbenv $order $niter $args
325} elseif { $runtype == "WAIT" } {
326	t106_consume $nitems $tnum $outputfile -consume_wait $dbenv $args
327} else {
328	error_check_good bad_args $runtype "either PRODUCE, or WAIT"
329}
330error_check_good env_close [$dbenv close] 0
331exit
332