test/tcl/test070.tcl

   1 # See the file LICENSE for redistribution information.
   2 #
   3 # Copyright (c) 1999, 2012 Oracle and/or its affiliates.  All rights reserved.
   4 #
   5 # $Id$
   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.
  14 proc 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         set pageargs ""
  36         split_pageargs $args pageargs
  37
  38         puts "Test$tnum: $method ($args) Test of DB_$mode flag to DB->get."
  39         puts "\tUsing $txn environment."
  40
  41         error_check_good enough_consumers [expr $nconsumers > 0] 1
  42         error_check_good enough_producers [expr $nproducers > 0] 1
  43
  44         if { [is_queue $method] != 1 } {
  45                 puts "\tSkipping Test$tnum for method $method."
  46                 return
  47         }
  48
  49         env_cleanup $testdir
  50         set testfile test$tnum.db
  51
  52         # Create environment
  53         set dbenv [eval {berkdb_env -create $txn -home } $testdir $pageargs]
  54         error_check_good dbenv_create [is_valid_env $dbenv] TRUE
  55
  56         # Create database
  57         set db [eval {berkdb_open -create -mode 0644 -queue}\
  58                 -env $dbenv $args $testfile]
  59         error_check_good db_open [is_valid_db $db] TRUE
  60
  61         if { $start != 0 } {
  62                 error_check_good set_seed [$db put $start "consumer data"] 0
  63                 puts "\tTest$tnum: starting at $start."
  64         } else {
  65                 incr start
  66         }
  67
  68         set pidlist {}
  69
  70         # Divvy up the total number of records amongst the consumers and
  71         # producers.
  72         error_check_good cons_div_evenly [expr $nitems % $nconsumers] 0
  73         error_check_good prod_div_evenly [expr $nitems % $nproducers] 0
  74         set nperconsumer [expr $nitems / $nconsumers]
  75         set nperproducer [expr $nitems / $nproducers]
  76
  77         set consumerlog $testdir/CONSUMERLOG.
  78
  79         # Fork consumer processes (we want them to be hungry)
  80         for { set ndx 0 } { $ndx < $nconsumers } { incr ndx } {
  81                 set output $consumerlog$ndx
  82                 set p [exec $tclsh_path $test_path/wrap.tcl \
  83                     conscript.tcl $testdir/conscript.log.consumer$ndx \
  84                     $testdir $testfile $mode $nperconsumer $output $tnum \
  85                     $args &]
  86                 lappend pidlist $p
  87         }
  88         for { set ndx 0 } { $ndx < $nproducers } { incr ndx } {
  89                 set p [exec $tclsh_path $test_path/wrap.tcl \
  90                     conscript.tcl $testdir/conscript.log.producer$ndx \
  91                     $testdir $testfile PRODUCE $nperproducer "" $tnum \
  92                     $args &]
  93                 lappend pidlist $p
  94         }
  95
  96         # Wait for all children.
  97         watch_procs $pidlist 10
  98
  99         # Verify: slurp all record numbers into list, sort, and make
 100         # sure each appears exactly once.
 101         puts "\tTest$tnum: Verifying results."
 102         set reclist {}
 103         for { set ndx 0 } { $ndx < $nconsumers } { incr ndx } {
 104                 set input $consumerlog$ndx
 105                 set iid [open $input r]
 106                 while { [gets $iid str] != -1 } {
 107                         lappend reclist $str
 108                 }
 109                 close $iid
 110         }
 111         set sortreclist [lsort -command int32_compare $reclist]
 112
 113         set nitems [expr $start + $nitems]
 114         for { set ndx $start } { $ndx < $nitems } { set ndx [expr $ndx + 1] } {
 115                 # Wrap if $ndx goes beyond 32 bits because our
 116                 # recno wrapped if it did.
 117                 if { $ndx > 0xffffffff } {
 118                         set cmp [expr $ndx - 0xffffffff]
 119                 } else {
 120                         set cmp [expr $ndx + 0]
 121                 }
 122                 # Skip 0 if we are wrapping around
 123                 if { $cmp == 0 } {
 124                         incr ndx
 125                         incr nitems
 126                         incr cmp
 127                 }
 128                 # Be sure to convert ndx to a number before comparing.
 129                 error_check_good pop_num [lindex $sortreclist 0] $cmp
 130                 set sortreclist [lreplace $sortreclist 0 0]
 131         }
 132         error_check_good list_ends_empty $sortreclist {}
 133         error_check_good db_close [$db close] 0
 134         error_check_good dbenv_close [$dbenv close] 0
 135
 136         puts "\tTest$tnum completed successfully."
 137 }