1# See the file LICENSE for redistribution information.
2#
3# Copyright (c) 1999,2008 Oracle.  All rights reserved.
4#
5# $Id: test070.tcl,v 12.6 2008/01/08 20:58:53 bostic Exp $
6#
7# TEST	test070
8# TEST	Test of DB_CONSUME (Four consumers, 1000 items.)
9# TEST
10# TEST	Fork off six processes, four consumers and two producers.
11# TEST	The producers will each put 20000 records into a queue;
12# TEST	the consumers will each get 10000.
13# TEST	Then, verify that no record was lost or retrieved twice.
14proc test070 { method {nconsumers 4} {nproducers 2} \
15    {nitems 1000} {mode CONSUME } {start 0} {txn -txn} {tnum "070"} args } {
16	source ./include.tcl
17	global alphabet
18	global encrypt
19
20	#
21	# If we are using an env, then skip this test.  It needs its own.
22	set eindex [lsearch -exact $args "-env"]
23	if { $eindex != -1 } {
24		incr eindex
25		set env [lindex $args $eindex]
26		puts "Test$tnum skipping for env $env"
27		return
28	}
29	set omethod [convert_method $method]
30	set args [convert_args $method $args]
31	if { $encrypt != 0 } {
32		puts "Test$tnum skipping for security"
33		return
34	}
35
36	puts "Test$tnum: $method ($args) Test of DB_$mode flag to DB->get."
37	puts "\tUsing $txn environment."
38
39	error_check_good enough_consumers [expr $nconsumers > 0] 1
40	error_check_good enough_producers [expr $nproducers > 0] 1
41
42	if { [is_queue $method] != 1 } {
43		puts "\tSkipping Test$tnum for method $method."
44		return
45	}
46
47	env_cleanup $testdir
48	set testfile test$tnum.db
49
50	# Create environment
51	set dbenv [eval {berkdb_env -create $txn -home } $testdir]
52	error_check_good dbenv_create [is_valid_env $dbenv] TRUE
53
54	# Create database
55	set db [eval {berkdb_open -create -mode 0644 -queue}\
56		-env $dbenv $args $testfile]
57	error_check_good db_open [is_valid_db $db] TRUE
58
59	if { $start != 0 } {
60		error_check_good set_seed [$db put $start "consumer data"] 0
61		puts "\tTest$tnum: starting at $start."
62	} else {
63		incr start
64	}
65
66	set pidlist {}
67
68	# Divvy up the total number of records amongst the consumers and
69	# producers.
70	error_check_good cons_div_evenly [expr $nitems % $nconsumers] 0
71	error_check_good prod_div_evenly [expr $nitems % $nproducers] 0
72	set nperconsumer [expr $nitems / $nconsumers]
73	set nperproducer [expr $nitems / $nproducers]
74
75	set consumerlog $testdir/CONSUMERLOG.
76
77	# Fork consumer processes (we want them to be hungry)
78	for { set ndx 0 } { $ndx < $nconsumers } { incr ndx } {
79		set output $consumerlog$ndx
80		set p [exec $tclsh_path $test_path/wrap.tcl \
81		    conscript.tcl $testdir/conscript.log.consumer$ndx \
82		    $testdir $testfile $mode $nperconsumer $output $tnum \
83		    $args &]
84		lappend pidlist $p
85	}
86	for { set ndx 0 } { $ndx < $nproducers } { incr ndx } {
87		set p [exec $tclsh_path $test_path/wrap.tcl \
88		    conscript.tcl $testdir/conscript.log.producer$ndx \
89		    $testdir $testfile PRODUCE $nperproducer "" $tnum \
90		    $args &]
91		lappend pidlist $p
92	}
93
94	# Wait for all children.
95	watch_procs $pidlist 10
96
97	# Verify: slurp all record numbers into list, sort, and make
98	# sure each appears exactly once.
99	puts "\tTest$tnum: Verifying results."
100	set reclist {}
101	for { set ndx 0 } { $ndx < $nconsumers } { incr ndx } {
102		set input $consumerlog$ndx
103		set iid [open $input r]
104		while { [gets $iid str] != -1 } {
105			lappend reclist $str
106		}
107		close $iid
108	}
109	set sortreclist [lsort -command int32_compare $reclist]
110
111	set nitems [expr $start + $nitems]
112	for { set ndx $start } { $ndx < $nitems } { set ndx [expr $ndx + 1] } {
113		# Wrap if $ndx goes beyond 32 bits because our
114		# recno wrapped if it did.
115		if { $ndx > 0xffffffff } {
116			set cmp [expr $ndx - 0xffffffff]
117		} else {
118			set cmp [expr $ndx + 0]
119		}
120		# Skip 0 if we are wrapping around
121		if { $cmp == 0 } {
122			incr ndx
123			incr nitems
124			incr cmp
125		}
126		# Be sure to convert ndx to a number before comparing.
127		error_check_good pop_num [lindex $sortreclist 0] $cmp
128		set sortreclist [lreplace $sortreclist 0 0]
129	}
130	error_check_good list_ends_empty $sortreclist {}
131	error_check_good db_close [$db close] 0
132	error_check_good dbenv_close [$dbenv close] 0
133
134	puts "\tTest$tnum completed successfully."
135}
136