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