1# See the file LICENSE for redistribution information. 2# 3# Copyright (c) 1996,2008 Oracle. All rights reserved. 4# 5# $Id: rpc006.tcl,v 12.7 2008/01/08 20:58:53 bostic Exp $ 6# 7# TEST rpc006 8# TEST Test RPC server and multiple operations to server. 9# TEST Make sure the server doesn't deadlock itself, but 10# TEST returns DEADLOCK to the client. 11proc rpc006 { } { 12 global __debug_on 13 global __debug_print 14 global errorInfo 15 global rpc_svc 16 source ./include.tcl 17 18 puts "Rpc006: RPC server + multiple operations" 19 puts "Rpc006: Using $rpc_svc" 20 cleanup $testdir NULL 21 set dpid [rpc_server_start] 22 puts "\tRpc006.a: Started server, pid $dpid" 23 24 # 25 # Wrap the test in a catch statement so we can still kill 26 # the rpc server even if the test fails. 27 # 28 set status [catch { 29 tclsleep 2 30 remote_cleanup $rpc_server $rpc_testdir $testdir 31 32 puts "\tRpc006.b: Creating environment" 33 34 set testfile "rpc006.db" 35 set home [file tail $rpc_testdir] 36 37 set env [eval {berkdb_env -create -mode 0644 -home $home \ 38 -server $rpc_server -txn}] 39 error_check_good lock_env:open [is_valid_env $env] TRUE 40 41 # 42 # NOTE: the type of database doesn't matter, just use btree. 43 set db [eval {berkdb_open -auto_commit -create -btree \ 44 -mode 0644} -env $env $testfile] 45 error_check_good dbopen [is_valid_db $db] TRUE 46 47 puts "\tRpc006.c: Create competing transactions" 48 set txn1 [$env txn] 49 set txn2 [$env txn] 50 error_check_good txn [is_valid_txn $txn1 $env] TRUE 51 error_check_good txn [is_valid_txn $txn2 $env] TRUE 52 set key1 "key1" 53 set key2 "key2" 54 set data1 "data1" 55 set data2 "data2" 56 57 puts "\tRpc006.d: Put with both txns to same page. Deadlock" 58 set ret [$db put -txn $txn1 $key1 $data1] 59 error_check_good db_put $ret 0 60 set res [catch {$db put -txn $txn2 $key2 $data2} ret] 61 error_check_good db_put2 $res 1 62 error_check_good db_putret [is_substr $ret DB_LOCK_DEADLOCK] 1 63 error_check_good txn_commit [$txn1 commit] 0 64 65 puts "\tRpc006.e: Retry after commit." 66 set res [catch {$db put -txn $txn2 $key2 $data2} ret] 67 error_check_good db_put2 $res 0 68 error_check_good db_putret $ret 0 69 error_check_good txn_commit [$txn2 commit] 0 70 error_check_good db_close [$db close] 0 71 error_check_good env_close [$env close] 0 72 } res] 73 if { $status != 0 } { 74 puts $res 75 } 76 tclkill $dpid 77} 78