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