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