summaryrefslogtreecommitdiff
path: root/test/txn003.tcl
blob: 90b3e9e637cced3e9f6c13757e5bc6b2b0f8533e (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
227
228
229
230
# See the file LICENSE for redistribution information.
#
# Copyright (c) 1996-2009 Oracle.  All rights reserved.
#
# $Id$
#
# TEST	txn003
# TEST	Test abort/commit/prepare of txns with outstanding child txns.
proc txn003 { {tnum "003"} } {
	source ./include.tcl
	global txn_curid
	global txn_maxid

	puts -nonewline "Txn$tnum: Outstanding child transaction test"

	if { $tnum != "003" } {
		puts " (with ID wrap)"
	} else {
		puts ""
	}
	env_cleanup $testdir
	set testfile txn003.db

	set env_cmd "berkdb_env_noerr -create -txn -home $testdir"
	set env [eval $env_cmd]
	error_check_good dbenv [is_valid_env $env] TRUE
	error_check_good txn_id_set \
	     [$env txn_id_set $txn_curid $txn_maxid] 0

	set oflags {-auto_commit -create -btree -mode 0644 -env $env $testfile}
	set db [eval {berkdb_open} $oflags]
	error_check_good db_open [is_valid_db $db] TRUE

	#
	# Put some data so that we can check commit or abort of child
	#
	set key 1
	set origdata some_data
	set newdata this_is_new_data
	set newdata2 some_other_new_data

	error_check_good db_put [$db put $key $origdata] 0
	error_check_good dbclose [$db close] 0

	set db [eval {berkdb_open} $oflags]
	error_check_good db_open [is_valid_db $db] TRUE

	txn003_check $db $key "Origdata" $origdata

	puts "\tTxn$tnum.a: Parent abort"
	set parent [$env txn]
	error_check_good txn_begin [is_valid_txn $parent $env] TRUE
	set child [$env txn -parent $parent]
	error_check_good txn_begin [is_valid_txn $child $env] TRUE
	error_check_good db_put [$db put -txn $child $key $newdata] 0
	error_check_good parent_abort [$parent abort] 0
	txn003_check $db $key "parent_abort" $origdata
	# Check child handle is invalid
	set stat [catch {$child abort} ret]
	error_check_good child_handle $stat 1
	error_check_good child_h2 [is_substr $ret "invalid command name"] 1

	puts "\tTxn$tnum.b: Parent commit"
	set parent [$env txn]
	error_check_good txn_begin [is_valid_txn $parent $env] TRUE
	set child [$env txn -parent $parent]
	error_check_good txn_begin [is_valid_txn $child $env] TRUE
	error_check_good db_put [$db put -txn $child $key $newdata] 0
	error_check_good parent_commit [$parent commit] 0
	txn003_check $db $key "parent_commit" $newdata
	# Check child handle is invalid
	set stat [catch {$child abort} ret]
	error_check_good child_handle $stat 1
	error_check_good child_h2 [is_substr $ret "invalid command name"] 1
	error_check_good dbclose [$db close] 0
	error_check_good env_close [$env close] 0

	#
	# Since the data check assumes what has come before, the 'commit'
	# operation must be last.
	#
	set hdr "\tTxn$tnum"
	set rlist {
		{begin		".c"}
		{prepare	".d"}
		{abort		".e"}
		{commit		".f"}
	}
	set count 0
	foreach pair $rlist {
		incr count
		set op [lindex $pair 0]
		set msg [lindex $pair 1]
		set msg $hdr$msg
		txn003_body $env_cmd $testfile $testdir $key $newdata2 $msg $op
		set env [eval $env_cmd]
		error_check_good dbenv [is_valid_env $env] TRUE

		berkdb debug_check
		set db [eval {berkdb_open} $oflags]
		error_check_good db_open [is_valid_db $db] TRUE
		#
		# For prepare we'll then just
		# end up aborting after we test what we need to.
		# So set gooddata to the same as abort.
		switch $op {
			abort {
				set gooddata $newdata
			}
			begin {
				set gooddata $newdata
			}
			commit {
				set gooddata $newdata2
			}
			prepare {
				set gooddata $newdata
			}
		}
		txn003_check $db $key "parent_$op" $gooddata
		error_check_good dbclose [$db close] 0
		error_check_good env_close [$env close] 0
	}

	puts "\tTxn$tnum.g: Attempt child prepare"
	set env [eval $env_cmd]
	error_check_good dbenv [is_valid_env $env] TRUE
	berkdb debug_check
	set db [eval {berkdb_open_noerr} $oflags]
	error_check_good db_open [is_valid_db $db] TRUE

	set parent [$env txn]
	error_check_good txn_begin [is_valid_txn $parent $env] TRUE
	set child [$env txn -parent $parent]
	error_check_good txn_begin [is_valid_txn $child $env] TRUE
	error_check_good db_put [$db put -txn $child $key $newdata] 0
	set gid [make_gid child_prepare:$child]
	set stat [catch {$child prepare $gid} ret]
	error_check_good child_prepare $stat 1
	error_check_good child_prep_err [is_substr $ret "txn prepare"] 1

	puts "\tTxn$tnum.h: Attempt child discard"
	set stat [catch {$child discard} ret]
	error_check_good child_discard $stat 1

	# We just panic'd the region, so the next operations will fail.
	# No matter, we still have to clean up all the handles.

	set stat [catch {$parent commit} ret]
	error_check_good parent_commit $stat 1
	error_check_good parent_commit:fail [is_substr $ret "DB_RUNRECOVERY"] 1

	set stat [catch {$db close} ret]
	error_check_good db_close $stat 1
	error_check_good db_close:fail [is_substr $ret "DB_RUNRECOVERY"] 1

	set stat [catch {$env close} ret]
	error_check_good env_close $stat 1
	error_check_good env_close:fail [is_substr $ret "DB_RUNRECOVERY"] 1
}

proc txn003_body { env_cmd testfile dir key newdata2 msg op } {
	source ./include.tcl

	berkdb debug_check
	sentinel_init
	set gidf $dir/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 txnscript.tcl \
	    $testdir/txnout $env_cmd $testfile $gidf $key $newdata2 &]
	lappend pidlist $p
	watch_procs $pidlist 5
	set f1 [open $testdir/txnout r]
	set r [read $f1]
	puts $r
	close $f1
	fileremove -f $testdir/txnout

	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] 1
	set tpair [lindex $txnlist 0]

	set gfd [open $gidf r]
	set ret [gets $gfd parentgid]
	close $gfd
	set txn [lindex $tpair 0]
	set gid [lindex $tpair 1]
	if { $op == "begin" } {
		puts "$msg.2: $op new txn"
	} else {
		puts "$msg.2: $op parent"
	}
	error_check_good gidcompare $gid $parentgid
	if { $op == "prepare" } {
		set gid [make_gid prepare_recover:$txn]
		set stat [catch {$txn $op $gid} ret]
		error_check_good prep_error $stat 1
		error_check_good prep_err \
		    [is_substr $ret "transaction already prepared"] 1
		error_check_good txn:prep_abort [$txn abort] 0
	} elseif { $op == "begin" } {
		# As of the 4.6 release, we allow new txns to be created
		# while prepared but not committed txns exist, so this
		# should succeed.
		set txn2 [$env txn]
		error_check_good txn:begin_abort [$txn abort] 0
		error_check_good txn2:begin_abort [$txn2 abort] 0
	} else {
		error_check_good txn:$op [$txn $op] 0
	}
	error_check_good envclose [$env close] 0
}

proc txn003_check { db key msg gooddata } {
	set kd [$db get $key]
	set data [lindex [lindex $kd 0] 1]
	error_check_good $msg $data $gooddata
}