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