1# See the file LICENSE for redistribution information.
2#
3# Copyright (c) 1999-2009 Oracle.  All rights reserved.
4#
5# $Id$
6#
7# TEST	test047
8# TEST	DBcursor->c_get get test with SET_RANGE option.
9proc test047 { method args } {
10	source ./include.tcl
11
12	set tnum 047
13	set args [convert_args $method $args]
14
15	if { [is_btree $method] != 1 } {
16		puts "Test$tnum skipping for method $method"
17		return
18	}
19	# Btree with compression does not support unsorted duplicates.
20	if { [is_compressed $args] == 1 } {
21		puts "Test$tnum skipping for btree with compression."
22		return
23	}
24	set method "-btree"
25
26	puts "\tTest$tnum: Test of SET_RANGE interface to DB->c_get ($method)."
27
28	set key	"key"
29	set data	"data"
30	set txn ""
31	set flags ""
32
33	puts "\tTest$tnum.a: Create $method database."
34	set eindex [lsearch -exact $args "-env"]
35	set txnenv 0
36	#
37	# If we are using an env, then testfile should just be the db name.
38	# Otherwise it is the test directory and the name.
39	if { $eindex == -1 } {
40		set testfile $testdir/test$tnum.db
41		set testfile1 $testdir/test$tnum.a.db
42		set testfile2 $testdir/test$tnum.b.db
43		set env NULL
44	} else {
45		set testfile test$tnum.db
46		set testfile1 test$tnum.a.db
47		set testfile2 test$tnum.b.db
48		incr eindex
49		set env [lindex $args $eindex]
50		set txnenv [is_txnenv $env]
51		if { $txnenv == 1 } {
52			append args " -auto_commit "
53		}
54		set testdir [get_home $env]
55	}
56	set t1 $testdir/t1
57	cleanup $testdir $env
58
59	set oflags "-create -mode 0644 -dup $args $method"
60	set db [eval {berkdb_open} $oflags $testfile]
61	error_check_good dbopen [is_valid_db $db] TRUE
62
63	set nkeys 20
64	# Fill page w/ small key/data pairs
65	#
66	puts "\tTest$tnum.b: Fill page with $nkeys small key/data pairs."
67	for { set i 0 } { $i < $nkeys } { incr i } {
68		if { $txnenv == 1 } {
69			set t [$env txn]
70			error_check_good txn [is_valid_txn $t $env] TRUE
71			set txn "-txn $t"
72		}
73		set ret [eval {$db put} $txn {$key$i $data$i}]
74		error_check_good dbput $ret 0
75		if { $txnenv == 1 } {
76			error_check_good txn [$t commit] 0
77		}
78	}
79
80	if { $txnenv == 1 } {
81		set t [$env txn]
82		error_check_good txn [is_valid_txn $t $env] TRUE
83		set txn "-txn $t"
84	}
85	# open curs to db
86	set dbc [eval {$db cursor} $txn]
87	error_check_good db_cursor [is_valid_cursor $dbc $db] TRUE
88
89	puts "\tTest$tnum.c: Get data with SET_RANGE, then delete by cursor."
90	set i 0
91	set ret [$dbc get -set_range $key$i]
92	error_check_bad dbc_get:set_range [llength $ret] 0
93	set curr $ret
94
95	# delete by cursor, make sure it is gone
96	error_check_good dbc_del [$dbc del] 0
97
98	set ret [$dbc get -set_range $key$i]
99	error_check_bad dbc_get(post-delete):set_range [llength $ret] 0
100	error_check_bad dbc_get(no-match):set_range $ret $curr
101
102	puts "\tTest$tnum.d: \
103	    Use another cursor to fix item on page, delete by db."
104	set dbcurs2 [eval {$db cursor} $txn]
105	error_check_good db:cursor2 [is_valid_cursor $dbcurs2 $db] TRUE
106
107	set ret [$dbcurs2 get -set [lindex [lindex $ret 0] 0]]
108	error_check_bad dbc_get(2):set [llength $ret] 0
109	set curr $ret
110	error_check_good db:del [eval {$db del} $txn \
111	    {[lindex [lindex $ret 0] 0]}] 0
112
113	# make sure item is gone
114	set ret [$dbcurs2 get -set_range [lindex [lindex $curr 0] 0]]
115	error_check_bad dbc2_get:set_range [llength $ret] 0
116	error_check_bad dbc2_get:set_range $ret $curr
117
118	puts "\tTest$tnum.e: Close for second part of test, close db/cursors."
119	error_check_good dbc:close [$dbc close] 0
120	error_check_good dbc2:close [$dbcurs2 close] 0
121	if { $txnenv == 1 } {
122		error_check_good txn [$t commit] 0
123	}
124	error_check_good dbclose [$db close] 0
125
126	# open db
127	set db [eval {berkdb_open} $oflags $testfile1]
128	error_check_good dbopen2 [is_valid_db $db] TRUE
129
130	set nkeys 10
131	puts "\tTest$tnum.f: Fill page with $nkeys pairs, one set of dups."
132	for {set i 0} { $i < $nkeys } {incr i} {
133		# a pair
134		if { $txnenv == 1 } {
135			set t [$env txn]
136			error_check_good txn [is_valid_txn $t $env] TRUE
137			set txn "-txn $t"
138		}
139		set ret [eval {$db put} $txn {$key$i $data$i}]
140		error_check_good dbput($i) $ret 0
141		if { $txnenv == 1 } {
142			error_check_good txn [$t commit] 0
143		}
144	}
145
146	set j 0
147	for {set i 0} { $i < $nkeys } {incr i} {
148		# a dup set for same  1 key
149		if { $txnenv == 1 } {
150			set t [$env txn]
151			error_check_good txn [is_valid_txn $t $env] TRUE
152			set txn "-txn $t"
153		}
154		set ret [eval {$db put} $txn {$key$i DUP_$data$i}]
155		error_check_good dbput($i):dup $ret 0
156		if { $txnenv == 1 } {
157			error_check_good txn [$t commit] 0
158		}
159	}
160
161	puts "\tTest$tnum.g: \
162	    Get dups key w/ SET_RANGE, pin onpage with another cursor."
163	set i 0
164	if { $txnenv == 1 } {
165		set t [$env txn]
166		error_check_good txn [is_valid_txn $t $env] TRUE
167		set txn "-txn $t"
168	}
169	set dbc [eval {$db cursor} $txn]
170	error_check_good db_cursor [is_valid_cursor $dbc $db] TRUE
171	set ret [$dbc get -set_range $key$i]
172	error_check_bad dbc_get:set_range [llength $ret] 0
173
174	set dbc2 [eval {$db cursor} $txn]
175	error_check_good db_cursor [is_valid_cursor $dbc2 $db] TRUE
176	set ret2 [$dbc2 get -set_range $key$i]
177	error_check_bad dbc2_get:set_range [llength $ret] 0
178
179	error_check_good dbc_compare $ret $ret2
180	puts "\tTest$tnum.h: \
181	    Delete duplicates' key, use SET_RANGE to get next dup."
182	set ret [$dbc2 del]
183	error_check_good dbc2_del $ret 0
184	set ret [$dbc get -set_range $key$i]
185	error_check_bad dbc_get:set_range [llength $ret] 0
186	error_check_bad dbc_get:set_range $ret $ret2
187
188	error_check_good dbc_close [$dbc close] 0
189	error_check_good dbc2_close [$dbc2 close] 0
190	if { $txnenv == 1 } {
191		error_check_good txn [$t commit] 0
192	}
193	error_check_good db_close [$db close] 0
194
195	set db [eval {berkdb_open} $oflags $testfile2]
196	error_check_good dbopen [is_valid_db $db] TRUE
197
198	set nkeys 10
199	set ndups 1000
200
201	puts "\tTest$tnum.i: Fill page with $nkeys pairs and $ndups dups."
202	for {set i 0} { $i < $nkeys } { incr i} {
203		# a pair
204		if { $txnenv == 1 } {
205			set t [$env txn]
206			error_check_good txn [is_valid_txn $t $env] TRUE
207			set txn "-txn $t"
208		}
209		set ret [eval {$db put} $txn {$key$i $data$i}]
210		error_check_good dbput $ret 0
211
212		# dups for single pair
213		if { $i == 0} {
214			for {set j 0} { $j < $ndups } { incr j } {
215				set ret [eval {$db put} $txn \
216				    {$key$i DUP_$data$i:$j}]
217				error_check_good dbput:dup $ret 0
218			}
219		}
220		if { $txnenv == 1 } {
221			error_check_good txn [$t commit] 0
222		}
223	}
224	set i 0
225	if { $txnenv == 1 } {
226		set t [$env txn]
227		error_check_good txn [is_valid_txn $t $env] TRUE
228		set txn "-txn $t"
229	}
230	set dbc [eval {$db cursor} $txn]
231	error_check_good db_cursor [is_valid_cursor $dbc $db] TRUE
232	set dbc2 [eval {$db cursor} $txn]
233	error_check_good db_cursor [is_valid_cursor $dbc2 $db] TRUE
234	puts "\tTest$tnum.j: \
235	    Get key of first dup with SET_RANGE, fix with 2 curs."
236	set ret [$dbc get -set_range $key$i]
237	error_check_bad dbc_get:set_range [llength $ret] 0
238
239	set ret2 [$dbc2 get -set_range $key$i]
240	error_check_bad dbc2_get:set_range [llength $ret] 0
241	set curr $ret2
242
243	error_check_good dbc_compare $ret $ret2
244
245	puts "\tTest$tnum.k: Delete item by cursor, use SET_RANGE to verify."
246	set ret [$dbc2 del]
247	error_check_good dbc2_del $ret 0
248	set ret [$dbc get -set_range $key$i]
249	error_check_bad dbc_get:set_range [llength $ret] 0
250	error_check_bad dbc_get:set_range $ret $curr
251
252	puts "\tTest$tnum.l: Cleanup."
253	error_check_good dbc_close [$dbc close] 0
254	error_check_good dbc2_close [$dbc2 close] 0
255	if { $txnenv == 1 } {
256		error_check_good txn [$t commit] 0
257	}
258	error_check_good db_close [$db close] 0
259
260	puts "\tTest$tnum complete."
261}
262