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
|
# See the file LICENSE for redistribution information.
#
# Copyright (c) 1999-2002
# Sleepycat Software. All rights reserved.
#
# $Id: recd015.tcl,v 1.1.1.1 2003/11/20 22:13:58 toshok Exp $
#
# TEST recd015
# TEST This is a recovery test for testing lots of prepared txns.
# TEST This test is to force the use of txn_recover to call with the
# TEST DB_FIRST flag and then DB_NEXT.
proc recd015 { method args } {
source ./include.tcl
set args [convert_args $method $args]
set omethod [convert_method $method]
puts "Recd015: $method ($args) prepared txns test"
# Create the database and environment.
set numtxns 1
set testfile NULL
set env_cmd "berkdb_env -create -txn -home $testdir"
set msg "\tRecd015.a"
puts "$msg Simple test to prepare $numtxns txn "
foreach op { abort commit discard } {
env_cleanup $testdir
recd015_body $env_cmd $testfile $numtxns $msg $op
}
#
# Now test large numbers of prepared txns to test DB_NEXT
# on txn_recover.
#
set numtxns 250
set testfile recd015.db
set txnmax [expr $numtxns + 5]
#
# For this test we create our database ahead of time so that we
# don't need to send methods and args to the script.
#
env_cleanup $testdir
set env_cmd "berkdb_env -create -txn_max $txnmax -txn -home $testdir"
set env [eval $env_cmd]
error_check_good dbenv [is_valid_env $env] TRUE
set db [eval {berkdb_open -create} $omethod -env $env $args $testfile]
error_check_good dbopen [is_valid_db $db] TRUE
error_check_good dbclose [$db close] 0
error_check_good envclose [$env close] 0
set msg "\tRecd015.b"
puts "$msg Large test to prepare $numtxns txn "
foreach op { abort commit discard } {
recd015_body $env_cmd $testfile $numtxns $msg $op
}
set stat [catch {exec $util_path/db_printlog -h $testdir \
> $testdir/LOG } ret]
error_check_good db_printlog $stat 0
fileremove $testdir/LOG
}
proc recd015_body { env_cmd testfile numtxns msg op } {
source ./include.tcl
sentinel_init
set gidf $testdir/gidfile
fileremove -f $gidf
set pidlist {}
puts "$msg.0: Executing child script to prepare txns"
berkdb debug_check
set p [exec $tclsh_path $test_path/wrap.tcl recd15scr.tcl \
$testdir/recdout $env_cmd $testfile $gidf $numtxns &]
lappend pidlist $p
watch_procs $pidlist 5
set f1 [open $testdir/recdout r]
set r [read $f1]
puts $r
close $f1
fileremove -f $testdir/recdout
berkdb debug_check
puts -nonewline "$msg.1: Running recovery ... "
flush stdout
berkdb debug_check
set env [eval $env_cmd -recover]
error_check_good dbenv-recover [is_valid_env $env] TRUE
puts "complete"
puts "$msg.2: getting txns from txn_recover"
set txnlist [$env txn_recover]
error_check_good txnlist_len [llength $txnlist] $numtxns
set gfd [open $gidf r]
set i 0
while { [gets $gfd gid] != -1 } {
set gids($i) $gid
incr i
}
close $gfd
#
# Make sure we have as many as we expect
error_check_good num_gids $i $numtxns
set i 0
puts "$msg.3: comparing GIDs and $op txns"
foreach tpair $txnlist {
set txn [lindex $tpair 0]
set gid [lindex $tpair 1]
error_check_good gidcompare $gid $gids($i)
error_check_good txn:$op [$txn $op] 0
incr i
}
if { $op != "discard" } {
error_check_good envclose [$env close] 0
return
}
#
# If we discarded, now do it again and randomly resolve some
# until all txns are resolved.
#
puts "$msg.4: resolving/discarding txns"
set txnlist [$env txn_recover]
set len [llength $txnlist]
set opval(1) "abort"
set opcnt(1) 0
set opval(2) "commit"
set opcnt(2) 0
set opval(3) "discard"
set opcnt(3) 0
while { $len != 0 } {
set opicnt(1) 0
set opicnt(2) 0
set opicnt(3) 0
#
# Abort/commit or discard them randomly until
# all are resolved.
#
for { set i 0 } { $i < $len } { incr i } {
set t [lindex $txnlist $i]
set txn [lindex $t 0]
set newop [berkdb random_int 1 3]
set ret [$txn $opval($newop)]
error_check_good txn_$opval($newop):$i $ret 0
incr opcnt($newop)
incr opicnt($newop)
}
# puts "$opval(1): $opicnt(1) Total: $opcnt(1)"
# puts "$opval(2): $opicnt(2) Total: $opcnt(2)"
# puts "$opval(3): $opicnt(3) Total: $opcnt(3)"
set txnlist [$env txn_recover]
set len [llength $txnlist]
}
error_check_good envclose [$env close] 0
}
|
