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