1# See the file LICENSE for redistribution information.
2#
3# Copyright (c) 1999,2008 Oracle.  All rights reserved.
4#
5# $Id: test072.tcl,v 12.6 2008/01/08 20:58:53 bostic Exp $
6#
7# TEST	test072
8# TEST	Test of cursor stability when duplicates are moved off-page.
9proc test072 { method {pagesize 512} {ndups 20} {tnum "072"} args } {
10	source ./include.tcl
11	global alphabet
12	global is_je_test
13
14	set omethod [convert_method $method]
15	set args [convert_args $method $args]
16
17	set txnenv 0
18	set eindex [lsearch -exact $args "-env"]
19	#
20	# If we are using an env, then testfile name should just be
21	# the db name.  Otherwise it is the test directory and the name.
22	if { $eindex == -1 } {
23		set basename $testdir/test$tnum
24		set env NULL
25	} else {
26		set basename test$tnum
27		incr eindex
28		set env [lindex $args $eindex]
29		set txnenv [is_txnenv $env]
30		if { $txnenv == 1 } {
31			append args " -auto_commit "
32		}
33		set testdir [get_home $env]
34	}
35	cleanup $testdir $env
36
37	# Keys must sort $prekey < $key < $postkey.
38	set prekey "a key"
39	set key "the key"
40	set postkey "z key"
41
42	# Make these distinguishable from each other and from the
43	# alphabets used for the $key's data.
44	set predatum "1234567890"
45	set postdatum "0987654321"
46
47	puts -nonewline "Test$tnum $omethod ($args): "
48	if { [is_record_based $method] || [is_rbtree $method] } {
49		puts "Skipping for method $method."
50		return
51	} else {
52		puts "\nTest$tnum: Test of cursor stability when\
53		    duplicates are moved off-page."
54	}
55	set pgindex [lsearch -exact $args "-pagesize"]
56	if { $pgindex != -1 } {
57		puts "Test$tnum: skipping for specific pagesizes"
58		return
59	}
60
61	append args " -pagesize $pagesize "
62	set txn ""
63
64	set dlist [list "-dup" "-dup -dupsort"]
65	set testid 0
66	foreach dupopt $dlist {
67		if { $is_je_test && $dupopt == "-dup" } {
68			continue
69		}
70
71		incr testid
72		set duptestfile $basename$testid.db
73		set db [eval {berkdb_open -create -mode 0644} \
74		    $omethod $args $dupopt {$duptestfile}]
75		error_check_good "db open" [is_valid_db $db] TRUE
76
77		puts \
78"\tTest$tnum.a: ($dupopt) Set up surrounding keys and cursors."
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} $txn {$prekey $predatum}]
85		error_check_good pre_put $ret 0
86		set ret [eval {$db put} $txn {$postkey $postdatum}]
87		error_check_good post_put $ret 0
88
89		set precursor [eval {$db cursor} $txn]
90		error_check_good precursor [is_valid_cursor $precursor \
91		    $db] TRUE
92		set postcursor [eval {$db cursor} $txn]
93		error_check_good postcursor [is_valid_cursor $postcursor \
94		    $db] TRUE
95		error_check_good preset [$precursor get -set $prekey] \
96			[list [list $prekey $predatum]]
97		error_check_good postset [$postcursor get -set $postkey] \
98			[list [list $postkey $postdatum]]
99
100		puts "\tTest$tnum.b: Put/create cursor/verify all cursor loop."
101
102		for { set i 0 } { $i < $ndups } { incr i } {
103			set datum [format "%4d$alphabet" [expr $i + 1000]]
104			set data($i) $datum
105
106			# Uncomment these lines to see intermediate steps.
107			# error_check_good db_sync($i) [$db sync] 0
108			# error_check_good db_dump($i) \
109			#     [catch {exec $util_path/db_dump \
110			#	-da $duptestfile > $testdir/out.$i}] 0
111
112			set ret [eval {$db put} $txn {$key $datum}]
113			error_check_good "db put ($i)" $ret 0
114
115			set dbc($i) [eval {$db cursor} $txn]
116			error_check_good "db cursor ($i)"\
117			    [is_valid_cursor $dbc($i) $db] TRUE
118
119			error_check_good "dbc get -get_both ($i)"\
120			    [$dbc($i) get -get_both $key $datum]\
121			    [list [list $key $datum]]
122
123			for { set j 0 } { $j < $i } { incr j } {
124				set dbt [$dbc($j) get -current]
125				set k [lindex [lindex $dbt 0] 0]
126				set d [lindex [lindex $dbt 0] 1]
127
128				#puts "cursor $j after $i: $d"
129
130				eval {$db sync}
131
132				error_check_good\
133				    "cursor $j key correctness after $i puts" \
134				    $k $key
135				error_check_good\
136				    "cursor $j data correctness after $i puts" \
137				    $d $data($j)
138			}
139
140			# Check correctness of pre- and post- cursors.  Do an
141			# error_check_good on the lengths first so that we don't
142			# spew garbage as the "got" field and screw up our
143			# terminal.  (It's happened here.)
144			set pre_dbt [$precursor get -current]
145			set post_dbt [$postcursor get -current]
146			error_check_good \
147			    "key earlier cursor correctness after $i puts" \
148			    [string length [lindex [lindex $pre_dbt 0] 0]] \
149			    [string length $prekey]
150			error_check_good \
151			    "data earlier cursor correctness after $i puts" \
152			    [string length [lindex [lindex $pre_dbt 0] 1]] \
153			    [string length $predatum]
154			error_check_good \
155			    "key later cursor correctness after $i puts" \
156			    [string length [lindex [lindex $post_dbt 0] 0]] \
157			    [string length $postkey]
158			error_check_good \
159			    "data later cursor correctness after $i puts" \
160			    [string length [lindex [lindex $post_dbt 0] 1]]\
161			    [string length $postdatum]
162
163			error_check_good \
164			    "earlier cursor correctness after $i puts" \
165			    $pre_dbt [list [list $prekey $predatum]]
166			error_check_good \
167			    "later cursor correctness after $i puts" \
168			    $post_dbt [list [list $postkey $postdatum]]
169		}
170
171		puts "\tTest$tnum.c: Reverse Put/create cursor/verify all cursor loop."
172		set end [expr $ndups * 2 - 1]
173		for { set i $end } { $i >= $ndups } { set i [expr $i - 1] } {
174			set datum [format "%4d$alphabet" [expr $i + 1000]]
175			set data($i) $datum
176
177			# Uncomment these lines to see intermediate steps.
178			# error_check_good db_sync($i) [$db sync] 0
179			# error_check_good db_dump($i) \
180			#     [catch {exec $util_path/db_dump \
181			# 	-da $duptestfile > $testdir/out.$i}] 0
182
183			set ret [eval {$db put} $txn {$key $datum}]
184			error_check_good "db put ($i)" $ret 0
185
186			error_check_bad dbc($i)_stomped [info exists dbc($i)] 1
187			set dbc($i) [eval {$db cursor} $txn]
188			error_check_good "db cursor ($i)"\
189			    [is_valid_cursor $dbc($i) $db] TRUE
190
191			error_check_good "dbc get -get_both ($i)"\
192			    [$dbc($i) get -get_both $key $datum]\
193			    [list [list $key $datum]]
194
195			for { set j $i } { $j < $end } { incr j } {
196				set dbt [$dbc($j) get -current]
197				set k [lindex [lindex $dbt 0] 0]
198				set d [lindex [lindex $dbt 0] 1]
199
200				#puts "cursor $j after $i: $d"
201
202				eval {$db sync}
203
204				error_check_good\
205				    "cursor $j key correctness after $i puts" \
206				    $k $key
207				error_check_good\
208				    "cursor $j data correctness after $i puts" \
209				    $d $data($j)
210			}
211
212			# Check correctness of pre- and post- cursors.  Do an
213			# error_check_good on the lengths first so that we don't
214			# spew garbage as the "got" field and screw up our
215			# terminal.  (It's happened here.)
216			set pre_dbt [$precursor get -current]
217			set post_dbt [$postcursor get -current]
218			error_check_good \
219			    "key earlier cursor correctness after $i puts" \
220			    [string length [lindex [lindex $pre_dbt 0] 0]] \
221			    [string length $prekey]
222			error_check_good \
223			    "data earlier cursor correctness after $i puts" \
224			    [string length [lindex [lindex $pre_dbt 0] 1]] \
225			    [string length $predatum]
226			error_check_good \
227			    "key later cursor correctness after $i puts" \
228			    [string length [lindex [lindex $post_dbt 0] 0]] \
229			    [string length $postkey]
230			error_check_good \
231			    "data later cursor correctness after $i puts" \
232			    [string length [lindex [lindex $post_dbt 0] 1]]\
233			    [string length $postdatum]
234
235			error_check_good \
236			    "earlier cursor correctness after $i puts" \
237			    $pre_dbt [list [list $prekey $predatum]]
238			error_check_good \
239			    "later cursor correctness after $i puts" \
240			    $post_dbt [list [list $postkey $postdatum]]
241		}
242
243		# Close cursors.
244		puts "\tTest$tnum.d: Closing cursors."
245		for { set i 0 } { $i <= $end } { incr i } {
246			error_check_good "dbc close ($i)" [$dbc($i) close] 0
247		}
248		unset dbc
249		error_check_good precursor_close [$precursor close] 0
250		error_check_good postcursor_close [$postcursor 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}
257