blob: b12c757854aa2a8df2e3f2cb7658018b8473ced5 (
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
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
|
# See the file LICENSE for redistribution information.
#
# Copyright (c) 1996-2004
# Sleepycat Software. All rights reserved.
#
# $Id: recd008.tcl,v 1.30 2004/11/05 00:59:01 mjc Exp $
#
# TEST recd008
# TEST Test deeply nested transactions and many-child transactions.
proc recd008 { method {breadth 4} {depth 4} args} {
global kvals
source ./include.tcl
set args [convert_args $method $args]
set omethod [convert_method $method]
puts "Recd008: $method $breadth X $depth deeply nested transactions"
# Create the database and environment.
env_cleanup $testdir
set dbfile recd008.db
puts "\tRecd008.a: create database"
set db [eval {berkdb_open -create} $args $omethod $testdir/$dbfile]
error_check_good dbopen [is_valid_db $db] TRUE
# Make sure that we have enough entries to span a couple of
# different pages.
set did [open $dict]
set count 0
while { [gets $did str] != -1 && $count < 1000 } {
if { [is_record_based $method] == 1 } {
set key [expr $count + 1]
} else {
set key $str
}
if { $count == 500} {
set p1 $key
set kvals($p1) $str
}
set ret [$db put $key [chop_data $method $str]]
error_check_good put $ret 0
incr count
}
close $did
error_check_good db_close [$db close] 0
set txn_max [expr int([expr pow($breadth,$depth)])]
if { $txn_max < 20 } {
set txn_max 20
}
puts "\tRecd008.b: create environment for $txn_max transactions"
set lock_max 2500
set eflags "-mode 0644 -create -lock_max $lock_max -txn_max $txn_max \
-txn -home $testdir"
set env_cmd "berkdb_env $eflags"
set dbenv [eval $env_cmd]
error_check_good env_open [is_valid_env $dbenv] TRUE
reset_env $dbenv
set rlist {
{ {recd008_parent abort ENV DB $method $p1 TXNID 1 1 $breadth $depth}
"Recd008.c: child abort parent" }
{ {recd008_parent commit ENV DB $method $p1 TXNID 1 1 $breadth $depth}
"Recd008.d: child commit parent" }
}
foreach pair $rlist {
set cmd [subst [lindex $pair 0]]
set msg [lindex $pair 1]
op_recover abort $testdir $env_cmd $dbfile $cmd $msg
recd008_setkval $dbfile $p1
op_recover commit $testdir $env_cmd $dbfile $cmd $msg
recd008_setkval $dbfile $p1
}
puts "\tRecd008.e: Verify db_printlog can read logfile"
set tmpfile $testdir/printlog.out
set stat [catch {exec $util_path/db_printlog -h $testdir \
> $tmpfile} ret]
error_check_good db_printlog $stat 0
fileremove $tmpfile
}
proc recd008_setkval { dbfile p1 } {
global kvals
source ./include.tcl
set db [berkdb_open $testdir/$dbfile]
error_check_good dbopen [is_valid_db $db] TRUE
set ret [$db get $p1]
error_check_good dbclose [$db close] 0
set kvals($p1) [lindex [lindex $ret 0] 1]
}
# This is a lot like the op_recover procedure. We cannot use that
# because it was not meant to be called recursively. This proc
# knows about depth/breadth and file naming so that recursive calls
# don't overwrite various initial and afterop files, etc.
#
# The basic flow of this is:
# (Initial file)
# Parent begin transaction (in op_recover)
# Parent starts children
# Recursively call recd008_recover
# (children modify p1)
# Parent modifies p1
# (Afterop file)
# Parent commit/abort (in op_recover)
# (Final file)
# Recovery test (in op_recover)
proc recd008_parent { op env db method p1key parent b0 d0 breadth depth } {
global kvals
source ./include.tcl
#
# Save copy of original data
# Acquire lock on data
#
set olddata [pad_data $method $kvals($p1key)]
set ret [$db get -rmw -txn $parent $p1key]
set Dret [lindex [lindex $ret 0] 1]
error_check_good get_parent_RMW $Dret $olddata
#
# Parent spawns off children
#
set ret [recd008_txn $op $env $db $method $p1key $parent \
$b0 $d0 $breadth $depth]
puts "Child runs complete. Parent modifies data."
#
# Parent modifies p1
#
set newdata $olddata.parent
set ret [$db put -txn $parent $p1key [chop_data $method $newdata]]
error_check_good db_put $ret 0
#
# Save value in kvals for later comparison
#
switch $op {
"commit" {
set kvals($p1key) $newdata
}
"abort" {
set kvals($p1key) $olddata
}
}
return 0
}
proc recd008_txn { op env db method p1key parent b0 d0 breadth depth } {
global log_log_record_types
global kvals
source ./include.tcl
for {set d 1} {$d < $d0} {incr d} {
puts -nonewline "\t"
}
puts "Recd008_txn: $op parent:$parent $breadth $depth ($b0 $d0)"
# Save the initial file and open the environment and the file
for {set b $b0} {$b <= $breadth} {incr b} {
#
# Begin child transaction
#
set t [$env txn -parent $parent]
error_check_bad txn_begin $t NULL
error_check_good txn_begin [is_valid_txn $t $env] TRUE
set startd [expr $d0 + 1]
set child $b:$startd:$t
set olddata [pad_data $method $kvals($p1key)]
set newdata $olddata.$child
set ret [$db get -rmw -txn $t $p1key]
set Dret [lindex [lindex $ret 0] 1]
error_check_good get_parent_RMW $Dret $olddata
#
# Recursively call to set up nested transactions/children
#
for {set d $startd} {$d <= $depth} {incr d} {
set ret [recd008_txn commit $env $db $method $p1key $t \
$b $d $breadth $depth]
set ret [recd008_txn abort $env $db $method $p1key $t \
$b $d $breadth $depth]
}
#
# Modifies p1.
#
set ret [$db put -txn $t $p1key [chop_data $method $newdata]]
error_check_good db_put $ret 0
#
# Commit or abort
#
for {set d 1} {$d < $startd} {incr d} {
puts -nonewline "\t"
}
puts "Executing txn_$op:$t"
error_check_good txn_$op:$t [$t $op] 0
for {set d 1} {$d < $startd} {incr d} {
puts -nonewline "\t"
}
set ret [$db get -rmw -txn $parent $p1key]
set Dret [lindex [lindex $ret 0] 1]
set newdata [pad_data $method $newdata]
switch $op {
"commit" {
puts "Command executed and committed."
error_check_good get_parent_RMW $Dret $newdata
set kvals($p1key) $newdata
}
"abort" {
puts "Command executed and aborted."
error_check_good get_parent_RMW $Dret $olddata
set kvals($p1key) $olddata
}
}
}
return 0
}
|
