recd015.tcl 4.12 KB
Newer Older
unknown's avatar
unknown committed
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
# See the file LICENSE for redistribution information.
#
# Copyright (c) 1999-2002
#	Sleepycat Software.  All rights reserved.
#
# $Id: recd015.tcl,v 1.13 2002/09/05 17:23:06 sandstro Exp $
#
# TEST	recd015
# TEST	This is a recovery test for testing lots of prepared txns.
# TEST	This test is to force the use of txn_recover to call with the
# TEST	DB_FIRST flag and then DB_NEXT.
proc recd015 { method args } {
	source ./include.tcl

	set args [convert_args $method $args]
	set omethod [convert_method $method]

	puts "Recd015: $method ($args) prepared txns test"

	# Create the database and environment.

	set numtxns 1
	set testfile NULL

	set env_cmd "berkdb_env -create -txn -home $testdir"
	set msg "\tRecd015.a"
	puts "$msg Simple test to prepare $numtxns txn "
	foreach op { abort commit discard } {
		env_cleanup $testdir
		recd015_body $env_cmd $testfile $numtxns $msg $op
	}

	#
	# Now test large numbers of prepared txns to test DB_NEXT
	# on txn_recover.
	#
	set numtxns 250
	set testfile recd015.db
	set txnmax [expr $numtxns + 5]
	#
	# For this test we create our database ahead of time so that we
	# don't need to send methods and args to the script.
	#
	env_cleanup $testdir
	set env_cmd "berkdb_env -create -txn_max $txnmax -txn -home $testdir"
	set env [eval $env_cmd]
	error_check_good dbenv [is_valid_env $env] TRUE
	set db [eval {berkdb_open -create} $omethod -env $env $args $testfile]
	error_check_good dbopen [is_valid_db $db] TRUE
	error_check_good dbclose [$db close] 0
	error_check_good envclose [$env close] 0

	set msg "\tRecd015.b"
	puts "$msg Large test to prepare $numtxns txn "
	foreach op { abort commit discard } {
		recd015_body $env_cmd $testfile $numtxns $msg $op
	}

	set stat [catch {exec $util_path/db_printlog -h $testdir \
	    > $testdir/LOG } ret]
	error_check_good db_printlog $stat 0
	fileremove $testdir/LOG
}

proc recd015_body { env_cmd testfile numtxns msg op } {
	source ./include.tcl

	sentinel_init
	set gidf $testdir/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 recd15scr.tcl \
	    $testdir/recdout $env_cmd $testfile $gidf $numtxns &]

	lappend pidlist $p
	watch_procs $pidlist 5
	set f1 [open $testdir/recdout r]
	set r [read $f1]
	puts $r
	close $f1
	fileremove -f $testdir/recdout

	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] $numtxns

	set gfd [open $gidf r]
	set i 0
	while { [gets $gfd gid] != -1 } {
		set gids($i) $gid
		incr i
	}
	close $gfd
	#
	# Make sure we have as many as we expect
	error_check_good num_gids $i $numtxns

	set i 0
	puts "$msg.3: comparing GIDs and $op txns"
	foreach tpair $txnlist {
		set txn [lindex $tpair 0]
		set gid [lindex $tpair 1]
		error_check_good gidcompare $gid $gids($i)
		error_check_good txn:$op [$txn $op] 0
		incr i
	}
	if { $op != "discard" } {
		error_check_good envclose [$env close] 0
		return
	}
	#
	# If we discarded, now do it again and randomly resolve some
	# until all txns are resolved.
	#
	puts "$msg.4: resolving/discarding txns"
	set txnlist [$env txn_recover]
	set len [llength $txnlist]
	set opval(1) "abort"
	set opcnt(1) 0
	set opval(2) "commit"
	set opcnt(2) 0
	set opval(3) "discard"
	set opcnt(3) 0
	while { $len != 0 } {
		set opicnt(1) 0
		set opicnt(2) 0
		set opicnt(3) 0
		#
		# Abort/commit or discard them randomly until
		# all are resolved.
		#
		for { set i 0 } { $i < $len } { incr i } {
			set t [lindex $txnlist $i]
			set txn [lindex $t 0]
			set newop [berkdb random_int 1 3]
			set ret [$txn $opval($newop)]
			error_check_good txn_$opval($newop):$i $ret 0
			incr opcnt($newop)
			incr opicnt($newop)
		}
#		puts "$opval(1): $opicnt(1) Total: $opcnt(1)"
#		puts "$opval(2): $opicnt(2) Total: $opcnt(2)"
#		puts "$opval(3): $opicnt(3) Total: $opcnt(3)"

		set txnlist [$env txn_recover]
		set len [llength $txnlist]
	}

	error_check_good envclose [$env close] 0
}