1# See the file LICENSE for redistribution information.
2#
3# Copyright (c) 1996,2008 Oracle.  All rights reserved.
4#
5# $Id: test031.tcl,v 12.6 2008/01/08 20:58:53 bostic Exp $
6#
7# TEST	test031
8# TEST	Duplicate sorting functionality
9# TEST	Make sure DB_NODUPDATA works.
10# TEST
11# TEST	Use the first 10,000 entries from the dictionary.
12# TEST	Insert each with self as key and "ndups" duplicates
13# TEST	For the data field, prepend random five-char strings (see test032)
14# TEST	that we force the duplicate sorting code to do something.
15# TEST	Along the way, test that we cannot insert duplicate duplicates
16# TEST	using DB_NODUPDATA.
17# TEST
18# TEST	By setting ndups large, we can make this an off-page test
19# TEST	After all are entered, retrieve all; verify output.
20# TEST	Close file, reopen, do retrieve and re-verify.
21# TEST	This does not work for recno
22proc test031 { method {nentries 10000} {ndups 5} {tnum "031"} args } {
23	global alphabet
24	global rand_init
25	source ./include.tcl
26
27	berkdb srand $rand_init
28
29	set args [convert_args $method $args]
30	set omethod [convert_method $method]
31
32	# Create the database and open the dictionary
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/test$tnum.db
40		set checkdb $testdir/checkdb.db
41		set env NULL
42	} else {
43		set testfile test$tnum.db
44		set checkdb checkdb.db
45		incr eindex
46		set env [lindex $args $eindex]
47		set txnenv [is_txnenv $env]
48		if { $txnenv == 1 } {
49			append args " -auto_commit "
50			#
51			# If we are using txns and running with the
52			# default, set the default down a bit.
53			#
54			if { $nentries == 10000 } {
55				set nentries 100
56			}
57			reduce_dups nentries ndups
58		}
59		set testdir [get_home $env]
60	}
61	set t1 $testdir/t1
62	set t2 $testdir/t2
63	set t3 $testdir/t3
64	cleanup $testdir $env
65
66	puts "Test$tnum: \
67	    $method ($args) $nentries small $ndups sorted dup key/data pairs"
68	if { [is_record_based $method] == 1 || \
69	    [is_rbtree $method] == 1 } {
70		puts "Test$tnum skipping for method $omethod"
71		return
72	}
73	set db [eval {berkdb_open -create \
74		-mode 0644} $args {$omethod -dup -dupsort $testfile}]
75	error_check_good dbopen [is_valid_db $db] TRUE
76	set did [open $dict]
77
78	set check_db [eval {berkdb_open \
79	     -create -mode 0644} $args {-hash $checkdb}]
80	error_check_good dbopen:check_db [is_valid_db $check_db] TRUE
81
82	set pflags ""
83	set gflags ""
84	set txn ""
85	set count 0
86
87	# Here is the loop where we put and get each key/data pair
88	puts "\tTest$tnum.a: Put/get loop, check nodupdata"
89	if { $txnenv == 1 } {
90		set t [$env txn]
91		error_check_good txn [is_valid_txn $t $env] TRUE
92		set txn "-txn $t"
93	}
94	set dbc [eval {$db cursor} $txn]
95	error_check_good cursor_open [is_valid_cursor $dbc $db] TRUE
96	while { [gets $did str] != -1 && $count < $nentries } {
97		# Re-initialize random string generator
98		randstring_init $ndups
99
100		set dups ""
101		for { set i 1 } { $i <= $ndups } { incr i } {
102			set pref [randstring]
103			set dups $dups$pref
104			set datastr $pref:$str
105			if { $i == 2 } {
106				set nodupstr $datastr
107			}
108			set ret [eval {$db put} \
109			    $txn $pflags {$str [chop_data $method $datastr]}]
110			error_check_good put $ret 0
111		}
112
113		# Test DB_NODUPDATA using the DB handle
114		set ret [eval {$db put -nodupdata} \
115		    $txn $pflags {$str [chop_data $method $nodupstr]}]
116		error_check_good db_nodupdata [is_substr $ret "DB_KEYEXIST"] 1
117
118		set ret [eval {$check_db put} \
119		    $txn $pflags {$str [chop_data $method $dups]}]
120		error_check_good checkdb_put $ret 0
121
122		# Now retrieve all the keys matching this key
123		set x 0
124		set lastdup ""
125		# Test DB_NODUPDATA using cursor handle
126		set ret [$dbc get -set $str]
127		error_check_bad dbc_get [llength $ret] 0
128		set datastr [lindex [lindex $ret 0] 1]
129		error_check_bad dbc_data [string length $datastr] 0
130		set ret [eval {$dbc put -nodupdata} \
131		    {$str [chop_data $method $datastr]}]
132		error_check_good dbc_nodupdata [is_substr $ret "DB_KEYEXIST"] 1
133
134		for {set ret [$dbc get -set $str]} \
135		    {[llength $ret] != 0} \
136		    {set ret [$dbc get -nextdup] } {
137			set k [lindex [lindex $ret 0] 0]
138			if { [string compare $k $str] != 0 } {
139				break
140			}
141			set datastr [lindex [lindex $ret 0] 1]
142			if {[string length $datastr] == 0} {
143				break
144			}
145			if {[string compare \
146			    $lastdup [pad_data $method $datastr]] > 0} {
147				error_check_good \
148				    sorted_dups($lastdup,$datastr) 0 1
149			}
150			incr x
151			set lastdup $datastr
152		}
153		error_check_good "Test$tnum:ndups:$str" $x $ndups
154		incr count
155	}
156	error_check_good cursor_close [$dbc close] 0
157	if { $txnenv == 1 } {
158		error_check_good txn [$t commit] 0
159	}
160	close $did
161
162	# Now we will get each key from the DB and compare the results
163	# to the original.
164	puts "\tTest$tnum.b: Checking file for correct duplicates"
165	if { $txnenv == 1 } {
166		set t [$env txn]
167		error_check_good txn [is_valid_txn $t $env] TRUE
168		set txn "-txn $t"
169	}
170	set dbc [eval {$db cursor} $txn]
171	error_check_good cursor_open(2) [is_valid_cursor $dbc $db] TRUE
172
173	set lastkey "THIS WILL NEVER BE A KEY VALUE"
174	# no need to delete $lastkey
175	set firsttimethru 1
176	for {set ret [$dbc get -first]} \
177	    {[llength $ret] != 0} \
178	    {set ret [$dbc get -next] } {
179		set k [lindex [lindex $ret 0] 0]
180		set d [lindex [lindex $ret 0] 1]
181		error_check_bad data_check:$d [string length $d] 0
182
183		if { [string compare $k $lastkey] != 0 } {
184			# Remove last key from the checkdb
185			if { $firsttimethru != 1 } {
186				error_check_good check_db:del:$lastkey \
187				    [eval {$check_db del} $txn {$lastkey}] 0
188			}
189			set firsttimethru 0
190			set lastdup ""
191			set lastkey $k
192			set dups [lindex [lindex [eval {$check_db get} \
193				$txn {$k}] 0] 1]
194			error_check_good check_db:get:$k \
195			    [string length $dups] [expr $ndups * 4]
196		}
197
198		if { [string compare $lastdup $d] > 0 } {
199			error_check_good dup_check:$k:$d 0 1
200		}
201		set lastdup $d
202
203		set pref [string range $d 0 3]
204		set ndx [string first $pref $dups]
205		error_check_good valid_duplicate [expr $ndx >= 0] 1
206		set a [string range $dups 0 [expr $ndx - 1]]
207		set b [string range $dups [expr $ndx + 4] end]
208		set dups $a$b
209	}
210	# Remove last key from the checkdb
211	if { [string length $lastkey] != 0 } {
212		error_check_good check_db:del:$lastkey \
213		[eval {$check_db del} $txn {$lastkey}] 0
214	}
215
216	# Make sure there is nothing left in check_db
217
218	set check_c [eval {$check_db cursor} $txn]
219	set ret [$check_c get -first]
220	error_check_good check_c:get:$ret [llength $ret] 0
221	error_check_good check_c:close [$check_c close] 0
222
223	error_check_good dbc_close [$dbc close] 0
224	if { $txnenv == 1 } {
225		error_check_good txn [$t commit] 0
226	}
227	error_check_good check_db:close [$check_db close] 0
228	error_check_good db_close [$db close] 0
229}
230