1# See the file LICENSE for redistribution information.
2#
3# Copyright (c) 1999,2008 Oracle.  All rights reserved.
4#
5# $Id: test073.tcl,v 12.6 2008/01/08 20:58:53 bostic Exp $
6#
7# TEST	test073
8# TEST	Test of cursor stability on duplicate pages.
9# TEST
10# TEST	Does the following:
11# TEST	a. Initialize things by DB->putting ndups dups and
12# TEST	   setting a reference cursor to point to each.
13# TEST	b. c_put ndups dups (and correspondingly expanding
14# TEST	   the set of reference cursors) after the last one, making sure
15# TEST	   after each step that all the reference cursors still point to
16# TEST	   the right item.
17# TEST	c. Ditto, but before the first one.
18# TEST	d. Ditto, but after each one in sequence first to last.
19# TEST	e. Ditto, but after each one in sequence from last to first.
20# TEST	   occur relative to the new datum)
21# TEST	f. Ditto for the two sequence tests, only doing a
22# TEST	   DBC->c_put(DB_CURRENT) of a larger datum instead of adding a
23# TEST	   new one.
24proc test073 { method {pagesize 512} {ndups 50} {tnum "073"} args } {
25	source ./include.tcl
26	global alphabet
27
28	set omethod [convert_method $method]
29	set args [convert_args $method $args]
30
31	set txnenv 0
32	set eindex [lsearch -exact $args "-env"]
33	#
34	# If we are using an env, then testfile should just be the db name.
35	# Otherwise it is the test directory and the name.
36	if { $eindex == -1 } {
37		set testfile $testdir/test$tnum.db
38		set env NULL
39	} else {
40		set testfile test$tnum.db
41		incr eindex
42		set env [lindex $args $eindex]
43		set txnenv [is_txnenv $env]
44		if { $txnenv == 1 } {
45			append args " -auto_commit "
46		}
47		set testdir [get_home $env]
48	}
49	cleanup $testdir $env
50
51	set key "the key"
52	set txn ""
53
54	puts -nonewline "Test$tnum $omethod ($args): "
55	if { [is_record_based $method] || [is_rbtree $method] } {
56		puts "Skipping for method $method."
57		return
58	} else {
59		puts "cursor stability on duplicate pages."
60	}
61	set pgindex [lsearch -exact $args "-pagesize"]
62	if { $pgindex != -1 } {
63		puts "Test073: skipping for specific pagesizes"
64		return
65	}
66
67	append args " -pagesize $pagesize -dup"
68
69	set db [eval {berkdb_open \
70	     -create -mode 0644} $omethod $args $testfile]
71	error_check_good "db open" [is_valid_db $db] TRUE
72
73	# Number of outstanding keys.
74	set keys 0
75
76	puts "\tTest$tnum.a.1: Initializing put loop; $ndups dups, short data."
77
78	for { set i 0 } { $i < $ndups } { incr i } {
79		set datum [makedatum_t73 $i 0]
80
81		if { $txnenv == 1 } {
82			set t [$env txn]
83			error_check_good txn [is_valid_txn $t $env] TRUE
84			set txn "-txn $t"
85		}
86		set ret [eval {$db put} $txn {$key $datum}]
87		error_check_good "db put ($i)" $ret 0
88		if { $txnenv == 1 } {
89			error_check_good txn [$t commit] 0
90		}
91
92		set is_long($i) 0
93		incr keys
94	}
95
96	puts "\tTest$tnum.a.2: Initializing cursor get loop; $keys dups."
97	if { $txnenv == 1 } {
98		set t [$env txn]
99		error_check_good txn [is_valid_txn $t $env] TRUE
100		set txn "-txn $t"
101	}
102	for { set i 0 } { $i < $keys } { incr i } {
103		set datum [makedatum_t73 $i 0]
104
105		set dbc($i) [eval {$db cursor} $txn]
106		error_check_good "db cursor ($i)"\
107		    [is_valid_cursor $dbc($i) $db] TRUE
108		error_check_good "dbc get -get_both ($i)"\
109		    [$dbc($i) get -get_both $key $datum]\
110		    [list [list $key $datum]]
111	}
112
113	puts "\tTest$tnum.b: Cursor put (DB_KEYLAST); $ndups new dups,\
114	    short data."
115
116	for { set i 0 } { $i < $ndups } { incr i } {
117		# !!! keys contains the number of the next dup
118		# to be added (since they start from zero)
119
120		set datum [makedatum_t73 $keys 0]
121		set curs [eval {$db cursor} $txn]
122		error_check_good "db cursor create" [is_valid_cursor $curs $db]\
123		    TRUE
124		error_check_good "c_put(DB_KEYLAST, $keys)"\
125		    [$curs put -keylast $key $datum] 0
126
127		set dbc($keys) $curs
128		set is_long($keys) 0
129		incr keys
130
131		verify_t73 is_long dbc $keys $key
132	}
133
134	puts "\tTest$tnum.c: Cursor put (DB_KEYFIRST); $ndups new dups,\
135	    short data."
136
137	for { set i 0 } { $i < $ndups } { incr i } {
138		# !!! keys contains the number of the next dup
139		# to be added (since they start from zero)
140
141		set datum [makedatum_t73 $keys 0]
142		set curs [eval {$db cursor} $txn]
143		error_check_good "db cursor create" [is_valid_cursor $curs $db]\
144		    TRUE
145		error_check_good "c_put(DB_KEYFIRST, $keys)"\
146		    [$curs put -keyfirst $key $datum] 0
147
148		set dbc($keys) $curs
149		set is_long($keys) 0
150		incr keys
151
152		verify_t73 is_long dbc $keys $key
153	}
154
155	puts "\tTest$tnum.d: Cursor put (DB_AFTER) first to last;\
156	    $keys new dups, short data"
157	# We want to add a datum after each key from 0 to the current
158	# value of $keys, which we thus need to save.
159	set keysnow $keys
160	for { set i 0 } { $i < $keysnow } { incr i } {
161		set datum [makedatum_t73 $keys 0]
162		set curs [eval {$db cursor} $txn]
163		error_check_good "db cursor create" [is_valid_cursor $curs $db]\
164		    TRUE
165
166		# Which datum to insert this guy after.
167		set curdatum [makedatum_t73 $i 0]
168		error_check_good "c_get(DB_GET_BOTH, $i)"\
169		    [$curs get -get_both $key $curdatum]\
170		    [list [list $key $curdatum]]
171		error_check_good "c_put(DB_AFTER, $i)"\
172		    [$curs put -after $datum] 0
173
174		set dbc($keys) $curs
175		set is_long($keys) 0
176		incr keys
177
178		verify_t73 is_long dbc $keys $key
179	}
180
181	puts "\tTest$tnum.e: Cursor put (DB_BEFORE) last to first;\
182	    $keys new dups, short data"
183
184	for { set i [expr $keys - 1] } { $i >= 0 } { incr i -1 } {
185		set datum [makedatum_t73 $keys 0]
186		set curs [eval {$db cursor} $txn]
187		error_check_good "db cursor create" [is_valid_cursor $curs $db]\
188		    TRUE
189
190		# Which datum to insert this guy before.
191		set curdatum [makedatum_t73 $i 0]
192		error_check_good "c_get(DB_GET_BOTH, $i)"\
193		    [$curs get -get_both $key $curdatum]\
194		    [list [list $key $curdatum]]
195		error_check_good "c_put(DB_BEFORE, $i)"\
196		    [$curs put -before $datum] 0
197
198		set dbc($keys) $curs
199		set is_long($keys) 0
200		incr keys
201
202		if { $i % 10 == 1 } {
203			verify_t73 is_long dbc $keys $key
204		}
205	}
206	verify_t73 is_long dbc $keys $key
207
208	puts "\tTest$tnum.f: Cursor put (DB_CURRENT), first to last,\
209	    growing $keys data."
210	set keysnow $keys
211	for { set i 0 } { $i < $keysnow } { incr i } {
212		set olddatum [makedatum_t73 $i 0]
213		set newdatum [makedatum_t73 $i 1]
214		set curs [eval {$db cursor} $txn]
215		error_check_good "db cursor create" [is_valid_cursor $curs $db]\
216		    TRUE
217
218		error_check_good "c_get(DB_GET_BOTH, $i)"\
219		    [$curs get -get_both $key $olddatum]\
220		    [list [list $key $olddatum]]
221		error_check_good "c_put(DB_CURRENT, $i)"\
222		    [$curs put -current $newdatum] 0
223
224		error_check_good "cursor close" [$curs close] 0
225
226		set is_long($i) 1
227
228		if { $i % 10 == 1 } {
229			verify_t73 is_long dbc $keys $key
230		}
231	}
232	verify_t73 is_long dbc $keys $key
233
234	# Close cursors.
235	puts "\tTest$tnum.g: Closing cursors."
236	for { set i 0 } { $i < $keys } { incr i } {
237		error_check_good "dbc close ($i)" [$dbc($i) close] 0
238	}
239	if { $txnenv == 1 } {
240		error_check_good txn [$t commit] 0
241	}
242	error_check_good "db close" [$db close] 0
243}
244
245# !!!: This procedure is also used by test087.
246proc makedatum_t73 { num is_long } {
247	global alphabet
248	if { $is_long == 1 } {
249		set a $alphabet$alphabet$alphabet
250	} else {
251		set a abcdefghijklm
252	}
253
254	# format won't do leading zeros, alas.
255	if { $num / 1000 > 0 } {
256		set i $num
257	} elseif { $num / 100 > 0 } {
258		set i 0$num
259	} elseif { $num / 10 > 0 } {
260		set i 00$num
261	} else {
262		set i 000$num
263	}
264
265	return $i$a
266}
267
268# !!!: This procedure is also used by test087.
269proc verify_t73 { is_long_array curs_array numkeys key } {
270	upvar $is_long_array is_long
271	upvar $curs_array dbc
272	upvar db db
273
274	#useful for debugging, perhaps.
275	eval $db sync
276
277	for { set j 0 } { $j < $numkeys } { incr j } {
278		set dbt [$dbc($j) get -current]
279		set k [lindex [lindex $dbt 0] 0]
280		set d [lindex [lindex $dbt 0] 1]
281
282		error_check_good\
283		    "cursor $j key correctness (with $numkeys total items)"\
284		    $k $key
285		error_check_good\
286		    "cursor $j data correctness (with $numkeys total items)"\
287		    $d [makedatum_t73 $j $is_long($j)]
288	}
289}
290