← Back to branch summary

~ubuntu-branches/ubuntu/edgy/rpm/edgy

« back to all changes in this revision

Viewing changes to db/test/test070.tcl

  • Committer: Bazaar Package Importer
  • Author(s): Joey Hess
  • Date: 2002-01-22 20:56:57 UTC
  • Revision ID: james.westby@ubuntu.com-20020122205657-l74j50mr9z8ofcl5
Tags: upstream-4.0.3
Import upstream version 4.0.3

Show diffs side-by-side

added added

removed removed

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