test046.tcl

这是linux下运行的mysql软件包,可用于linux 下安装 php + mysql + apach 的网络配置

# See the file LICENSE for redistribution information.
#
# Copyright (c) 1999-2002
#	Sleepycat Software.  All rights reserved.
#
# $Id: test046.tcl,v 11.33 2002/05/24 15:24:55 sue Exp $
#
# TEST	test046
# TEST	Overwrite test of small/big key/data with cursor checks.
proc test046 { method args } {
	global alphabet
	global errorInfo
	global errorCode
	source ./include.tcl

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

	puts "\tTest046: Overwrite test with cursor and small/big key/data."
	puts "\tTest046:\t$method $args"

	if { [is_rrecno $method] == 1} {
		puts "\tTest046: skipping for method $method."
		return
	}

	set key "key"
	set data "data"
	set txn ""
	set flags ""

	if { [is_record_based $method] == 1} {
		set key ""
	}

	puts "\tTest046: Create $method database."
	set txnenv 0
	set eindex [lsearch -exact $args "-env"]
	#
	# If we are using an env, then testfile should just be the db name.
	# Otherwise it is the test directory and the name.
	if { $eindex == -1 } {
		set testfile $testdir/test046.db
		set env NULL
	} else {
		set testfile test046.db
		incr eindex
		set env [lindex $args $eindex]
		set txnenv [is_txnenv $env]
		if { $txnenv == 1 } {
			append args " -auto_commit "
		}
		set testdir [get_home $env]
	}
	set t1 $testdir/t1
	cleanup $testdir $env

	set oflags "-create -mode 0644 $args $omethod"
	set db [eval {berkdb_open} $oflags $testfile.a]
	error_check_good dbopen [is_valid_db $db] TRUE

	# keep nkeys even
	set nkeys 20

	# Fill page w/ small key/data pairs
	puts "\tTest046: Fill page with $nkeys small key/data pairs."
	for { set i 1 } { $i <= $nkeys } { incr i } {
		if { $txnenv == 1 } {
			set t [$env txn]
			error_check_good txn [is_valid_txn $t $env] TRUE
			set txn "-txn $t"
		}
		if { [is_record_based $method] == 1} {
			set ret [eval {$db put} $txn {$i $data$i}]
		} elseif { $i < 10 } {
			set ret [eval {$db put} $txn [set key]00$i \
			    [set data]00$i]
		} elseif { $i < 100 } {
			set ret [eval {$db put} $txn [set key]0$i \
			    [set data]0$i]
		} else {
			set ret [eval {$db put} $txn {$key$i $data$i}]
		}
		error_check_good dbput $ret 0
		if { $txnenv == 1 } {
			error_check_good txn [$t commit] 0
		}
	}

	# open curs to db
	if { $txnenv == 1 } {
		set t [$env txn]
		error_check_good txn [is_valid_txn $t $env] TRUE
		set txn "-txn $t"
	}
	set dbc [eval {$db cursor} $txn]
	error_check_good db_cursor [is_substr $dbc $db] 1

	# get db order of keys
	for {set i 1; set ret [$dbc get -first]} { [llength $ret] != 0} { \
	    set ret [$dbc get -next]} {
		set key_set($i) [lindex [lindex $ret 0] 0]
		set data_set($i) [lindex [lindex $ret 0] 1]
		incr i
	}

	puts "\tTest046.a: Deletes by key."
	puts "\t\tTest046.a.1: Get data with SET, then delete before cursor."
	# get key in middle of page, call this the nth set curr to it
	set i [expr $nkeys/2]
	set ret [$dbc get -set $key_set($i)]
	error_check_bad dbc_get:set [llength $ret] 0
	set curr $ret

	# delete before cursor(n-1), make sure it is gone
	set i [expr $i - 1]
	error_check_good db_del [eval {$db del} $txn {$key_set($i)}] 0

	# use set_range to get first key starting at n-1, should
	# give us nth--but only works for btree
	if { [is_btree $method] == 1 } {
		set ret [$dbc get -set_range $key_set($i)]
	} else {
		if { [is_record_based $method] == 1 } {
			set ret [$dbc get -set $key_set($i)]
			error_check_good \
			    dbc_get:deleted(recno) [llength [lindex $ret 1]] 0
			#error_check_good \
			#   catch:get [catch {$dbc get -set $key_set($i)} ret] 1
			#error_check_good \
			#   dbc_get:deleted(recno) [is_substr $ret "KEYEMPTY"] 1
		} else {
			set ret [$dbc get -set $key_set($i)]
			error_check_good dbc_get:deleted [llength $ret] 0
		}
		set ret [$dbc get -set $key_set([incr i])]
		incr i -1
	}
	error_check_bad dbc_get:set(R)(post-delete) [llength $ret] 0
	error_check_good dbc_get(match):set $ret $curr

	puts "\t\tTest046.a.2: Delete cursor item by key."
	# nth key, which cursor should be on now
	set i [incr i]
	set ret [eval {$db del} $txn {$key_set($i)}]
	error_check_good db_del $ret 0

	# this should return n+1 key/data, curr has nth key/data
	if { [string compare $omethod "-btree"] == 0 } {
		set ret [$dbc get -set_range $key_set($i)]
	} else {
		if { [is_record_based $method] == 1 } {
			set ret [$dbc get -set $key_set($i)]
			error_check_good \
			    dbc_get:deleted(recno) [llength [lindex $ret 1]] 0
			#error_check_good \
			#   catch:get [catch {$dbc get -set $key_set($i)} ret] 1
			#error_check_good \
			#   dbc_get:deleted(recno) [is_substr $ret "KEYEMPTY"] 1
		} else {
			set ret [$dbc get -set $key_set($i)]
			error_check_good dbc_get:deleted [llength $ret] 0
		}
		set ret [$dbc get -set $key_set([expr $i+1])]
	}
	error_check_bad dbc_get(post-delete):set_range [llength $ret] 0
	error_check_bad dbc_get(no-match):set_range $ret $curr

	puts "\t\tTest046.a.3: Delete item after cursor."
	# we'll delete n+2, since we have deleted n-1 and n
	# i still equal to nth, cursor on n+1
	set i [incr i]
	set ret [$dbc get -set $key_set($i)]
	error_check_bad dbc_get:set [llength $ret] 0
	set curr [$dbc get -next]
	error_check_bad dbc_get:next [llength $curr] 0
	set ret [$dbc get -prev]
	error_check_bad dbc_get:prev [llength $curr] 0
	# delete *after* cursor pos.
	error_check_good db:del [eval {$db del} $txn {$key_set([incr i])}] 0

	# make sure item is gone, try to get it
	if { [string compare $omethod "-btree"] == 0} {
		set ret [$dbc get -set_range $key_set($i)]
	} else {
		if { [is_record_based $method] == 1 } {
			set ret [$dbc get -set $key_set($i)]
			error_check_good \
			    dbc_get:deleted(recno) [llength [lindex $ret 1]] 0
			#error_check_good \
			#   catch:get [catch {$dbc get -set $key_set($i)} ret] 1
			#error_check_good \
			#   dbc_get:deleted(recno) [is_substr $ret "KEYEMPTY"] 1
		} else {
			set ret [$dbc get -set $key_set($i)]
			error_check_good dbc_get:deleted [llength $ret] 0
		}
		set ret [$dbc get -set $key_set([expr $i +1])]
	}
	error_check_bad dbc_get:set(_range) [llength $ret] 0
	error_check_bad dbc_get:set(_range) $ret $curr
	error_check_good dbc_get:set [lindex [lindex $ret 0] 0] \
											$key_set([expr $i+1])

	puts "\tTest046.b: Deletes by cursor."
	puts "\t\tTest046.b.1: Delete, do DB_NEXT."
	error_check_good dbc:del [$dbc del] 0
	set ret [$dbc get -next]
	error_check_bad dbc_get:next [llength $ret] 0
	set i [expr $i+2]
	# i = n+4
	error_check_good dbc_get:next(match) \
		[lindex [lindex $ret 0] 0] $key_set($i)

	puts "\t\tTest046.b.2: Delete, do DB_PREV."
	error_check_good dbc:del [$dbc del] 0
	set ret [$dbc get -prev]
	error_check_bad dbc_get:prev [llength $ret] 0
	set i [expr $i-3]
	# i = n+1 (deleted all in between)
	error_check_good dbc_get:prev(match) \
		[lindex [lindex $ret 0] 0] $key_set($i)

	puts "\t\tTest046.b.3: Delete, do DB_CURRENT."
	error_check_good dbc:del [$dbc del] 0
	# we just deleted, so current item should be KEYEMPTY, throws err
	set ret [$dbc get -current]
	error_check_good dbc_get:curr:deleted [llength [lindex $ret 1]] 0
	#error_check_good catch:get:current [catch {$dbc get -current} ret] 1
	#error_check_good dbc_get:curr:deleted [is_substr $ret "DB_KEYEMPTY"] 1

	puts "\tTest046.c: Inserts (before/after), by key then cursor."
	puts "\t\tTest046.c.1: Insert by key before the cursor."
	# i is at curs pos, i=n+1, we want to go BEFORE
	set i [incr i -1]
	set ret [eval {$db put} $txn {$key_set($i) $data_set($i)}]
	error_check_good db_put:before $ret 0

	puts "\t\tTest046.c.2: Insert by key after the cursor."
	set i [incr i +2]
	set ret [eval {$db put} $txn {$key_set($i) $data_set($i)}]
	error_check_good db_put:after $ret 0

	puts "\t\tTest046.c.3: Insert by curs with deleted curs (should fail)."
	# cursor is on n+1, we'll change i to match
	set i [incr i -1]

	error_check_good dbc:close [$dbc close] 0
	if { $txnenv == 1 } {
		error_check_good txn [$t commit] 0
	}
	error_check_good db:close [$db close] 0
	if { [is_record_based $method] == 1} {
		puts "\t\tSkipping the rest of test for method $method."
		puts "\tTest046 ($method) complete."
		return
	} else {
		# Reopen without printing __db_errs.
		set db [eval {berkdb_open_noerr} $oflags $testfile.a]
		error_check_good dbopen [is_valid_db $db] TRUE
		if { $txnenv == 1 } {
			set t [$env txn]
			error_check_good txn [is_valid_txn $t $env] TRUE
			set txn "-txn $t"
		}
		set dbc [eval {$db cursor} $txn]
		error_check_good cursor [is_valid_cursor $dbc $db] TRUE

		# should fail with EINVAL (deleted cursor)
		set errorCode NONE
		error_check_good catch:put:before 1 \
			[catch {$dbc put -before $data_set($i)} ret]
		error_check_good dbc_put:deleted:before \
			[is_substr $errorCode "EINVAL"] 1

		# should fail with EINVAL
		set errorCode NONE
		error_check_good catch:put:after 1 \
			[catch {$dbc put -after $data_set($i)} ret]
		error_check_good dbc_put:deleted:after \
			[is_substr $errorCode "EINVAL"] 1

		puts "\t\tTest046.c.4:\
		    Insert by cursor before/after existent cursor."
		# can't use before after w/o dup except renumber in recno
		# first, restore an item so they don't fail
		#set ret [eval {$db put} $txn {$key_set($i) $data_set($i)}]
		#error_check_good db_put $ret 0

		#set ret [$dbc get -set $key_set($i)]
		#error_check_bad dbc_get:set [llength $ret] 0
		#set i [incr i -2]
		# i = n - 1
		#set ret [$dbc get -prev]
		#set ret [$dbc put -before $key_set($i) $data_set($i)]
		#error_check_good dbc_put:before $ret 0
		# cursor pos is adjusted to match prev, recently inserted
		#incr i
		# i = n
		#set ret [$dbc put -after $key_set($i) $data_set($i)]
		#error_check_good dbc_put:after $ret 0
	}

	# For the next part of the test, we need a db with no dups to test
	# overwrites
	puts "\tTest046.d.0: Cleanup, close db, open new db with no dups."
	error_check_good dbc:close [$dbc close] 0
	if { $txnenv == 1 } {
		error_check_good txn [$t commit] 0
	}
	error_check_good db:close [$db close] 0

	set db [eval {berkdb_open} $oflags $testfile.d]
	error_check_good dbopen [is_valid_db $db] TRUE
	# Fill page w/ small key/data pairs
	puts "\tTest046.d.0: Fill page with $nkeys small key/data pairs."
	for { set i 1 } { $i < $nkeys } { incr i } {
		if { $txnenv == 1 } {
			set t [$env txn]
			error_check_good txn [is_valid_txn $t $env] TRUE
			set txn "-txn $t"
		}
		set ret [eval {$db put} $txn {$key$i $data$i}]
		error_check_good dbput $ret 0
		if { $txnenv == 1 } {
			error_check_good txn [$t commit] 0
		}
	}

	if { $txnenv == 1 } {
		set t [$env txn]
		error_check_good txn [is_valid_txn $t $env] TRUE
		set txn "-txn $t"
	}
	set dbc [eval {$db cursor} $txn]
	error_check_good db_cursor [is_valid_cursor $dbc $db] TRUE
	set nkeys 20

	# Prepare cursor on item
	set ret [$dbc get -first]
	error_check_bad dbc_get:first [llength $ret] 0

	# Prepare unique big/small values for an initial
	# and an overwrite set of key/data
	foreach ptype {init over} {
		foreach size {big small} {
			if { [string compare $size big] == 0 } {
				set key_$ptype$size \
				    KEY_$size[repeat alphabet 250]
				set data_$ptype$size \
				    DATA_$size[repeat alphabet 250]
			} else {
				set key_$ptype$size \
				    KEY_$size[repeat alphabet 10]
				set data_$ptype$size \
				    DATA_$size[repeat alphabet 10]
			}
		}
	}

	set i 0
	# Do all overwrites for key and cursor
	foreach type {key_over curs_over} {
		# Overwrite (i=initial) four different kinds of pairs
		incr i
		puts "\tTest046.d: Overwrites $type."
		foreach i_pair {\
		    {small small} {big small} {small big} {big big} } {
			# Overwrite (w=write) with four different kinds of data
		   foreach w_pair {\
		       {small small} {big small} {small big} {big big} } {

				# we can only overwrite if key size matches
				if { [string compare [lindex \
				    $i_pair 0] [lindex $w_pair 0]] != 0} {
					continue
				}

				# first write the initial key/data
				set ret [$dbc put -keyfirst \
				    key_init[lindex $i_pair 0] \
				    data_init[lindex $i_pair 1]]
				error_check_good \
				    dbc_put:curr:init:$i_pair $ret 0
				set ret [$dbc get -current]
				error_check_bad dbc_get:curr [llength $ret] 0
				error_check_good dbc_get:curr:data \
				    [lindex [lindex $ret 0] 1] \
				    data_init[lindex $i_pair 1]

				# Now, try to overwrite: dups not supported in
				# this db
				if { [string compare $type key_over] == 0 } {
					puts "\t\tTest046.d.$i: Key\
					    Overwrite:($i_pair) by ($w_pair)."
					set ret [eval {$db put} $txn \
					    $"key_init[lindex $i_pair 0]" \
					    $"data_over[lindex $w_pair 1]"]
					error_check_good \
				dbput:over:i($i_pair):o($w_pair) $ret 0
					# check value
					set ret [eval {$db get} $txn \
					    $"key_init[lindex $i_pair 0]"]
					error_check_bad \
					    db:get:check [llength $ret] 0
					error_check_good db:get:compare_data \
					    [lindex [lindex $ret 0] 1] \