summaryrefslogtreecommitdiff
path: root/db-4.8.30/test/test086.tcl
blob: 16ed5fd47c7c1c9b91a1b811fb51940b344e5ca8 (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
# See the file LICENSE for redistribution information.
#
# Copyright (c) 1999-2009 Oracle.  All rights reserved.
#
# $Id$
#
# TEST	test086
# TEST	Test of cursor stability across btree splits/rsplits with
# TEST	subtransaction aborts (a variant of test048).  [#2373]
proc test086 { method args } {
	global errorCode
	source ./include.tcl

	set tnum 086
	set args [convert_args $method $args]
	set encargs ""
	set args [split_encargs $args encargs]
	set pageargs ""
	split_pageargs $args pageargs

	if { [is_btree $method] != 1 } {
		puts "Test$tnum skipping for method $method."
		return
	}

	set method "-btree"

	puts "\tTest$tnum: Test of cursor stability across aborted\
	    btree splits."

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

	set eindex [lsearch -exact $args "-env"]
	#
	# If we are using an env, then this test won't work.
	if { $eindex == -1 } {
		# But we will be using our own env...
		set testfile test$tnum.db
	} else {
		puts "\tTest$tnum: Environment provided;  skipping test."
		return
	}
	set t1 $testdir/t1
	env_cleanup $testdir

	set env [eval \
	     {berkdb_env -create -home $testdir -txn} $pageargs $encargs]
	error_check_good berkdb_env [is_valid_env $env] TRUE

	puts "\tTest$tnum.a: Create $method database."
	set oflags "-auto_commit -create -env $env -mode 0644 $args $method"
	set db [eval {berkdb_open} $oflags $testfile]
	error_check_good dbopen [is_valid_db $db] TRUE

	set nkeys 5
	# Fill page w/ small key/data pairs, keep at leaf
	#
	puts "\tTest$tnum.b: Fill page with $nkeys small key/data pairs."
	set txn [$env txn]
	error_check_good txn [is_valid_txn $txn $env] TRUE
	for { set i 0 } { $i < $nkeys } { incr i } {
		set ret [$db put -txn $txn key000$i $data$i]
		error_check_good dbput $ret 0
	}
	error_check_good commit [$txn commit] 0

	# get db ordering, set cursors
	puts "\tTest$tnum.c: Set cursors on each of $nkeys pairs."
	set txn [$env txn]
	error_check_good txn [is_valid_txn $txn $env] TRUE
	for {set i 0; set ret [$db get -txn $txn key000$i]} {\
			$i < $nkeys && [llength $ret] != 0} {\
			incr i; set ret [$db get -txn $txn key000$i]} {
		set key_set($i) [lindex [lindex $ret 0] 0]
		set data_set($i) [lindex [lindex $ret 0] 1]
		set dbc [$db cursor -txn $txn]
		set dbc_set($i) $dbc
		error_check_good db_cursor:$i [is_substr $dbc_set($i) $db] 1
		set ret [$dbc_set($i) get -set $key_set($i)]
		error_check_bad dbc_set($i)_get:set [llength $ret] 0
	}

	# Create child txn.
	set ctxn [$env txn -parent $txn]
	error_check_good ctxn [is_valid_txn $txn $env] TRUE

	# if mkeys is above 1000, need to adjust below for lexical order
	set mkeys 1000
	puts "\tTest$tnum.d: Add $mkeys pairs to force split."
	for {set i $nkeys} { $i < $mkeys } { incr i } {
		if { $i >= 100 } {
			set ret [$db put -txn $ctxn key0$i $data$i]
		} elseif { $i >= 10 } {
			set ret [$db put -txn $ctxn key00$i $data$i]
		} else {
			set ret [$db put -txn $ctxn key000$i $data$i]
		}
		error_check_good dbput:more $ret 0
	}

	puts "\tTest$tnum.e: Abort."
	error_check_good ctxn_abort [$ctxn abort] 0

	puts "\tTest$tnum.f: Check and see that cursors maintained reference."
	for {set i 0} { $i < $nkeys } {incr i} {
		set ret [$dbc_set($i) get -current]
		error_check_bad dbc$i:get:current [llength $ret] 0
		set ret2 [$dbc_set($i) get -set $key_set($i)]
		error_check_bad dbc$i:get:set [llength $ret2] 0
		error_check_good dbc$i:get(match) $ret $ret2
	}

	# Put (and this time keep) the keys that caused the split.
	# We'll delete them to test reverse splits.
	puts "\tTest$tnum.g: Put back added keys."
	for {set i $nkeys} { $i < $mkeys } { incr i } {
		if { $i >= 100 } {
			set ret [$db put -txn $txn key0$i $data$i]
		} elseif { $i >= 10 } {
			set ret [$db put -txn $txn key00$i $data$i]
		} else {
			set ret [$db put -txn $txn key000$i $data$i]
		}
		error_check_good dbput:more $ret 0
	}

	puts "\tTest$tnum.h: Delete added keys to force reverse split."
	set ctxn [$env txn -parent $txn]
	error_check_good ctxn [is_valid_txn $txn $env] TRUE
	for {set i $nkeys} { $i < $mkeys } { incr i } {
		if { $i >= 100 } {
			error_check_good db_del:$i [$db del -txn $ctxn key0$i] 0
		} elseif { $i >= 10 } {
			error_check_good db_del:$i \
			    [$db del -txn $ctxn key00$i] 0
		} else {
			error_check_good db_del:$i \
			    [$db del -txn $ctxn key000$i] 0
		}
	}

	puts "\tTest$tnum.i: Abort."
	error_check_good ctxn_abort [$ctxn abort] 0

	puts "\tTest$tnum.j: Verify cursor reference."
	for {set i 0} { $i < $nkeys } {incr i} {
		set ret [$dbc_set($i) get -current]
		error_check_bad dbc$i:get:current [llength $ret] 0
		set ret2 [$dbc_set($i) get -set $key_set($i)]
		error_check_bad dbc$i:get:set [llength $ret2] 0
		error_check_good dbc$i:get(match) $ret $ret2
	}

	puts "\tTest$tnum.j: Cleanup."
	# close cursors
	for {set i 0} { $i < $nkeys } {incr i} {
		error_check_good dbc_close:$i [$dbc_set($i) close] 0
	}

	error_check_good commit [$txn commit] 0
	error_check_good dbclose [$db close] 0
	error_check_good envclose [$env close] 0

	puts "\tTest$tnum complete."
}