1# See the file LICENSE for redistribution information.
2#
3# Copyright (c) 1996,2008 Oracle.  All rights reserved.
4#
5# $Id: test024.tcl,v 12.6 2008/01/08 20:58:53 bostic Exp $
6#
7# TEST	test024
8# TEST	Record number retrieval test.
9# TEST	Test the Btree and Record number get-by-number functionality.
10proc test024 { method {nentries 10000} args} {
11	source ./include.tcl
12	global rand_init
13
14	set do_renumber [is_rrecno $method]
15	set args [convert_args $method $args]
16	set omethod [convert_method $method]
17
18	puts "Test024: $method ($args)"
19
20	if { [string compare $omethod "-hash"] == 0 } {
21		puts "Test024 skipping for method HASH"
22		return
23	}
24
25	berkdb srand $rand_init
26
27	# Create the database and open the dictionary
28	set txnenv 0
29	set eindex [lsearch -exact $args "-env"]
30	#
31	# If we are using an env, then testfile should just be the db name.
32	# Otherwise it is the test directory and the name.
33	if { $eindex == -1 } {
34		set testfile $testdir/test024.db
35		set env NULL
36	} else {
37		set testfile test024.db
38		incr eindex
39		set env [lindex $args $eindex]
40		set txnenv [is_txnenv $env]
41		if { $txnenv == 1 } {
42			append args " -auto_commit "
43			#
44			# If we are using txns and running with the
45			# default, set the default down a bit.
46			#
47			if { $nentries == 10000 } {
48				set nentries 100
49			}
50		}
51		set testdir [get_home $env]
52	}
53	set t1 $testdir/t1
54	set t2 $testdir/t2
55	set t3 $testdir/t3
56
57	cleanup $testdir $env
58
59	# Read the first nentries dictionary elements and reverse them.
60	# Keep a list of these (these will be the keys).
61	puts "\tTest024.a: initialization"
62	set keys ""
63	set did [open $dict]
64	set count 0
65	while { [gets $did str] != -1 && $count < $nentries } {
66		lappend keys [reverse $str]
67		incr count
68	}
69	close $did
70
71	# Generate sorted order for the keys
72	set sorted_keys [lsort $keys]
73	# Create the database
74	if { [string compare $omethod "-btree"] == 0 } {
75		set db [eval {berkdb_open -create \
76			-mode 0644 -recnum} $args {$omethod $testfile}]
77		error_check_good dbopen [is_valid_db $db] TRUE
78	} else  {
79		set db [eval {berkdb_open -create \
80			-mode 0644} $args {$omethod $testfile}]
81		error_check_good dbopen [is_valid_db $db] TRUE
82	}
83
84	set pflags ""
85	set gflags ""
86	set txn ""
87
88	if { [is_record_based $method] == 1 } {
89		set gflags " -recno"
90	}
91
92	puts "\tTest024.b: put/get loop"
93	foreach k $keys {
94		if { [is_record_based $method] == 1 } {
95			set key [lsearch $sorted_keys $k]
96			incr key
97		} else {
98			set key $k
99		}
100		if { $txnenv == 1 } {
101			set t [$env txn]
102			error_check_good txn [is_valid_txn $t $env] TRUE
103			set txn "-txn $t"
104		}
105		set ret [eval {$db put} \
106		    $txn $pflags {$key [chop_data $method $k]}]
107		error_check_good put $ret 0
108		set ret [eval {$db get} $txn $gflags {$key}]
109		error_check_good \
110		    get $ret [list [list $key [pad_data $method $k]]]
111		if { $txnenv == 1 } {
112			error_check_good txn [$t commit] 0
113		}
114	}
115
116	# Now we will get each key from the DB and compare the results
117	# to the original.
118	puts "\tTest024.c: dump file"
119
120	# Put sorted keys in file
121	set oid [open $t1 w]
122	foreach k $sorted_keys {
123		puts $oid [pad_data $method $k]
124	}
125	close $oid
126
127	# Instead of using dump_file; get all the keys by keynum
128	set oid [open $t2 w]
129	if { [string compare $omethod "-btree"] == 0 } {
130		set do_renumber 1
131	}
132
133	set gflags " -recno"
134
135	if { $txnenv == 1 } {
136		set t [$env txn]
137		error_check_good txn [is_valid_txn $t $env] TRUE
138		set txn "-txn $t"
139	}
140	for { set k 1 } { $k <= $count } { incr k } {
141		set ret [eval {$db get} $txn $gflags {$k}]
142		puts $oid [lindex [lindex $ret 0] 1]
143		error_check_good recnum_get [lindex [lindex $ret 0] 1] \
144		    [pad_data $method [lindex $sorted_keys [expr $k - 1]]]
145	}
146	close $oid
147	if { $txnenv == 1 } {
148		error_check_good txn [$t commit] 0
149	}
150	error_check_good db_close [$db close] 0
151
152	error_check_good Test024.c:diff($t1,$t2) \
153	    [filecmp $t1 $t2] 0
154
155	# Now, reopen the file and run the last test again.
156	puts "\tTest024.d: close, open, and dump file"
157	set db [eval {berkdb_open -rdonly} $args $testfile]
158	error_check_good dbopen [is_valid_db $db] TRUE
159	set oid [open $t2 w]
160	if { $txnenv == 1 } {
161		set t [$env txn]
162		error_check_good txn [is_valid_txn $t $env] TRUE
163		set txn "-txn $t"
164	}
165	for { set k 1 } { $k <= $count } { incr k } {
166		set ret [eval {$db get} $txn $gflags {$k}]
167		puts $oid [lindex [lindex $ret 0] 1]
168		error_check_good recnum_get [lindex [lindex $ret 0] 1] \
169		    [pad_data $method [lindex $sorted_keys [expr $k - 1]]]
170	}
171	if { $txnenv == 1 } {
172		error_check_good txn [$t commit] 0
173	}
174	close $oid
175	error_check_good db_close [$db close] 0
176	error_check_good Test024.d:diff($t1,$t2) \
177	    [filecmp $t1 $t2] 0
178
179	# Now, reopen the file and run the last test again in reverse direction.
180	puts "\tTest024.e: close, open, and dump file in reverse direction"
181	set db [eval {berkdb_open -rdonly} $args $testfile]
182	error_check_good dbopen [is_valid_db $db] TRUE
183	# Put sorted keys in file
184	set rsorted ""
185	foreach k $sorted_keys {
186		set rsorted [linsert $rsorted 0 $k]
187	}
188	set oid [open $t1 w]
189	foreach k $rsorted {
190		puts $oid [pad_data $method $k]
191	}
192	close $oid
193
194	set oid [open $t2 w]
195	if { $txnenv == 1 } {
196		set t [$env txn]
197		error_check_good txn [is_valid_txn $t $env] TRUE
198		set txn "-txn $t"
199	}
200	for { set k $count } { $k > 0 } { incr k -1 } {
201		set ret [eval {$db get} $txn $gflags {$k}]
202		puts $oid [lindex [lindex $ret 0] 1]
203		error_check_good recnum_get [lindex [lindex $ret 0] 1] \
204		    [pad_data $method [lindex $sorted_keys [expr $k - 1]]]
205	}
206	if { $txnenv == 1 } {
207		error_check_good txn [$t commit] 0
208	}
209	close $oid
210	error_check_good db_close [$db close] 0
211	error_check_good Test024.e:diff($t1,$t2) \
212	    [filecmp $t1 $t2] 0
213
214	# Now try deleting elements and making sure they work
215	puts "\tTest024.f: delete test"
216	set db [eval {berkdb_open} $args $testfile]
217	error_check_good dbopen [is_valid_db $db] TRUE
218	while { $count > 0 } {
219		set kndx [berkdb random_int 1 $count]
220		set kval [lindex $keys [expr $kndx - 1]]
221		set recno [expr [lsearch $sorted_keys $kval] + 1]
222
223		if { $txnenv == 1 } {
224			set t [$env txn]
225			error_check_good txn [is_valid_txn $t $env] TRUE
226			set txn "-txn $t"
227		}
228		if { [is_record_based $method] == 1 } {
229			set ret [eval {$db del} $txn {$recno}]
230		} else {
231			set ret [eval {$db del} $txn {$kval}]
232		}
233		error_check_good delete $ret 0
234		if { $txnenv == 1 } {
235			error_check_good txn [$t commit] 0
236		}
237
238		# Remove the key from the key list
239		set ndx [expr $kndx - 1]
240		set keys [lreplace $keys $ndx $ndx]
241
242		if { $do_renumber == 1 } {
243			set r [expr $recno - 1]
244			set sorted_keys [lreplace $sorted_keys $r $r]
245		}
246
247		# Check that the keys after it have been renumbered
248		if { $txnenv == 1 } {
249			set t [$env txn]
250			error_check_good txn [is_valid_txn $t $env] TRUE
251			set txn "-txn $t"
252		}
253		if { $do_renumber == 1 && $recno != $count } {
254			set r [expr $recno - 1]
255			set ret [eval {$db get} $txn $gflags {$recno}]
256			error_check_good get_after_del \
257			    [lindex [lindex $ret 0] 1] [lindex $sorted_keys $r]
258		}
259		if { $txnenv == 1 } {
260			error_check_good txn [$t commit] 0
261		}
262
263		# Decrement count
264		incr count -1
265	}
266	error_check_good db_close [$db close] 0
267}
268