1# See the file LICENSE for redistribution information.
2#
3# Copyright (c) 1996-2009 Oracle.  All rights reserved.
4#
5# $Id$
6#
7# TEST	test011
8# TEST	Duplicate test
9# TEST		Small key/data pairs.
10# TEST		Test DB_KEYFIRST, DB_KEYLAST, DB_BEFORE and DB_AFTER.
11# TEST		To test off-page duplicates, run with small pagesize.
12# TEST
13# TEST	Use the first 10,000 entries from the dictionary.
14# TEST	Insert each with self as key and data; add duplicate records for each.
15# TEST	Then do some key_first/key_last add_before, add_after operations.
16# TEST	This does not work for recno
17# TEST
18# TEST	To test if dups work when they fall off the main page, run this with
19# TEST	a very tiny page size.
20proc test011 { method {nentries 10000} {ndups 5} {tnum "011"} args } {
21	global dlist
22	global rand_init
23	source ./include.tcl
24
25	set dlist ""
26
27	# Btree with compression does not support unsorted duplicates.
28	if { [is_compressed $args] == 1 } {
29		puts "Test$tnum skipping for btree with compression."
30		return
31	}
32
33	if { [is_rbtree $method] == 1 } {
34		puts "Test$tnum skipping for method $method"
35		return
36	}
37	if { [is_record_based $method] == 1 } {
38		test011_recno $method $nentries $tnum $args
39		return
40	}
41	if {$ndups < 5} {
42		set ndups 5
43	}
44
45	set args [convert_args $method $args]
46	set omethod [convert_method $method]
47
48	berkdb srand $rand_init
49
50	# Create the database and open the dictionary
51	set txnenv 0
52	set eindex [lsearch -exact $args "-env"]
53	#
54	# If we are using an env, then testfile should just be the db name.
55	# Otherwise it is the test directory and the name.
56	if { $eindex == -1 } {
57		set testfile $testdir/test$tnum.db
58		set env NULL
59	} else {
60		set testfile test$tnum.db
61		incr eindex
62		set env [lindex $args $eindex]
63		set txnenv [is_txnenv $env]
64		if { $txnenv == 1 } {
65			append args " -auto_commit "
66			#
67			# If we are using txns and running with the
68			# default, set the default down a bit.
69			#
70			if { $nentries == 10000 } {
71				set nentries 100
72			}
73			reduce_dups nentries ndups
74		}
75		set testdir [get_home $env]
76	}
77
78	puts -nonewline "Test$tnum: $method $nentries small $ndups dup "
79	puts "key/data pairs, cursor ops"
80
81	set t1 $testdir/t1
82	set t2 $testdir/t2
83	set t3 $testdir/t3
84	cleanup $testdir $env
85
86	set db [eval {berkdb_open -create \
87	    -mode 0644} [concat $args "-dup"] {$omethod $testfile}]
88	error_check_good dbopen [is_valid_db $db] TRUE
89
90	set did [open $dict]
91
92	set pflags ""
93	set gflags ""
94	set txn ""
95	set count 0
96
97	# Here is the loop where we put and get each key/data pair
98	# We will add dups with values 1, 3, ... $ndups.  Then we'll add
99	# 0 and $ndups+1 using keyfirst/keylast.  We'll add 2 and 4 using
100	# add before and add after.
101	puts "\tTest$tnum.a: put and get duplicate keys."
102	set i ""
103	for { set i 1 } { $i <= $ndups } { incr i 2 } {
104		lappend dlist $i
105	}
106	set maxodd $i
107	while { [gets $did str] != -1 && $count < $nentries } {
108		for { set i 1 } { $i <= $ndups } { incr i 2 } {
109			set datastr $i:$str
110			if { $txnenv == 1 } {
111				set t [$env txn]
112				error_check_good txn [is_valid_txn $t $env] TRUE
113				set txn "-txn $t"
114			}
115			set ret [eval {$db put} $txn $pflags {$str $datastr}]
116			error_check_good put $ret 0
117			if { $txnenv == 1 } {
118				error_check_good txn [$t commit] 0
119			}
120		}
121
122		# Now retrieve all the keys matching this key
123		set x 1
124		if { $txnenv == 1 } {
125			set t [$env txn]
126			error_check_good txn [is_valid_txn $t $env] TRUE
127			set txn "-txn $t"
128		}
129		set dbc [eval {$db cursor} $txn]
130		for {set ret [$dbc get "-set" $str ]} \
131		    {[llength $ret] != 0} \
132		    {set ret [$dbc get "-next"] } {
133			if {[llength $ret] == 0} {
134				break
135			}
136			set k [lindex [lindex $ret 0] 0]
137			if { [string compare $k $str] != 0 } {
138				break
139			}
140			set datastr [lindex [lindex $ret 0] 1]
141			set d [data_of $datastr]
142
143			error_check_good Test$tnum:put $d $str
144			set id [ id_of $datastr ]
145			error_check_good Test$tnum:dup# $id $x
146			incr x 2
147		}
148		error_check_good Test$tnum:numdups $x $maxodd
149		error_check_good curs_close [$dbc close] 0
150		if { $txnenv == 1 } {
151			error_check_good txn [$t commit] 0
152		}
153		incr count
154	}
155	close $did
156
157	# Now we will get each key from the DB and compare the results
158	# to the original.
159	puts "\tTest$tnum.b: \
160	    traverse entire file checking duplicates before close."
161	if { $txnenv == 1 } {
162		set t [$env txn]
163		error_check_good txn [is_valid_txn $t $env] TRUE
164		set txn "-txn $t"
165	}
166	dup_check $db $txn $t1 $dlist
167	if { $txnenv == 1 } {
168		error_check_good txn [$t commit] 0
169	}
170
171	# Now compare the keys to see if they match the dictionary entries
172	set q q
173	filehead $nentries $dict $t3
174	filesort $t3 $t2
175	filesort $t1 $t3
176
177	error_check_good Test$tnum:diff($t3,$t2) \
178	    [filecmp $t3 $t2] 0
179
180	error_check_good db_close [$db close] 0
181
182	set db [eval {berkdb_open} $args $testfile]
183	error_check_good dbopen [is_valid_db $db] TRUE
184
185	puts "\tTest$tnum.c: \
186	    traverse entire file checking duplicates after close."
187	if { $txnenv == 1 } {
188		set t [$env txn]
189		error_check_good txn [is_valid_txn $t $env] TRUE
190		set txn "-txn $t"
191	}
192	dup_check $db $txn $t1 $dlist
193	if { $txnenv == 1 } {
194		error_check_good txn [$t commit] 0
195	}
196
197	# Now compare the keys to see if they match the dictionary entries
198	filesort $t1 $t3
199	error_check_good Test$tnum:diff($t3,$t2) \
200	    [filecmp $t3 $t2] 0
201
202	puts "\tTest$tnum.d: Testing key_first functionality"
203	if { $txnenv == 1 } {
204		set t [$env txn]
205		error_check_good txn [is_valid_txn $t $env] TRUE
206		set txn "-txn $t"
207	}
208	add_dup $db $txn $nentries "-keyfirst" 0 0
209	set dlist [linsert $dlist 0 0]
210	dup_check $db $txn $t1 $dlist
211	if { $txnenv == 1 } {
212		error_check_good txn [$t commit] 0
213	}
214
215	puts "\tTest$tnum.e: Testing key_last functionality"
216	if { $txnenv == 1 } {
217		set t [$env txn]
218		error_check_good txn [is_valid_txn $t $env] TRUE
219		set txn "-txn $t"
220	}
221	add_dup $db $txn $nentries "-keylast" [expr $maxodd - 1] 0
222	lappend dlist [expr $maxodd - 1]
223	dup_check $db $txn $t1 $dlist
224	if { $txnenv == 1 } {
225		error_check_good txn [$t commit] 0
226	}
227
228	puts "\tTest$tnum.f: Testing add_before functionality"
229	if { $txnenv == 1 } {
230		set t [$env txn]
231		error_check_good txn [is_valid_txn $t $env] TRUE
232		set txn "-txn $t"
233	}
234	add_dup $db $txn $nentries "-before" 2 3
235	set dlist [linsert $dlist 2 2]
236	dup_check $db $txn $t1 $dlist
237	if { $txnenv == 1 } {
238		error_check_good txn [$t commit] 0
239	}
240
241	puts "\tTest$tnum.g: Testing add_after functionality"
242	if { $txnenv == 1 } {
243		set t [$env txn]
244		error_check_good txn [is_valid_txn $t $env] TRUE
245		set txn "-txn $t"
246	}
247	add_dup $db $txn $nentries "-after" 4 4
248	set dlist [linsert $dlist 4 4]
249	dup_check $db $txn $t1 $dlist
250	if { $txnenv == 1 } {
251		error_check_good txn [$t commit] 0
252	}
253
254	error_check_good db_close [$db close] 0
255}
256
257proc add_dup {db txn nentries flag dataval iter} {
258	source ./include.tcl
259
260	set dbc [eval {$db cursor} $txn]
261	set did [open $dict]
262	set count 0
263	while { [gets $did str] != -1 && $count < $nentries } {
264		set datastr $dataval:$str
265		set ret [$dbc get "-set" $str]
266		error_check_bad "cget(SET)" [is_substr $ret Error] 1
267		for { set i 1 } { $i < $iter } { incr i } {
268			set ret [$dbc get "-next"]
269			error_check_bad "cget(NEXT)" [is_substr $ret Error] 1
270		}
271
272		if { [string compare $flag "-before"] == 0 ||
273		    [string compare $flag "-after"] == 0 } {
274			set ret [$dbc put $flag $datastr]
275		} else {
276			set ret [$dbc put $flag $str $datastr]
277		}
278		error_check_good "$dbc put $flag" $ret 0
279		incr count
280	}
281	close $did
282	$dbc close
283}
284
285proc test011_recno { method {nentries 10000} {tnum "011"} largs } {
286	global dlist
287	source ./include.tcl
288
289	set largs [convert_args $method $largs]
290	set omethod [convert_method $method]
291	set renum [is_rrecno $method]
292
293	puts "Test$tnum: \
294	    $method ($largs) $nentries test cursor insert functionality"
295
296	# Create the database and open the dictionary
297	set eindex [lsearch -exact $largs "-env"]
298	#
299	# If we are using an env, then testfile should just be the db name.
300	# Otherwise it is the test directory and the name.
301	set txnenv 0
302	if { $eindex == -1 } {
303		set testfile $testdir/test$tnum.db
304		set env NULL
305	} else {
306		set testfile test$tnum.db
307		incr eindex
308		set env [lindex $largs $eindex]
309		set txnenv [is_txnenv $env]
310		if { $txnenv == 1 } {
311			append largs " -auto_commit "
312			#
313			# If we are using txns and running with the
314			# default, set the default down a bit.
315			#
316			if { $nentries == 10000 } {
317				set nentries 100
318			}
319		}
320		set testdir [get_home $env]
321	}
322	set t1 $testdir/t1
323	set t2 $testdir/t2
324	set t3 $testdir/t3
325	cleanup $testdir $env
326
327	if {$renum == 1} {
328		append largs " -renumber"
329	}
330	set db [eval {berkdb_open \
331	     -create -mode 0644} $largs {$omethod $testfile}]
332	error_check_good dbopen [is_valid_db $db] TRUE
333
334	set did [open $dict]
335
336	set pflags ""
337	set gflags ""
338	set txn ""
339	set count 0
340
341	# The basic structure of the test is that we pick a random key
342	# in the database and then add items before, after, ?? it.  The
343	# trickiness is that with RECNO, these are not duplicates, they
344	# are creating new keys.  Therefore, every time we do this, the
345	# keys assigned to other values change.  For this reason, we'll
346	# keep the database in tcl as a list and insert properly into
347	# it to verify that the right thing is happening.  If we do not
348	# have renumber set, then the BEFORE and AFTER calls should fail.
349
350	# Seed the database with an initial record
351	gets $did str
352	if { $txnenv == 1 } {
353		set t [$env txn]
354		error_check_good txn [is_valid_txn $t $env] TRUE
355		set txn "-txn $t"
356	}
357	set ret [eval {$db put} $txn {1 [chop_data $method $str]}]
358	if { $txnenv == 1 } {
359		error_check_good txn [$t commit] 0
360	}
361	error_check_good put $ret 0
362	set count 1
363
364	set dlist "NULL $str"
365
366	# Open a cursor
367	if { $txnenv == 1 } {
368		set t [$env txn]
369		error_check_good txn [is_valid_txn $t $env] TRUE
370		set txn "-txn $t"
371	}
372	set dbc [eval {$db cursor} $txn]
373	puts "\tTest$tnum.a: put and get entries"
374	while { [gets $did str] != -1 && $count < $nentries } {
375		# Pick a random key
376		set key [berkdb random_int 1 $count]
377		set ret [$dbc get -set $key]
378		set k [lindex [lindex $ret 0] 0]
379		set d [lindex [lindex $ret 0] 1]
380		error_check_good cget:SET:key $k $key
381		error_check_good \
382		    cget:SET $d [pad_data $method [lindex $dlist $key]]
383
384		# Current
385		set ret [$dbc put -current [chop_data $method $str]]
386		error_check_good cput:$key $ret 0
387		set dlist [lreplace $dlist $key $key [pad_data $method $str]]
388
389		# Before
390		if { [gets $did str] == -1 } {
391			continue;
392		}
393
394		if { $renum == 1 } {
395			set ret [$dbc put \
396			    -before [chop_data $method $str]]
397			error_check_good cput:$key:BEFORE $ret $key
398			set dlist [linsert $dlist $key $str]
399			incr count
400
401			# After
402			if { [gets $did str] == -1 } {
403				continue;
404			}
405			set ret [$dbc put \
406			    -after [chop_data $method $str]]
407			error_check_good cput:$key:AFTER $ret [expr $key + 1]
408			set dlist [linsert $dlist [expr $key + 1] $str]
409			incr count
410		}
411
412		# Now verify that the keys are in the right place
413		set i 0
414		for {set ret [$dbc get "-set" $key]} \
415		    {[string length $ret] != 0 && $i < 3} \
416		    {set ret [$dbc get "-next"] } {
417			set check_key [expr $key + $i]
418
419			set k [lindex [lindex $ret 0] 0]
420			error_check_good cget:$key:loop $k $check_key
421
422			set d [lindex [lindex $ret 0] 1]
423			error_check_good cget:data $d \
424			    [pad_data $method [lindex $dlist $check_key]]
425			incr i
426		}
427	}
428	close $did
429	error_check_good cclose [$dbc close] 0
430	if { $txnenv == 1 } {
431		error_check_good txn [$t commit] 0
432	}
433
434	# Create  check key file.
435	set oid [open $t2 w]
436	for {set i 1} {$i <= $count} {incr i} {
437		puts $oid $i
438	}
439	close $oid
440
441	puts "\tTest$tnum.b: dump file"
442	if { $txnenv == 1 } {
443		set t [$env txn]
444		error_check_good txn [is_valid_txn $t $env] TRUE
445		set txn "-txn $t"
446	}
447	dump_file $db $txn $t1 test011_check
448	if { $txnenv == 1 } {
449		error_check_good txn [$t commit] 0
450	}
451	error_check_good Test$tnum:diff($t2,$t1) \
452	    [filecmp $t2 $t1] 0
453
454	error_check_good db_close [$db close] 0
455
456	puts "\tTest$tnum.c: close, open, and dump file"
457	eval open_and_dump_file $testfile $env $t1 test011_check \
458	    dump_file_direction "-first" "-next" $largs
459	error_check_good Test$tnum:diff($t2,$t1) \
460	    [filecmp $t2 $t1] 0
461
462	puts "\tTest$tnum.d: close, open, and dump file in reverse direction"
463	eval open_and_dump_file $testfile $env $t1 test011_check \
464	    dump_file_direction "-last" "-prev" $largs
465
466	filesort $t1 $t3 -n
467	error_check_good Test$tnum:diff($t2,$t3) \
468	    [filecmp $t2 $t3] 0
469}
470
471proc test011_check { key data } {
472	global dlist
473
474	error_check_good "get key $key" $data [lindex $dlist $key]
475}
476