192 lines
5.1 KiB
Tcl
192 lines
5.1 KiB
Tcl
# See the file LICENSE for redistribution information.
|
|
#
|
|
# Copyright (c) 1996, 1997, 1998, 1999, 2000
|
|
# Sleepycat Software. All rights reserved.
|
|
#
|
|
# $Id: test037.tcl,v 11.11 2000/08/25 14:21:55 sue Exp $
|
|
#
|
|
# Test037: RMW functionality.
|
|
proc test037 { method {nentries 100} args } {
|
|
source ./include.tcl
|
|
set eindex [lsearch -exact $args "-env"]
|
|
#
|
|
# If we are using an env, then skip this test. It needs its own.
|
|
if { $eindex != -1 } {
|
|
incr eindex
|
|
set env [lindex $args $eindex]
|
|
puts "Test037 skipping for env $env"
|
|
return
|
|
}
|
|
|
|
puts "Test037: RMW $method"
|
|
|
|
set args [convert_args $method $args]
|
|
set omethod [convert_method $method]
|
|
|
|
# Create the database
|
|
env_cleanup $testdir
|
|
set testfile test037.db
|
|
|
|
set local_env \
|
|
[berkdb env -create -mode 0644 -txn -home $testdir]
|
|
error_check_good dbenv [is_valid_env $local_env] TRUE
|
|
|
|
set db [eval {berkdb_open \
|
|
-env $local_env -create -mode 0644 $omethod} $args {$testfile}]
|
|
error_check_good dbopen [is_valid_db $db] TRUE
|
|
|
|
set did [open $dict]
|
|
set count 0
|
|
|
|
set pflags ""
|
|
set gflags ""
|
|
set txn ""
|
|
|
|
if { [is_record_based $method] == 1 } {
|
|
append gflags " -recno"
|
|
}
|
|
|
|
puts "\tTest037.a: Creating database"
|
|
# Here is the loop where we put and get each key/data pair
|
|
while { [gets $did str] != -1 && $count < $nentries } {
|
|
if { [is_record_based $method] == 1 } {
|
|
global kvals
|
|
|
|
set key [expr $count + 1]
|
|
set kvals($key) [pad_data $method $str]
|
|
} else {
|
|
set key $str
|
|
}
|
|
set ret [eval {$db put} \
|
|
$txn $pflags {$key [chop_data $method $str]}]
|
|
error_check_good put $ret 0
|
|
|
|
set ret [eval {$db get} $txn $gflags {$key}]
|
|
error_check_good get \
|
|
[lindex [lindex $ret 0] 1] [pad_data $method $str]
|
|
incr count
|
|
}
|
|
close $did
|
|
error_check_good dbclose [$db close] 0
|
|
error_check_good envclode [$local_env close] 0
|
|
|
|
puts "\tTest037.b: Setting up environments"
|
|
|
|
# Open local environment
|
|
set env_cmd [concat berkdb env -create -txn -home $testdir]
|
|
set local_env [eval $env_cmd]
|
|
error_check_good dbenv [is_valid_widget $local_env env] TRUE
|
|
|
|
# Open local transaction
|
|
set local_txn [$local_env txn]
|
|
error_check_good txn_open [is_valid_txn $local_txn $local_env] TRUE
|
|
|
|
# Open remote environment
|
|
set f1 [open |$tclsh_path r+]
|
|
puts $f1 "source $test_path/test.tcl"
|
|
|
|
set remote_env [send_cmd $f1 $env_cmd]
|
|
error_check_good remote:env_open [is_valid_env $remote_env] TRUE
|
|
|
|
# Open remote transaction
|
|
set remote_txn [send_cmd $f1 "$remote_env txn"]
|
|
error_check_good \
|
|
remote:txn_open [is_valid_txn $remote_txn $remote_env] TRUE
|
|
|
|
# Now try put test without RMW. Gets on one site should not
|
|
# lock out gets on another.
|
|
|
|
# Open databases and dictionary
|
|
puts "\tTest037.c: Opening databases"
|
|
set did [open $dict]
|
|
set rkey 0
|
|
|
|
set db [berkdb_open -env $local_env $testfile]
|
|
error_check_good dbopen [is_valid_db $db] TRUE
|
|
set rdb [send_cmd $f1 \
|
|
"berkdb_open -env $remote_env -mode 0644 $testfile"]
|
|
error_check_good remote:dbopen [is_valid_widget $rdb db] TRUE
|
|
|
|
puts "\tTest037.d: Testing without RMW"
|
|
|
|
# Now, get a key and try to "get" it from both DBs.
|
|
error_check_bad "gets on new open" [gets $did str] -1
|
|
incr rkey
|
|
if { [is_record_based $method] == 1 } {
|
|
set key $rkey
|
|
} else {
|
|
set key $str
|
|
}
|
|
|
|
set rec [eval {$db get -txn $local_txn} $gflags {$key}]
|
|
error_check_good local_get [lindex [lindex $rec 0] 1] \
|
|
[pad_data $method $str]
|
|
|
|
set r [send_timed_cmd $f1 0 "$rdb get -txn $remote_txn $gflags $key"]
|
|
error_check_good remote_send $r 0
|
|
|
|
# Now sleep before releasing local record lock
|
|
tclsleep 5
|
|
error_check_good local_commit [$local_txn commit] 0
|
|
|
|
# Now get the remote result
|
|
set remote_time [rcv_result $f1]
|
|
error_check_good no_rmw_get:remote_time [expr $remote_time <= 1] 1
|
|
|
|
# Commit the remote
|
|
set r [send_cmd $f1 "$remote_txn commit"]
|
|
error_check_good remote_commit $r 0
|
|
|
|
puts "\tTest037.e: Testing with RMW"
|
|
|
|
# Open local transaction
|
|
set local_txn [$local_env txn]
|
|
error_check_good \
|
|
txn_open [is_valid_widget $local_txn $local_env.txn] TRUE
|
|
|
|
# Open remote transaction
|
|
set remote_txn [send_cmd $f1 "$remote_env txn"]
|
|
error_check_good remote:txn_open \
|
|
[is_valid_widget $remote_txn $remote_env.txn] TRUE
|
|
|
|
# Now, get a key and try to "get" it from both DBs.
|
|
error_check_bad "gets on new open" [gets $did str] -1
|
|
incr rkey
|
|
if { [is_record_based $method] == 1 } {
|
|
set key $rkey
|
|
} else {
|
|
set key $str
|
|
}
|
|
|
|
set rec [eval {$db get -txn $local_txn -rmw} $gflags {$key}]
|
|
error_check_good \
|
|
local_get [lindex [lindex $rec 0] 1] [pad_data $method $str]
|
|
|
|
set r [send_timed_cmd $f1 0 "$rdb get -txn $remote_txn $gflags $key"]
|
|
error_check_good remote_send $r 0
|
|
|
|
# Now sleep before releasing local record lock
|
|
tclsleep 5
|
|
error_check_good local_commit [$local_txn commit] 0
|
|
|
|
# Now get the remote result
|
|
set remote_time [rcv_result $f1]
|
|
error_check_good rmw_get:remote_time [expr $remote_time > 4] 1
|
|
|
|
# Commit the remote
|
|
set r [send_cmd $f1 "$remote_txn commit"]
|
|
error_check_good remote_commit $r 0
|
|
|
|
# Close everything up: remote first
|
|
set r [send_cmd $f1 "$rdb close"]
|
|
error_check_good remote_db_close $r 0
|
|
|
|
set r [send_cmd $f1 "$remote_env close"]
|
|
|
|
# Close locally
|
|
error_check_good db_close [$db close] 0
|
|
$local_env close
|
|
close $did
|
|
close $f1
|
|
}
|