1# See the file LICENSE for redistribution information.
2#
3# Copyright (c) 1999,2008 Oracle.  All rights reserved.
4#
5# $Id: recd010.tcl,v 12.6 2008/01/08 20:58:53 bostic Exp $
6#
7# TEST	recd010
8# TEST	Test stability of btree duplicates across btree off-page dup splits
9# TEST	and reverse splits and across recovery.
10proc recd010 { method {select 0} args} {
11	if { [is_btree $method] != 1 } {
12		puts "Recd010 skipping for method $method."
13		return
14	}
15
16	set pgindex [lsearch -exact $args "-pagesize"]
17	if { $pgindex != -1 } {
18		puts "Recd010: skipping for specific pagesizes"
19		return
20	}
21	set largs $args
22	append largs " -dup "
23	recd010_main $method $select $largs
24	append largs " -dupsort "
25	recd010_main $method $select $largs
26}
27
28proc recd010_main { method select largs } {
29	global fixed_len
30	global kvals
31	global kvals_dups
32	source ./include.tcl
33
34
35	set opts [convert_args $method $largs]
36	set method [convert_method $method]
37
38	puts "Recd010 ($opts): Test duplicates across splits and recovery"
39
40	set testfile recd010.db
41	env_cleanup $testdir
42	#
43	# Set pagesize small to generate lots of off-page dups
44	#
45	set page 512
46	set mkeys 1000
47	set firstkeys 5
48	set data "data"
49	set key "recd010_key"
50
51	puts "\tRecd010.a: Create environment and database."
52	set flags "-create -txn -home $testdir"
53
54	set env_cmd "berkdb_env $flags"
55	set dbenv [eval $env_cmd]
56	error_check_good dbenv [is_valid_env $dbenv] TRUE
57
58	set oflags "-env $dbenv -create -mode 0644 $opts $method"
59	set db [eval {berkdb_open} -pagesize $page $oflags $testfile]
60	error_check_good dbopen [is_valid_db $db] TRUE
61
62	# Fill page with small key/data pairs.  Keep at leaf.
63	puts "\tRecd010.b: Fill page with $firstkeys small dups."
64	for { set i 1 } { $i <= $firstkeys } { incr i } {
65		set ret [$db put $key $data$i]
66		error_check_good dbput $ret 0
67	}
68	set kvals 1
69	set kvals_dups $firstkeys
70	error_check_good db_close [$db close] 0
71	error_check_good env_close [$dbenv close] 0
72
73	# List of recovery tests: {CMD MSG} pairs.
74	if { $mkeys < 100 } {
75		puts "Recd010 mkeys of $mkeys too small"
76		return
77	}
78	set rlist {
79	{ {recd010_split DB TXNID 1 2 $mkeys}
80	    "Recd010.c: btree split 2 large dups"}
81	{ {recd010_split DB TXNID 0 2 $mkeys}
82	    "Recd010.d: btree reverse split 2 large dups"}
83	{ {recd010_split DB TXNID 1 10 $mkeys}
84	    "Recd010.e: btree split 10 dups"}
85	{ {recd010_split DB TXNID 0 10 $mkeys}
86	    "Recd010.f: btree reverse split 10 dups"}
87	{ {recd010_split DB TXNID 1 100 $mkeys}
88	    "Recd010.g: btree split 100 dups"}
89	{ {recd010_split DB TXNID 0 100 $mkeys}
90	    "Recd010.h: btree reverse split 100 dups"}
91	}
92
93	foreach pair $rlist {
94		set cmd [subst [lindex $pair 0]]
95		set msg [lindex $pair 1]
96		if { $select != 0 } {
97			set tag [lindex $msg 0]
98			set tail [expr [string length $tag] - 2]
99			set tag [string range $tag $tail $tail]
100			if { [lsearch $select $tag] == -1 } {
101				continue
102			}
103		}
104		set reverse [string first "reverse" $msg]
105		op_recover abort $testdir $env_cmd $testfile $cmd $msg
106		recd010_check $testdir $testfile $opts abort $reverse $firstkeys
107		op_recover commit $testdir $env_cmd $testfile $cmd $msg
108		recd010_check $testdir $testfile $opts commit $reverse $firstkeys
109	}
110	puts "\tRecd010.i: Verify db_printlog can read logfile"
111	set tmpfile $testdir/printlog.out
112	set stat [catch {exec $util_path/db_printlog -h $testdir \
113	    > $tmpfile} ret]
114	error_check_good db_printlog $stat 0
115	fileremove $tmpfile
116}
117
118#
119# This procedure verifies that the database has only numkeys number
120# of keys and that they are in order.
121#
122proc recd010_check { tdir testfile opts op reverse origdups } {
123	global kvals
124	global kvals_dups
125	source ./include.tcl
126
127	set db [eval {berkdb_open} $opts $tdir/$testfile]
128	error_check_good dbopen [is_valid_db $db] TRUE
129
130	set data "data"
131
132	if { $reverse == -1 } {
133		puts "\tRecd010_check: Verify split after $op"
134	} else {
135		puts "\tRecd010_check: Verify reverse split after $op"
136	}
137
138	set stat [$db stat]
139	if { [expr ([string compare $op "abort"] == 0 && $reverse == -1) || \
140		   ([string compare $op "commit"] == 0 && $reverse != -1)]} {
141		set numkeys 0
142		set allkeys [expr $numkeys + 1]
143		set numdups $origdups
144		#
145		# If we abort the adding of dups, or commit
146		# the removal of dups, either way check that
147		# we are back at the beginning.  Check that:
148		# - We have 0 internal pages.
149		# - We have only 1 key (the original we primed the db
150		# with at the beginning of the test).
151		# - We have only the original number of dups we primed
152		# the db with at the beginning of the test.
153		#
154		error_check_good stat:orig0 [is_substr $stat \
155			"{{Internal pages} 0}"] 1
156		error_check_good stat:orig1 [is_substr $stat \
157			"{{Number of keys} 1}"] 1
158		error_check_good stat:orig2 [is_substr $stat \
159			"{{Number of records} $origdups}"] 1
160	} else {
161		set numkeys $kvals
162		set allkeys [expr $numkeys + 1]
163		set numdups $kvals_dups
164		#
165		# If we abort the removal of dups, or commit the
166		# addition of dups, check that:
167		# - We have > 0 internal pages.
168		# - We have the number of keys.
169		#
170		error_check_bad stat:new0 [is_substr $stat \
171			"{{Internal pages} 0}"] 1
172		error_check_good stat:new1 [is_substr $stat \
173			"{{Number of keys} $allkeys}"] 1
174	}
175
176	set dbc [$db cursor]
177	error_check_good dbcursor [is_valid_cursor $dbc $db] TRUE
178	puts "\tRecd010_check: Checking key and duplicate values"
179	set key "recd010_key"
180	#
181	# Check dups are there as they should be.
182	#
183	for {set ki 0} {$ki < $numkeys} {incr ki} {
184		set datacnt 0
185		for {set d [$dbc get -set $key$ki]} { [llength $d] != 0 } {
186		    set d [$dbc get -nextdup]} {
187			set thisdata [lindex [lindex $d 0] 1]
188			if { $datacnt < 10 } {
189				set pdata $data.$ki.00$datacnt
190			} elseif { $datacnt < 100 } {
191				set pdata $data.$ki.0$datacnt
192			} else {
193				set pdata $data.$ki.$datacnt
194			}
195			error_check_good dup_check $thisdata $pdata
196			incr datacnt
197		}
198		error_check_good dup_count $datacnt $numdups
199	}
200	#
201	# Check that the number of expected keys (allkeys) are
202	# all of the ones that exist in the database.
203	#
204	set dupkeys 0
205	set lastkey ""
206	for {set d [$dbc get -first]} { [llength $d] != 0 } {
207	    set d [$dbc get -next]} {
208		set thiskey [lindex [lindex $d 0] 0]
209		if { [string compare $lastkey $thiskey] != 0 } {
210			incr dupkeys
211		}
212		set lastkey $thiskey
213	}
214	error_check_good key_check $allkeys $dupkeys
215	error_check_good curs_close [$dbc close] 0
216	error_check_good db_close [$db close] 0
217}
218
219proc recd010_split { db txn split nkeys mkeys } {
220	global errorCode
221	global kvals
222	global kvals_dups
223	source ./include.tcl
224
225	set data "data"
226	set key "recd010_key"
227
228	set numdups [expr $mkeys / $nkeys]
229
230	set kvals $nkeys
231	set kvals_dups $numdups
232	if { $split == 1 } {
233		puts \
234"\tRecd010_split: Add $nkeys keys, with $numdups duplicates each to force split."
235		for {set k 0} { $k < $nkeys } { incr k } {
236			for {set i 0} { $i < $numdups } { incr i } {
237				if { $i < 10 } {
238					set pdata $data.$k.00$i
239				} elseif { $i < 100 } {
240					set pdata $data.$k.0$i
241				} else {
242					set pdata $data.$k.$i
243				}
244				set ret [$db put -txn $txn $key$k $pdata]
245				error_check_good dbput:more $ret 0
246			}
247		}
248	} else {
249		puts \
250"\tRecd010_split: Delete $nkeys keys to force reverse split."
251		for {set k 0} { $k < $nkeys } { incr k } {
252			error_check_good db_del:$k [$db del -txn $txn $key$k] 0
253		}
254	}
255	return 0
256}
257