1
# See the file LICENSE for redistribution information.
3
# Copyright (c) 1996-2001
4
# Sleepycat Software. All rights reserved.
6
# $Id: recd006.tcl,v 11.22 2001/01/25 18:23:06 bostic Exp $
9
# Test nested transactions.
10
proc recd006 { method {select 0} args} {
14
set args [convert_args $method $args]
15
set omethod [convert_method $method]
17
if { [is_record_based $method] == 1 || [is_rbtree $method] == 1 } {
18
puts "Recd006 skipping for method $method"
21
puts "Recd006: $method nested transactions"
23
# Create the database and environment.
27
set testfile $testdir/$dbfile
29
puts "\tRecd006.a: create database"
30
set oflags "-create $args $omethod $testfile"
31
set db [eval {berkdb_open} $oflags]
32
error_check_good dbopen [is_valid_db $db] TRUE
34
# Make sure that we have enough entries to span a couple of
38
while { [gets $did str] != -1 && $count < 1000 } {
39
if { [string compare $omethod "-recno"] == 0 } {
40
set key [expr $count + 1]
45
set ret [$db put -nooverwrite $key $str]
46
error_check_good put $ret 0
52
# Variables used below:
53
# p1: a pair of keys that are likely to be on the same page.
54
# p2: a pair of keys that are likely to be on the same page,
55
# but on a page different than those in p1.
57
error_check_good dbc [is_substr $dbc $db] 1
59
set ret [$dbc get -first]
60
error_check_bad dbc_get:DB_FIRST [llength $ret] 0
61
set p1 [lindex [lindex $ret 0] 0]
62
set kvals($p1) [lindex [lindex $ret 0] 1]
64
set ret [$dbc get -next]
65
error_check_bad dbc_get:DB_NEXT [llength $ret] 0
66
lappend p1 [lindex [lindex $ret 0] 0]
67
set kvals([lindex [lindex $ret 0] 0]) [lindex [lindex $ret 0] 1]
69
set ret [$dbc get -last]
70
error_check_bad dbc_get:DB_LAST [llength $ret] 0
71
set p2 [lindex [lindex $ret 0] 0]
72
set kvals($p2) [lindex [lindex $ret 0] 1]
74
set ret [$dbc get -prev]
75
error_check_bad dbc_get:DB_PREV [llength $ret] 0
76
lappend p2 [lindex [lindex $ret 0] 0]
77
set kvals([lindex [lindex $ret 0] 0]) [lindex [lindex $ret 0] 1]
79
error_check_good dbc_close [$dbc close] 0
80
error_check_good db_close [$db close] 0
82
# Now create the full transaction environment.
83
set eflags "-create -txn -home $testdir"
85
puts "\tRecd006.b: creating environment"
86
set env_cmd "berkdb env $eflags"
87
set dbenv [eval $env_cmd]
88
error_check_bad dbenv $dbenv NULL
90
# Reset the environment.
96
# List of recovery tests: {CMD MSG} pairs
98
{ {nesttest DB TXNID ENV 1 $p1 $p2 commit commit}
99
"Recd006.c: children (commit commit)"}
100
{ {nesttest DB TXNID ENV 0 $p1 $p2 commit commit}
101
"Recd006.d: children (commit commit)"}
102
{ {nesttest DB TXNID ENV 1 $p1 $p2 commit abort}
103
"Recd006.e: children (commit abort)"}
104
{ {nesttest DB TXNID ENV 0 $p1 $p2 commit abort}
105
"Recd006.f: children (commit abort)"}
106
{ {nesttest DB TXNID ENV 1 $p1 $p2 abort abort}
107
"Recd006.g: children (abort abort)"}
108
{ {nesttest DB TXNID ENV 0 $p1 $p2 abort abort}
109
"Recd006.h: children (abort abort)"}
110
{ {nesttest DB TXNID ENV 1 $p1 $p2 abort commit}
111
"Recd006.i: children (abort commit)"}
112
{ {nesttest DB TXNID ENV 0 $p1 $p2 abort commit}
113
"Recd006.j: children (abort commit)"}
116
foreach pair $rlist {
117
set cmd [subst [lindex $pair 0]]
118
set msg [lindex $pair 1]
119
if { $select != 0 } {
120
set tag [lindex $msg 0]
121
set tail [expr [string length $tag] - 2]
122
set tag [string range $tag $tail $tail]
123
if { [lsearch $select $tag] == -1 } {
127
op_recover abort $testdir $env_cmd $dbfile $cmd $msg
128
op_recover commit $testdir $env_cmd $dbfile $cmd $msg
131
puts "\tRecd006.k: Verify db_printlog can read logfile"
132
set tmpfile $testdir/printlog.out
133
set stat [catch {exec $util_path/db_printlog -h $testdir \
135
error_check_good db_printlog $stat 0
139
# Do the nested transaction test.
140
# We want to make sure that children inherit properly from their
141
# parents and that locks are properly handed back to parents
142
# and that the right thing happens on commit/abort.
144
# Write lock on parent, properly acquired by child.
145
# Committed operation on child gives lock to parent so that
146
# other child can also get the lock.
147
# Aborted op by child releases lock so other child can get it.
148
# Correct database state if child commits
149
# Correct database state if child aborts
150
proc nesttest { db parent env do p1 p2 child1 child2} {
160
# Do an RMW on the parent to get a write lock.
161
set p10 [lindex $p1 0]
162
set p11 [lindex $p1 1]
163
set p20 [lindex $p2 0]
164
set p21 [lindex $p2 1]
166
set ret [$db get -rmw -txn $parent $p10]
168
set Dret [lindex [lindex $ret 0] 1]
169
if { [string compare $Dret $kvals($p10)] == 0 ||
170
[string compare $Dret [string toupper $kvals($p10)]] == 0 } {
175
error_check_good get_parent_RMW $val 0
178
set kid1 [$env txn -parent $parent]
179
error_check_good kid1 [is_valid_widget $kid1 $env.txn] TRUE
181
# Reading write-locked parent object should be OK
182
#puts "\tRead write-locked parent object for kid1."
183
set ret [$db get -txn $kid1 $p10]
184
error_check_good kid1_get10 $ret $res
186
# Now update this child
187
set data [lindex [lindex [string $func $ret] 0] 1]
188
set ret [$db put -txn $kid1 $p10 $data]
189
error_check_good kid1_put10 $ret 0
191
#puts "\tKid1 successful put."
194
#puts "\tBegin txn for kid2."
195
set kid2 [$env txn -parent $parent]
196
error_check_good kid2 [is_valid_widget $kid2 $env.txn] TRUE
198
# Getting anything in the p1 set should deadlock, so let's
199
# work on the p2 set.
200
set data [string $func $kvals($p20)]
201
#puts "\tPut data for kid2."
202
set ret [$db put -txn $kid2 $p20 $data]
203
error_check_good kid2_put20 $ret 0
205
#puts "\tKid2 data put successful."
207
# Now let's do the right thing to kid1
208
puts -nonewline "\tKid1 $child1..."
209
if { [string compare $child1 "commit"] == 0 } {
210
error_check_good kid1_commit [$kid1 commit] 0
212
error_check_good kid1_abort [$kid1 abort] 0
216
# In either case, child2 should now be able to get the
217
# lock, either because it is inherited by the parent
218
# (commit) or because it was released (abort).
219
set data [string $func $kvals($p11)]
220
set ret [$db put -txn $kid2 $p11 $data]
221
error_check_good kid2_put11 $ret 0
223
# Now let's do the right thing to kid2
224
puts -nonewline "\tKid2 $child2..."
225
if { [string compare $child2 "commit"] == 0 } {
226
error_check_good kid2_commit [$kid2 commit] 0
228
error_check_good kid2_abort [$kid2 abort] 0
232
# Now, let parent check that the right things happened.
233
# First get all four values
234
set p10_check [lindex [lindex [$db get -txn $parent $p10] 0] 0]
235
set p11_check [lindex [lindex [$db get -txn $parent $p11] 0] 0]
236
set p20_check [lindex [lindex [$db get -txn $parent $p20] 0] 0]
237
set p21_check [lindex [lindex [$db get -txn $parent $p21] 0] 0]
239
if { [string compare $child1 "commit"] == 0 } {
240
error_check_good parent_kid1 $p10_check \
241
[string tolower [string $func $kvals($p10)]]
244
parent_kid1 $p10_check [string tolower $kvals($p10)]
246
if { [string compare $child2 "commit"] == 0 } {
247
error_check_good parent_kid2 $p11_check \
248
[string tolower [string $func $kvals($p11)]]
249
error_check_good parent_kid2 $p20_check \
250
[string tolower [string $func $kvals($p20)]]
252
error_check_good parent_kid2 $p11_check $kvals($p11)
253
error_check_good parent_kid2 $p20_check $kvals($p20)
256
# Now do a write on the parent for 21 whose lock it should
257
# either have or should be available.
258
set ret [$db put -txn $parent $p21 [string $func $kvals($p21)]]
259
error_check_good parent_put21 $ret 0
added
removed
db/test/recd006.tcl
