blob: 0b2e2989949a99d5f7346828f8255de177b64d29 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
|
# See the file LICENSE for redistribution information.
#
# Copyright (c) 1996-2002
# Sleepycat Software. All rights reserved.
#
# $Id: test037.tcl,v 11.18 2002/03/15 16:30:54 sue Exp $
#
# TEST test037
# TEST Test DB_RMW
proc test037 { method {nentries 100} args } {
global encrypt
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 encargs ""
set args [split_encargs $args encargs]
set omethod [convert_method $method]
# Create the database
env_cleanup $testdir
set testfile test037.db
set local_env \
[eval {berkdb_env -create -mode 0644 -txn} $encargs -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 $encargs -home $testdir]
set local_env [eval $env_cmd]
error_check_good dbenv [is_valid_env $local_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 -auto_commit -env $local_env $testfile]
error_check_good dbopen [is_valid_db $db] TRUE
set rdb [send_cmd $f1 \
"berkdb_open -auto_commit -env $remote_env -mode 0644 $testfile"]
error_check_good remote:dbopen [is_valid_db $rdb] 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_txn $local_txn $local_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, 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
}
|
