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