1# See the file LICENSE for redistribution information.
2#
3# Copyright (c) 1996,2008 Oracle.  All rights reserved.
4#
5# $Id: recd006.tcl,v 12.8 2008/01/08 20:58:53 bostic Exp $
6#
7# TEST	recd006
8# TEST	Nested transactions.
9proc recd006 { method {select 0} args } {
10	global kvals
11	source ./include.tcl
12
13	set envargs ""
14	set zero_idx [lsearch -exact $args "-zero_log"]
15	if { $zero_idx != -1 } {
16		set args [lreplace $args $zero_idx $zero_idx]
17		set envargs "-zero_log"
18	}
19
20	set args [convert_args $method $args]
21	set omethod [convert_method $method]
22
23	if { [is_record_based $method] == 1 || [is_rbtree $method] == 1 } {
24		puts "Recd006 skipping for method $method"
25		return
26	}
27	puts "Recd006: $method nested transactions ($envargs)"
28
29	# Create the database and environment.
30	env_cleanup $testdir
31
32	set dbfile recd006.db
33	set testfile $testdir/$dbfile
34
35	puts "\tRecd006.a: create database"
36	set oflags "-create $args $omethod $testfile"
37	set db [eval {berkdb_open} $oflags]
38	error_check_good dbopen [is_valid_db $db] TRUE
39
40	# Make sure that we have enough entries to span a couple of
41	# different pages.
42	set did [open $dict]
43	set count 0
44	while { [gets $did str] != -1 && $count < 1000 } {
45		if { [string compare $omethod "-recno"] == 0 } {
46			set key [expr $count + 1]
47		} else {
48			set key $str
49		}
50
51		set ret [$db put -nooverwrite $key $str]
52		error_check_good put $ret 0
53
54		incr count
55	}
56	close $did
57
58	# Variables used below:
59	# p1: a pair of keys that are likely to be on the same page.
60	# p2: a pair of keys that are likely to be on the same page,
61	# but on a page different than those in p1.
62	set dbc [$db cursor]
63	error_check_good dbc [is_substr $dbc $db] 1
64
65	set ret [$dbc get -first]
66	error_check_bad dbc_get:DB_FIRST [llength $ret] 0
67	set p1 [lindex [lindex $ret 0] 0]
68	set kvals($p1) [lindex [lindex $ret 0] 1]
69
70	set ret [$dbc get -next]
71	error_check_bad dbc_get:DB_NEXT [llength $ret] 0
72	lappend p1 [lindex [lindex $ret 0] 0]
73	set kvals([lindex [lindex $ret 0] 0]) [lindex [lindex $ret 0] 1]
74
75	set ret [$dbc get -last]
76	error_check_bad dbc_get:DB_LAST [llength $ret] 0
77	set p2 [lindex [lindex $ret 0] 0]
78	set kvals($p2) [lindex [lindex $ret 0] 1]
79
80	set ret [$dbc get -prev]
81	error_check_bad dbc_get:DB_PREV [llength $ret] 0
82	lappend p2 [lindex [lindex $ret 0] 0]
83	set kvals([lindex [lindex $ret 0] 0]) [lindex [lindex $ret 0] 1]
84
85	error_check_good dbc_close [$dbc close] 0
86	error_check_good db_close [$db close] 0
87
88	# Now create the full transaction environment.
89	set eflags "-create -txn -home $testdir"
90
91	puts "\tRecd006.b: creating environment"
92	set env_cmd "berkdb_env $eflags"
93	set dbenv [eval $env_cmd]
94	error_check_bad dbenv $dbenv NULL
95
96	# Reset the environment.
97	reset_env $dbenv
98
99	set p1 [list $p1]
100	set p2 [list $p2]
101
102	# List of recovery tests: {CMD MSG} pairs
103	set rlist {
104	{ {nesttest DB TXNID ENV 1 $p1 $p2 commit commit}
105		"Recd006.c: children (commit commit)"}
106	{ {nesttest DB TXNID ENV 0 $p1 $p2 commit commit}
107		"Recd006.d: children (commit commit)"}
108	{ {nesttest DB TXNID ENV 1 $p1 $p2 commit abort}
109		"Recd006.e: children (commit abort)"}
110	{ {nesttest DB TXNID ENV 0 $p1 $p2 commit abort}
111		"Recd006.f: children (commit abort)"}
112	{ {nesttest DB TXNID ENV 1 $p1 $p2 abort abort}
113		"Recd006.g: children (abort abort)"}
114	{ {nesttest DB TXNID ENV 0 $p1 $p2 abort abort}
115		"Recd006.h: children (abort abort)"}
116	{ {nesttest DB TXNID ENV 1 $p1 $p2 abort commit}
117		"Recd006.i: children (abort commit)"}
118	{ {nesttest DB TXNID ENV 0 $p1 $p2 abort commit}
119		"Recd006.j: children (abort commit)"}
120	}
121
122	foreach pair $rlist {
123		set cmd [subst [lindex $pair 0]]
124		set msg [lindex $pair 1]
125		if { $select != 0 } {
126			set tag [lindex $msg 0]
127			set tail [expr [string length $tag] - 2]
128			set tag [string range $tag $tail $tail]
129			if { [lsearch $select $tag] == -1 } {
130				continue
131			}
132		}
133		op_recover abort $testdir $env_cmd $dbfile $cmd $msg
134		op_recover commit $testdir $env_cmd $dbfile $cmd $msg
135	}
136
137	puts "\tRecd006.k: Verify db_printlog can read logfile"
138	set tmpfile $testdir/printlog.out
139	set stat [catch {exec $util_path/db_printlog -h $testdir \
140	    > $tmpfile} ret]
141	error_check_good db_printlog $stat 0
142	fileremove $tmpfile
143}
144
145# Do the nested transaction test.
146# We want to make sure that children inherit properly from their
147# parents and that locks are properly handed back to parents
148# and that the right thing happens on commit/abort.
149# In particular:
150#	Write lock on parent, properly acquired by child.
151#	Committed operation on child gives lock to parent so that
152#		other child can also get the lock.
153#	Aborted op by child releases lock so other child can get it.
154#	Correct database state if child commits
155#	Correct database state if child aborts
156proc nesttest { db parent env do p1 p2 child1 child2} {
157	global kvals
158	source ./include.tcl
159
160	if { $do == 1 } {
161		set func toupper
162	} else {
163		set func tolower
164	}
165
166	# Do an RMW on the parent to get a write lock.
167	set p10 [lindex $p1 0]
168	set p11 [lindex $p1 1]
169	set p20 [lindex $p2 0]
170	set p21 [lindex $p2 1]
171
172	set ret [$db get -rmw -txn $parent $p10]
173	set res $ret
174	set Dret [lindex [lindex $ret 0] 1]
175	if { [string compare $Dret $kvals($p10)] == 0 ||
176	    [string compare $Dret [string toupper $kvals($p10)]] == 0 } {
177		set val 0
178	} else {
179		set val $Dret
180	}
181	error_check_good get_parent_RMW $val 0
182
183	# OK, do child 1
184	set kid1 [$env txn -parent $parent]
185	error_check_good kid1 [is_valid_txn $kid1 $env] TRUE
186
187	# Reading write-locked parent object should be OK
188	#puts "\tRead write-locked parent object for kid1."
189	set ret [$db get -txn $kid1 $p10]
190	error_check_good kid1_get10 $ret $res
191
192	# Now update this child
193	set data [lindex [lindex [string $func $ret] 0] 1]
194	set ret [$db put -txn $kid1 $p10 $data]
195	error_check_good kid1_put10 $ret 0
196
197	#puts "\tKid1 successful put."
198
199	# Now start child2
200	#puts "\tBegin txn for kid2."
201	set kid2 [$env txn -parent $parent]
202	error_check_good kid2 [is_valid_txn $kid2 $env] TRUE
203
204	# Getting anything in the p1 set should deadlock, so let's
205	# work on the p2 set.
206	set data [string $func $kvals($p20)]
207	#puts "\tPut data for kid2."
208	set ret [$db put -txn $kid2 $p20 $data]
209	error_check_good kid2_put20 $ret 0
210
211	#puts "\tKid2 data put successful."
212
213	# Now let's do the right thing to kid1
214	puts -nonewline "\tKid1 $child1..."
215	if { [string compare $child1 "commit"] == 0 } {
216		error_check_good kid1_commit [$kid1 commit] 0
217	} else {
218		error_check_good kid1_abort [$kid1 abort] 0
219	}
220	puts "complete"
221
222	# In either case, child2 should now be able to get the
223	# lock, either because it is inherited by the parent
224	# (commit) or because it was released (abort).
225	set data [string $func $kvals($p11)]
226	set ret [$db put -txn $kid2 $p11 $data]
227	error_check_good kid2_put11 $ret 0
228
229	# Now let's do the right thing to kid2
230	puts -nonewline "\tKid2 $child2..."
231	if { [string compare $child2 "commit"] == 0 } {
232		error_check_good kid2_commit [$kid2 commit] 0
233	} else {
234		error_check_good kid2_abort [$kid2 abort] 0
235	}
236	puts "complete"
237
238	# Now, let parent check that the right things happened.
239	# First get all four values
240	set p10_check [lindex [lindex [$db get -txn $parent $p10] 0] 0]
241	set p11_check [lindex [lindex [$db get -txn $parent $p11] 0] 0]
242	set p20_check [lindex [lindex [$db get -txn $parent $p20] 0] 0]
243	set p21_check [lindex [lindex [$db get -txn $parent $p21] 0] 0]
244
245	if { [string compare $child1 "commit"] == 0 } {
246		error_check_good parent_kid1 $p10_check \
247		    [string tolower [string $func $kvals($p10)]]
248	} else {
249		error_check_good \
250		    parent_kid1 $p10_check [string tolower $kvals($p10)]
251	}
252	if { [string compare $child2 "commit"] == 0 } {
253		error_check_good parent_kid2 $p11_check \
254		    [string tolower [string $func $kvals($p11)]]
255		error_check_good parent_kid2 $p20_check \
256		    [string tolower [string $func $kvals($p20)]]
257	} else {
258		error_check_good parent_kid2 $p11_check $kvals($p11)
259		error_check_good parent_kid2 $p20_check $kvals($p20)
260	}
261
262	# Now do a write on the parent for 21 whose lock it should
263	# either have or should be available.
264	set ret [$db put -txn $parent $p21 [string $func $kvals($p21)]]
265	error_check_good parent_put21 $ret 0
266
267	return 0
268}
269