1# See the file LICENSE for redistribution information.
2#
3# Copyright (c) 1996,2008 Oracle.  All rights reserved.
4#
5# $Id: test099.tcl,v 12.6 2008/01/08 20:58:53 bostic Exp $
6#
7# TEST	test099
8# TEST
9# TEST	Test of DB->get and DBC->c_get with set_recno and get_recno.
10# TEST
11# TEST	Populate a small btree -recnum database.
12# TEST	After all are entered, retrieve each using -recno with DB->get.
13# TEST	Open a cursor and do the same for DBC->c_get with set_recno.
14# TEST	Verify that set_recno sets the record number position properly.
15# TEST	Verify that get_recno returns the correct record numbers.
16# TEST
17# TEST	Using the same database, open 3 cursors and position one at
18# TEST	the beginning, one in the middle, and one at the end.  Delete
19# TEST	by cursor and check that record renumbering is done properly.
20#
21proc test099 { method {nentries 10000} args } {
22	source ./include.tcl
23
24	set args [convert_args $method $args]
25	set omethod [convert_method $method]
26
27	puts "Test099: Test of set_recno and get_recno in DBC->c_get."
28	if { [is_rbtree $method] != 1 } {
29		puts "Test099: skipping for method $method."
30		return
31	}
32
33	set txnenv 0
34	set eindex [lsearch -exact $args "-env"]
35	#
36	# If we are using an env, then testfile should just be the db name.
37	# Otherwise it is the test directory and the name.
38	if { $eindex == -1 } {
39		set testfile $testdir/test099.db
40		set env NULL
41	} else {
42		set testfile test099.db
43		incr eindex
44		set env [lindex $args $eindex]
45		set txnenv [is_txnenv $env]
46		if { $txnenv == 1 } {
47			append args " -auto_commit "
48			#
49			# If we are using txns and running with the
50			# default, set the default down a bit.
51			#
52			if { $nentries == 10000 } {
53				set nentries 100
54			}
55		}
56		set testdir [get_home $env]
57	}
58	set t1 $testdir/t1
59	cleanup $testdir $env
60
61	# Create the database and open the dictionary
62	set db [eval {berkdb_open \
63	     -create -mode 0644} $args {$omethod $testfile}]
64	error_check_good dbopen [is_valid_db $db] TRUE
65
66	set did [open $dict]
67
68	set pflags ""
69	set gflags ""
70	set txn ""
71	set count 1
72
73	append gflags " -recno"
74
75	puts "\tTest099.a: put loop"
76	# Here is the loop where we put each key/data pair
77	while { [gets $did str] != -1 && $count <= $nentries } {
78		set key $str
79		if { $txnenv == 1 } {
80			set t [$env txn]
81			error_check_good txn [is_valid_txn $t $env] TRUE
82			set txn "-txn $t"
83		}
84		set r [eval {$db put} \
85		    $txn $pflags {$key [chop_data $method $str]}]
86		error_check_good db_put $r 0
87		if { $txnenv == 1 } {
88			error_check_good txn [$t commit] 0
89		}
90		incr count
91	}
92	close $did
93
94	puts "\tTest099.b: dump file"
95	if { $txnenv == 1 } {
96		set t [$env txn]
97		error_check_good txn [is_valid_txn $t $env] TRUE
98		set txn "-txn $t"
99	}
100	dump_file $db $txn $t1 test099.check
101	if { $txnenv == 1 } {
102		error_check_good txn [$t commit] 0
103	}
104	error_check_good db_close [$db close] 0
105
106	puts "\tTest099.c: Test set_recno then get_recno"
107	set db [eval {berkdb_open -rdonly} $args $omethod $testfile ]
108	error_check_good dbopen [is_valid_db $db] TRUE
109
110	# Open a cursor
111	if { $txnenv == 1 } {
112		set t [$env txn]
113		error_check_good txn [is_valid_txn $t $env] TRUE
114		set txn "-txn $t"
115	}
116	set dbc [eval {$db cursor} $txn]
117	error_check_good db_cursor [is_valid_cursor $dbc $db] TRUE
118
119	set did [open $t1]
120	set recno 1
121
122	# Create key(recno) array to use for later comparison
123	while { [gets $did str] != -1 } {
124		set kvals($recno) $str
125		incr recno
126	}
127
128	set recno 1
129	set ret [$dbc get -first]
130	error_check_bad dbc_get_first [llength $ret] 0
131
132	# First walk forward through the database ....
133	while { $recno < $count } {
134		# Test set_recno: verify it sets the record number properly.
135		set current [$dbc get -current]
136		set r [$dbc get -set_recno $recno]
137		error_check_good set_recno $current $r
138		# Test set_recno: verify that we find the expected key
139		# at the current record number position.
140		set k [lindex [lindex $r 0] 0]
141		error_check_good set_recno $kvals($recno) $k
142
143		# Test get_recno: verify that the return from
144		# get_recno matches the record number just set.
145		set g [$dbc get -get_recno]
146		error_check_good get_recno $recno $g
147		set ret [$dbc get -next]
148		incr recno
149	}
150
151	# ... and then backward.
152	set recno [expr $count - 1]
153	while { $recno > 0 } {
154		# Test set_recno: verify that we find the expected key
155		# at the current record number position.
156		set r [$dbc get -set_recno $recno]
157		set k [lindex [lindex $r 0] 0]
158		error_check_good set_recno $kvals($recno) $k
159
160		# Test get_recno: verify that the return from
161		# get_recno matches the record number just set.
162		set g [$dbc get -get_recno]
163		error_check_good get_recno $recno $g
164		set recno [expr $recno - 1]
165	}
166
167	error_check_good cursor_close [$dbc close] 0
168	if { $txnenv == 1 } {
169		error_check_good txn [$t commit] 0
170	}
171	error_check_good db_close [$db close] 0
172	close $did
173
174	puts "\tTest099.d: Test record renumbering with cursor deletes."
175	# Reopen the database, this time with write permission.
176	set db [eval {berkdb_open} $args $omethod $testfile ]
177	error_check_good dbopen [is_valid_db $db] TRUE
178
179	# Open three cursors.
180	if { $txnenv == 1 } {
181		set t [$env txn]
182		error_check_good txn [is_valid_txn $t $env] TRUE
183		set txn "-txn $t"
184	}
185	set dbc0 [eval {$db cursor} $txn]
186	error_check_good db_cursor [is_valid_cursor $dbc0 $db] TRUE
187	set dbc1 [eval {$db cursor} $txn]
188	error_check_good db_cursor [is_valid_cursor $dbc1 $db] TRUE
189	set dbc2 [eval {$db cursor} $txn]
190	error_check_good db_cursor [is_valid_cursor $dbc2 $db] TRUE
191
192	# Initialize cursor positions.  Set dbc0 at the beginning,
193	# dbc1 at the middle, and dbc2 at the end.
194	set ret [$dbc0 get -first]
195	error_check_bad dbc0_get_first [llength $ret] 0
196
197	set middle [expr $nentries / 2 + 1]
198	set ret [$dbc1 get -set_recno $middle]
199	error_check_bad dbc1_get_middle [llength $ret] 0
200
201	set ret [$dbc2 get -last]
202	error_check_bad dbc2_get_last [llength $ret] 0
203
204	# At each iteration, delete the first entry, delete the middle
205	# entry, and check the record number for beginning, middle and end.
206	set count 1
207	while { $count <= [expr $nentries / 2] } {
208		# Delete first item.
209		error_check_good dbc0_del [$dbc0 del] 0
210
211		# For non-txn env's, check that db_stat is recalculating
212		# to adjust for items marked for deletion.  We can't do this
213		# in txn env's because the live txn will cause deadlock.
214		if { $txnenv == 0 } {
215			set nkeys [expr $nentries - [expr $count * 2] + 1]
216			set stat [$db stat]
217			error_check_good keys_after_delete [is_substr $stat \
218			     "{Number of keys} $nkeys"] 1
219			error_check_good records_after_delete [is_substr $stat \
220			     "{Number of records} $nkeys"] 1
221
222			# Now delete the same entry again (which should not
223			# change the database) and make sure db->stat returns
224			# the same number of keys and records as before.
225			catch {[$dbc0 del]} result
226
227			set stat [$db stat]
228			error_check_good keys_after_baddelete [is_substr $stat \
229			     "{Number of keys} $nkeys"] 1
230			error_check_good recs_after_baddelete [is_substr $stat \
231			     "{Number of records} $nkeys"] 1
232		}
233
234		# Reposition cursor to new first item, check that record number
235		# is 1.
236		set ret0 [$dbc0 get -next]
237		error_check_good beginning_recno [$dbc0 get -get_recno] 1
238
239		# Calculate the current middle recno and compare to actual.
240		set middle [$dbc1 get -get_recno]
241		set calcmiddle [expr [expr $nentries / 2] - $count + 1]
242		error_check_good middle_recno $middle $calcmiddle
243
244		# Delete middle item, reposition cursor to next item.
245		error_check_good dbc1_del [$dbc1 del] 0
246		set ret1 [$dbc1 get -next]
247
248		# Calculate the expected end recno and compare to actual.
249		set end [$dbc2 get -get_recno]
250		set calcend [expr $nentries - [expr $count * 2]]
251		# On the last iteration, all items have been deleted so
252		# there is no recno.
253		if { $calcend == 0 } {
254			error_check_good end_recno $end ""
255		} else {
256			error_check_good end_recno $end $calcend
257		}
258		incr count
259	}
260
261	# Close all three cursors.
262	error_check_good cursor_close [$dbc0 close] 0
263	error_check_good cursor_close [$dbc1 close] 0
264	error_check_good cursor_close [$dbc2 close] 0
265
266	if { $txnenv == 1 } {
267		error_check_good txn [$t commit] 0
268	}
269	error_check_good db_close [$db close] 0
270}
271
272# Check function for dumped file; data should be fixed are identical
273proc test099.check { key data } {
274	error_check_good "data mismatch for key $key" $key $data
275}
276