1# See the file LICENSE for redistribution information.
2#
3# Copyright (c) 1996,2008 Oracle.  All rights reserved.
4#
5# $Id: test094.tcl,v 12.6 2008/01/08 20:58:53 bostic Exp $
6#
7# TEST	test094
8# TEST	Test using set_dup_compare.
9# TEST
10# TEST	Use the first 10,000 entries from the dictionary.
11# TEST	Insert each with self as key and data; retrieve each.
12# TEST	After all are entered, retrieve all; compare output to original.
13# TEST	Close file, reopen, do retrieve and re-verify.
14proc test094 { method {nentries 10000} {ndups 10} {tnum "094"} args} {
15	source ./include.tcl
16	global errorInfo
17
18	set dbargs [convert_args $method $args]
19	set omethod [convert_method $method]
20
21	if { [is_btree $method] != 1 && [is_hash $method] != 1 } {
22		puts "Test$tnum: skipping for method $method."
23		return
24	}
25
26	set txnenv 0
27	set eindex [lsearch -exact $dbargs "-env"]
28	# Create the database and open the dictionary
29	#
30	# If we are using an env, then testfile should just be the db name.
31	# Otherwise it is the test directory and the name.
32	if { $eindex == -1 } {
33		set testfile $testdir/test$tnum-a.db
34		set env NULL
35	} else {
36		set testfile test$tnum-a.db
37		incr eindex
38		set env [lindex $dbargs $eindex]
39		set rpcenv [is_rpcenv $env]
40		if { $rpcenv == 1 } {
41			puts "Test$tnum: skipping for RPC"
42			return
43		}
44		set txnenv [is_txnenv $env]
45		if { $txnenv == 1 } {
46			append dbargs " -auto_commit "
47			if { $nentries == 10000 } {
48				set nentries 100
49			}
50			reduce_dups nentries ndups
51		}
52		set testdir [get_home $env]
53	}
54	puts "Test$tnum: $method ($args) $nentries \
55	    with $ndups dups using dupcompare"
56
57	cleanup $testdir $env
58
59	set db [eval {berkdb_open -dupcompare test094_cmp \
60	    -dup -dupsort -create -mode 0644} $omethod $dbargs {$testfile}]
61	error_check_good dbopen [is_valid_db $db] TRUE
62
63	set did [open $dict]
64	set t1 $testdir/t1
65	set pflags ""
66	set gflags ""
67	set txn ""
68	puts "\tTest$tnum.a: $nentries put/get duplicates loop"
69	# Here is the loop where we put and get each key/data pair
70	set count 0
71	set dlist {}
72	for {set i 0} {$i < $ndups} {incr i} {
73		set dlist [linsert $dlist 0 $i]
74	}
75	while { [gets $did str] != -1 && $count < $nentries } {
76		set key $str
77		for {set i 0} {$i < $ndups} {incr i} {
78			set data $i:$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 ret [eval {$db put} \
85			    $txn $pflags {$key [chop_data $omethod $data]}]
86			error_check_good put $ret 0
87			if { $txnenv == 1 } {
88				error_check_good txn [$t commit] 0
89			}
90		}
91
92		set ret [eval {$db get} $gflags {$key}]
93		error_check_good get [llength $ret] $ndups
94		incr count
95	}
96	close $did
97	# Now we will get each key from the DB and compare the results
98	# to the original.
99	puts "\tTest$tnum.b: traverse checking duplicates before close"
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	dup_check $db $txn $t1 $dlist
106	if { $txnenv == 1 } {
107		error_check_good txn [$t commit] 0
108	}
109	error_check_good db_close [$db close] 0
110
111	# Set up second testfile so truncate flag is not needed.
112	# If we are using an env, then testfile should just be the db name.
113	# Otherwise it is the test directory and the name.
114	if { $eindex == -1 } {
115		set testfile $testdir/test$tnum-b.db
116		set env NULL
117	} else {
118		set testfile test$tnum-b.db
119		set env [lindex $dbargs $eindex]
120		set testdir [get_home $env]
121	}
122	cleanup $testdir $env
123
124	#
125	# Test dupcompare with data items big enough to force offpage dups.
126	#
127	puts "\tTest$tnum.c: big key put/get dup loop key=filename data=filecontents"
128	set db [eval {berkdb_open -dupcompare test094_cmp -dup -dupsort \
129	     -create -mode 0644} $omethod $dbargs $testfile]
130	error_check_good dbopen [is_valid_db $db] TRUE
131
132	# Here is the loop where we put and get each key/data pair
133	set file_list [get_file_list 1]
134	if { [llength $file_list] > $nentries } {
135		set file_list [lrange $file_list 1 $nentries]
136	}
137
138	set count 0
139	foreach f $file_list {
140		set fid [open $f r]
141		fconfigure $fid -translation binary
142		set cont [read $fid]
143		close $fid
144
145		set key $f
146		for {set i 0} {$i < $ndups} {incr i} {
147			set data $i:$cont
148			if { $txnenv == 1 } {
149				set t [$env txn]
150				error_check_good txn [is_valid_txn $t $env] TRUE
151				set txn "-txn $t"
152			}
153			set ret [eval {$db put} \
154			    $txn $pflags {$key [chop_data $omethod $data]}]
155			error_check_good put $ret 0
156			if { $txnenv == 1 } {
157				error_check_good txn [$t commit] 0
158			}
159		}
160
161		set ret [eval {$db get} $gflags {$key}]
162		error_check_good get [llength $ret] $ndups
163		incr count
164	}
165
166	puts "\tTest$tnum.d: traverse checking duplicates before close"
167	if { $txnenv == 1 } {
168		set t [$env txn]
169		error_check_good txn [is_valid_txn $t $env] TRUE
170		set txn "-txn $t"
171	}
172	dup_file_check $db $txn $t1 $dlist
173	if { $txnenv == 1 } {
174		error_check_good txn [$t commit] 0
175		set testdir [get_home $env]
176	}
177	error_check_good db_close [$db close] 0
178
179	# Clean up the test directory, since there's currently
180	# no way to specify a dup_compare function to berkdb dbverify
181	# and without one it will fail.
182	cleanup $testdir $env
183}
184
185# Simple dup comparison.
186proc test094_cmp { a b } {
187	return [string compare $b $a]
188}
189