1# See the file LICENSE for redistribution information.
2#
3# Copyright (c) 1999-2009 Oracle.  All rights reserved.
4#
5# $Id$
6#
7# TEST	test048
8# TEST	Cursor stability across Btree splits.
9proc test048 { method args } {
10	global errorCode
11	global is_je_test
12	source ./include.tcl
13
14	set tnum 048
15	set args [convert_args $method $args]
16
17	if { [is_btree $method] != 1 } {
18		puts "Test$tnum skipping for method $method."
19		return
20	}
21
22	# Compression will change the behavior of page splits.
23	# Skip test for compression.
24	if { [is_compressed $args] } {
25		puts "Test$tnum skipping for compression"
26		return
27	}
28
29	set pgindex [lsearch -exact $args "-pagesize"]
30	if { $pgindex != -1 } {
31		incr pgindex
32		if { [lindex $args $pgindex] > 8192 } {
33			puts "Test048: Skipping for large pagesizes"
34			return
35		}
36	}
37
38	set method "-btree"
39
40	puts "\tTest$tnum: Test of cursor stability across btree splits."
41
42	set key	"key"
43	set data	"data"
44	set txn ""
45	set flags ""
46
47	puts "\tTest$tnum.a: Create $method database."
48	set txnenv 0
49	set eindex [lsearch -exact $args "-env"]
50	#
51	# If we are using an env, then testfile should just be the db name.
52	# Otherwise it is the test directory and the name.
53	if { $eindex == -1 } {
54		set testfile $testdir/test$tnum.db
55		set env NULL
56	} else {
57		set testfile test$tnum.db
58		incr eindex
59		set env [lindex $args $eindex]
60		set txnenv [is_txnenv $env]
61		if { $txnenv == 1 } {
62			append args " -auto_commit "
63		}
64		set testdir [get_home $env]
65	}
66	set t1 $testdir/t1
67	cleanup $testdir $env
68
69	set oflags "-create -mode 0644 $args $method"
70	set db [eval {berkdb_open} $oflags $testfile]
71	error_check_good dbopen [is_valid_db $db] TRUE
72
73	set nkeys 5
74	# Fill page w/ small key/data pairs, keep at leaf
75	#
76	puts "\tTest$tnum.b: Fill page with $nkeys small key/data pairs."
77	for { set i 0 } { $i < $nkeys } { incr i } {
78		if { $txnenv == 1 } {
79			set t [$env txn]
80			error_check_good txn [is_valid_txn $t $env] TRUE
81			set txn "-txn $t"
82		}
83		set ret [eval {$db put} $txn {key000$i $data$i}]
84		error_check_good dbput $ret 0
85		if { $txnenv == 1 } {
86			error_check_good txn [$t commit] 0
87		}
88	}
89
90	# get db ordering, set cursors
91	puts "\tTest$tnum.c: Set cursors on each of $nkeys pairs."
92	if { $txnenv == 1 } {
93		set t [$env txn]
94		error_check_good txn [is_valid_txn $t $env] TRUE
95		set txn "-txn $t"
96	}
97	for {set i 0; set ret [$db get key000$i]} {\
98			$i < $nkeys && [llength $ret] != 0} {\
99			incr i; set ret [$db get key000$i]} {
100		set key_set($i) [lindex [lindex $ret 0] 0]
101		set data_set($i) [lindex [lindex $ret 0] 1]
102		set dbc [eval {$db cursor} $txn]
103		set dbc_set($i) $dbc
104		error_check_good db_cursor:$i \
105		    [is_valid_cursor $dbc_set($i) $db] TRUE
106		set ret [$dbc_set($i) get -set $key_set($i)]
107		error_check_bad dbc_set($i)_get:set [llength $ret] 0
108	}
109
110	# if mkeys is above 1000, need to adjust below for lexical order
111	set mkeys 1000
112	puts "\tTest$tnum.d: Add $mkeys pairs to force split."
113	for {set i $nkeys} { $i < $mkeys } { incr i } {
114		if { $i >= 100 } {
115			set ret [eval {$db put} $txn {key0$i $data$i}]
116		} elseif { $i >= 10 } {
117			set ret [eval {$db put} $txn {key00$i $data$i}]
118		} else {
119			set ret [eval {$db put} $txn {key000$i $data$i}]
120		}
121		error_check_good dbput:more $ret 0
122	}
123
124	puts "\tTest$tnum.e: Make sure split happened."
125	# XXX We cannot call stat with active txns or we deadlock.
126	if { $txnenv != 1 && !$is_je_test } {
127		error_check_bad stat:check-split [is_substr [$db stat] \
128					"{{Internal pages} 0}"] 1
129	}
130
131	puts "\tTest$tnum.f: Check to see that cursors maintained reference."
132	for {set i 0} { $i < $nkeys } {incr i} {
133		set ret [$dbc_set($i) get -current]
134		error_check_bad dbc$i:get:current [llength $ret] 0
135		set ret2 [$dbc_set($i) get -set $key_set($i)]
136		error_check_bad dbc$i:get:set [llength $ret2] 0
137		error_check_good dbc$i:get(match) $ret $ret2
138	}
139
140	puts "\tTest$tnum.g: Delete added keys to force reverse split."
141	for {set i $nkeys} { $i < $mkeys } { incr i } {
142		if { $i >= 100 } {
143			error_check_good db_del:$i \
144			    [eval {$db del} $txn {key0$i}] 0
145		} elseif { $i >= 10 } {
146			error_check_good db_del:$i \
147			    [eval {$db del} $txn {key00$i}] 0
148		} else {
149			error_check_good db_del:$i \
150			    [eval {$db del} $txn {key000$i}] 0
151		}
152	}
153
154	puts "\tTest$tnum.h: Verify cursor reference."
155	for {set i 0} { $i < $nkeys } {incr i} {
156		set ret [$dbc_set($i) get -current]
157		error_check_bad dbc$i:get:current [llength $ret] 0
158		set ret2 [$dbc_set($i) get -set $key_set($i)]
159		error_check_bad dbc$i:get:set [llength $ret2] 0
160		error_check_good dbc$i:get(match) $ret $ret2
161	}
162
163	puts "\tTest$tnum.i: Cleanup."
164	# close cursors
165	for {set i 0} { $i < $nkeys } {incr i} {
166		error_check_good dbc_close:$i [$dbc_set($i) close] 0
167	}
168	if { $txnenv == 1 } {
169		error_check_good txn [$t commit] 0
170	}
171	puts "\tTest$tnum.j: Verify reverse split."
172	error_check_good stat:check-reverse_split [is_substr [$db stat] \
173					"{{Internal pages} 0}"] 1
174
175	error_check_good dbclose [$db close] 0
176
177	puts "\tTest$tnum complete."
178}
179