1# See the file LICENSE for redistribution information.
2#
3# Copyright (c) 1996,2008 Oracle.  All rights reserved.
4#
5# $Id: txn003.tcl,v 12.10 2008/01/08 20:58:53 bostic Exp $
6#
7# TEST	txn003
8# TEST	Test abort/commit/prepare of txns with outstanding child txns.
9proc txn003 { {tnum "003"} } {
10	source ./include.tcl
11	global txn_curid
12	global txn_maxid
13
14	puts -nonewline "Txn$tnum: Outstanding child transaction test"
15
16	if { $tnum != "003" } {
17		puts " (with ID wrap)"
18	} else {
19		puts ""
20	}
21	env_cleanup $testdir
22	set testfile txn003.db
23
24	set env_cmd "berkdb_env_noerr -create -txn -home $testdir"
25	set env [eval $env_cmd]
26	error_check_good dbenv [is_valid_env $env] TRUE
27	error_check_good txn_id_set \
28	     [$env txn_id_set $txn_curid $txn_maxid] 0
29
30	set oflags {-auto_commit -create -btree -mode 0644 -env $env $testfile}
31	set db [eval {berkdb_open} $oflags]
32	error_check_good db_open [is_valid_db $db] TRUE
33
34	#
35	# Put some data so that we can check commit or abort of child
36	#
37	set key 1
38	set origdata some_data
39	set newdata this_is_new_data
40	set newdata2 some_other_new_data
41
42	error_check_good db_put [$db put $key $origdata] 0
43	error_check_good dbclose [$db close] 0
44
45	set db [eval {berkdb_open} $oflags]
46	error_check_good db_open [is_valid_db $db] TRUE
47
48	txn003_check $db $key "Origdata" $origdata
49
50	puts "\tTxn$tnum.a: Parent abort"
51	set parent [$env txn]
52	error_check_good txn_begin [is_valid_txn $parent $env] TRUE
53	set child [$env txn -parent $parent]
54	error_check_good txn_begin [is_valid_txn $child $env] TRUE
55	error_check_good db_put [$db put -txn $child $key $newdata] 0
56	error_check_good parent_abort [$parent abort] 0
57	txn003_check $db $key "parent_abort" $origdata
58	# Check child handle is invalid
59	set stat [catch {$child abort} ret]
60	error_check_good child_handle $stat 1
61	error_check_good child_h2 [is_substr $ret "invalid command name"] 1
62
63	puts "\tTxn$tnum.b: Parent commit"
64	set parent [$env txn]
65	error_check_good txn_begin [is_valid_txn $parent $env] TRUE
66	set child [$env txn -parent $parent]
67	error_check_good txn_begin [is_valid_txn $child $env] TRUE
68	error_check_good db_put [$db put -txn $child $key $newdata] 0
69	error_check_good parent_commit [$parent commit] 0
70	txn003_check $db $key "parent_commit" $newdata
71	# Check child handle is invalid
72	set stat [catch {$child abort} ret]
73	error_check_good child_handle $stat 1
74	error_check_good child_h2 [is_substr $ret "invalid command name"] 1
75	error_check_good dbclose [$db close] 0
76	error_check_good env_close [$env close] 0
77
78	#
79	# Since the data check assumes what has come before, the 'commit'
80	# operation must be last.
81	#
82	set hdr "\tTxn$tnum"
83	set rlist {
84		{begin		".c"}
85		{prepare	".d"}
86		{abort		".e"}
87		{commit		".f"}
88	}
89	set count 0
90	foreach pair $rlist {
91		incr count
92		set op [lindex $pair 0]
93		set msg [lindex $pair 1]
94		set msg $hdr$msg
95		txn003_body $env_cmd $testfile $testdir $key $newdata2 $msg $op
96		set env [eval $env_cmd]
97		error_check_good dbenv [is_valid_env $env] TRUE
98
99		berkdb debug_check
100		set db [eval {berkdb_open} $oflags]
101		error_check_good db_open [is_valid_db $db] TRUE
102		#
103		# For prepare we'll then just
104		# end up aborting after we test what we need to.
105		# So set gooddata to the same as abort.
106		switch $op {
107			abort {
108				set gooddata $newdata
109			}
110			begin {
111				set gooddata $newdata
112			}
113			commit {
114				set gooddata $newdata2
115			}
116			prepare {
117				set gooddata $newdata
118			}
119		}
120		txn003_check $db $key "parent_$op" $gooddata
121		error_check_good dbclose [$db close] 0
122		error_check_good env_close [$env close] 0
123	}
124
125	puts "\tTxn$tnum.g: Attempt child prepare"
126	set env [eval $env_cmd]
127	error_check_good dbenv [is_valid_env $env] TRUE
128	berkdb debug_check
129	set db [eval {berkdb_open_noerr} $oflags]
130	error_check_good db_open [is_valid_db $db] TRUE
131
132	set parent [$env txn]
133	error_check_good txn_begin [is_valid_txn $parent $env] TRUE
134	set child [$env txn -parent $parent]
135	error_check_good txn_begin [is_valid_txn $child $env] TRUE
136	error_check_good db_put [$db put -txn $child $key $newdata] 0
137	set gid [make_gid child_prepare:$child]
138	set stat [catch {$child prepare $gid} ret]
139	error_check_good child_prepare $stat 1
140	error_check_good child_prep_err [is_substr $ret "txn prepare"] 1
141
142	puts "\tTxn$tnum.h: Attempt child discard"
143	set stat [catch {$child discard} ret]
144	error_check_good child_discard $stat 1
145
146	# We just panic'd the region, so the next operations will fail.
147	# No matter, we still have to clean up all the handles.
148
149	set stat [catch {$parent commit} ret]
150	error_check_good parent_commit $stat 1
151	error_check_good parent_commit:fail [is_substr $ret "DB_RUNRECOVERY"] 1
152
153	set stat [catch {$db close} ret]
154	error_check_good db_close $stat 1
155	error_check_good db_close:fail [is_substr $ret "DB_RUNRECOVERY"] 1
156
157	set stat [catch {$env close} ret]
158	error_check_good env_close $stat 1
159	error_check_good env_close:fail [is_substr $ret "DB_RUNRECOVERY"] 1
160}
161
162proc txn003_body { env_cmd testfile dir key newdata2 msg op } {
163	source ./include.tcl
164
165	berkdb debug_check
166	sentinel_init
167	set gidf $dir/gidfile
168	fileremove -f $gidf
169	set pidlist {}
170	puts "$msg.0: Executing child script to prepare txns"
171	berkdb debug_check
172	set p [exec $tclsh_path $test_path/wrap.tcl txnscript.tcl \
173	    $testdir/txnout $env_cmd $testfile $gidf $key $newdata2 &]
174	lappend pidlist $p
175	watch_procs $pidlist 5
176	set f1 [open $testdir/txnout r]
177	set r [read $f1]
178	puts $r
179	close $f1
180	fileremove -f $testdir/txnout
181
182	berkdb debug_check
183	puts -nonewline "$msg.1: Running recovery ... "
184	flush stdout
185	berkdb debug_check
186	set env [eval $env_cmd "-recover"]
187	error_check_good dbenv-recover [is_valid_env $env] TRUE
188	puts "complete"
189
190	puts "$msg.2: getting txns from txn_recover"
191	set txnlist [$env txn_recover]
192	error_check_good txnlist_len [llength $txnlist] 1
193	set tpair [lindex $txnlist 0]
194
195	set gfd [open $gidf r]
196	set ret [gets $gfd parentgid]
197	close $gfd
198	set txn [lindex $tpair 0]
199	set gid [lindex $tpair 1]
200	if { $op == "begin" } {
201		puts "$msg.2: $op new txn"
202	} else {
203		puts "$msg.2: $op parent"
204	}
205	error_check_good gidcompare $gid $parentgid
206	if { $op == "prepare" } {
207		set gid [make_gid prepare_recover:$txn]
208		set stat [catch {$txn $op $gid} ret]
209		error_check_good prep_error $stat 1
210		error_check_good prep_err \
211		    [is_substr $ret "transaction already prepared"] 1
212		error_check_good txn:prep_abort [$txn abort] 0
213	} elseif { $op == "begin" } {
214		# As of the 4.6 release, we allow new txns to be created
215		# while prepared but not committed txns exist, so this
216		# should succeed.
217		set txn2 [$env txn]
218		error_check_good txn:begin_abort [$txn abort] 0
219		error_check_good txn2:begin_abort [$txn2 abort] 0
220	} else {
221		error_check_good txn:$op [$txn $op] 0
222	}
223	error_check_good envclose [$env close] 0
224}
225
226proc txn003_check { db key msg gooddata } {
227	set kd [$db get $key]
228	set data [lindex [lindex $kd 0] 1]
229	error_check_good $msg $data $gooddata
230}
231