1# See the file LICENSE for redistribution information.
2#
3# Copyright (c) 2005,2008 Oracle.  All rights reserved.
4#
5# $Id: test111.tcl,v 1.17 2008/01/08 20:58:53 bostic Exp $
6#
7# TEST	test111
8# TEST	Test database compaction.
9# TEST
10# TEST	Populate a database.  Remove a high proportion of entries.
11# TEST	Dump and save contents.  Compact the database, dump again,
12# TEST	and make sure we still have the same contents.
13# TEST  Add back some entries, delete more entries (this time by
14# TEST	cursor), dump, compact, and do the before/after check again.
15
16proc test111 { method {nentries 10000} {tnum "111"} args } {
17
18	# Compaction is an option for btree and recno databases only.
19	if { [is_hash $method] == 1 || [is_queue $method] == 1 } {
20		puts "Skipping test$tnum for method $method."
21		return
22	}
23
24	# If a page size was specified, find out what it is.  Pages
25	# might not be freed in the case of really large pages (64K)
26	# but we still want to run this test just to make sure
27	# nothing funny happens.
28	set pagesize 0
29        set pgindex [lsearch -exact $args "-pagesize"]
30        if { $pgindex != -1 } {
31                incr pgindex
32		set pagesize [lindex $args $pgindex]
33        }
34
35	source ./include.tcl
36	global rand_init
37	error_check_good set_random_seed [berkdb srand $rand_init] 0
38	set args [convert_args $method $args]
39	set omethod [convert_method $method]
40
41	# If we are using an env, then testfile should just be the db name.
42	# Otherwise it is the test directory and the name.
43	set txnenv 0
44	set eindex [lsearch -exact $args "-env"]
45	if { $eindex == -1 } {
46		set basename $testdir/test$tnum
47		set env NULL
48	} else {
49		set basename test$tnum
50		incr eindex
51		set env [lindex $args $eindex]
52		set rpcenv [is_rpcenv $env]
53		if { $rpcenv == 1 } {
54			puts "Test$tnum: skipping for RPC"
55			return
56		}
57		set txnenv [is_txnenv $env]
58		if { $txnenv == 1 } {
59			append args " -auto_commit "
60		}
61		set testdir [get_home $env]
62	}
63	puts "Test$tnum: ($method $args) Database compaction."
64	set t1 $testdir/t1
65	set t2 $testdir/t2
66	set splitopts { "" "-revsplitoff" }
67	set txn ""
68
69	if { [is_record_based $method] == 1 } {
70		set checkfunc test001_recno.check
71	} else {
72		set checkfunc test001.check
73	}
74
75	foreach splitopt $splitopts {
76		set testfile $basename.db
77		if { $splitopt == "-revsplitoff" } {
78			set testfile $basename.rev.db
79	 		if { [is_record_based $method] == 1 } {
80				puts "Skipping\
81				    -revsplitoff option for method $method."
82				continue
83			}
84		}
85		set did [open $dict]
86		if { $env != "NULL" } {
87			set testdir [get_home $env]
88		}
89		cleanup $testdir $env
90
91		puts "\tTest$tnum.a: Create and populate database ($splitopt)."
92		set db [eval {berkdb_open -create \
93		    -mode 0644} $splitopt $args $omethod $testfile]
94		error_check_good dbopen [is_valid_db $db] TRUE
95
96		set count 0
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		while { [gets $did str] != -1 && $count < $nentries } {
103			global kvals
104
105			if { [is_record_based $method] == 1 } {
106				set key [expr $count + 1]
107				set kvals($key) [pad_data $method $str]
108			} else {
109				set key $str
110				set str [reverse $str]
111			}
112
113			set ret [eval \
114			    {$db put} $txn {$key [chop_data $method $str]}]
115			error_check_good put $ret 0
116			incr count
117
118		}
119		if { $txnenv == 1 } {
120			error_check_good txn_commit [$t commit] 0
121		}
122		close $did
123		error_check_good db_sync [$db sync] 0
124
125		if { $env != "NULL" } {
126			set testdir [get_home $env]
127			set filename $testdir/$testfile
128		} else {
129			set filename $testfile
130		}
131		set size1 [file size $filename]
132		set free1 [stat_field $db stat "Pages on freelist"]
133		set leaf1 [stat_field $db stat "Leaf pages"]
134		set internal1 [stat_field $db stat "Internal pages"]
135
136		# Delete between 1 and maxdelete items, then skip over between
137		# 1 and maxskip items.  This is to make the data bunchy,
138		# so we sometimes follow the code path where merging is
139		# done record by record, and sometimes the path where
140		# the whole page is merged at once.
141
142		puts "\tTest$tnum.b: Delete most entries from database."
143		set did [open $dict]
144		set count [expr $nentries - 1]
145		set maxskip 4
146		set maxdelete 48
147
148		# Since rrecno and rbtree renumber, we delete starting at
149		# nentries and working down to 0.
150		if { $txnenv == 1 } {
151			set t [$env txn]
152			error_check_good txn [is_valid_txn $t $env] TRUE
153			set txn "-txn $t"
154		}
155		while { [gets $did str] != -1 && $count > 0 } {
156
157			# Delete a random number of successive items.
158			set ndeletes [berkdb random_int 1 $maxdelete]
159			set target [expr $count - $ndeletes]
160			while { [expr $count > $target] && $count > 0 } {
161				if { [is_record_based $method] == 1 } {
162					set key [expr $count + 1]
163				} else {
164					set key [gets $did]
165				}
166
167				set ret [eval {$db del} $txn {$key}]
168				error_check_good del $ret 0
169				incr count -1
170			}
171			# Skip over a random smaller number of items.
172			set skip [berkdb random_int 1 [expr $maxskip]]
173			set target [expr $count - $skip]
174			while { [expr $count > $target] && $count > 0 } {
175				incr count -1
176			}
177		}
178		if { $txnenv == 1 } {
179			error_check_good t_commit [$t commit] 0
180		}
181		error_check_good db_sync [$db sync] 0
182
183		puts "\tTest$tnum.c: Do a dump_file on contents."
184		if { $txnenv == 1 } {
185			set t [$env txn]
186			error_check_good txn [is_valid_txn $t $env] TRUE
187			set txn "-txn $t"
188		}
189		dump_file $db $txn $t1
190		if { $txnenv == 1 } {
191			error_check_good txn_commit [$t commit] 0
192		}
193
194		puts "\tTest$tnum.d: Compact and verify database."
195		set ret [$db compact -freespace]
196		error_check_good db_sync [$db sync] 0
197		error_check_good verify_dir [verify_dir $testdir] 0
198
199		set size2 [file size $filename]
200		set free2 [stat_field $db stat "Pages on freelist"]
201		set leaf2 [stat_field $db stat "Leaf pages"]
202		set internal2 [stat_field $db stat "Internal pages"]
203
204		# The sum of internal pages, leaf pages, and pages freed
205		# should decrease on compaction, indicating that pages
206		# have been freed to the file system.
207		set sum1 [expr $free1 + $leaf1 + $internal1]
208		set sum2 [expr $free2 + $leaf2 + $internal2]
209		error_check_good pages_freed [expr $sum1 > $sum2] 1
210
211		# The on-disk file size should be smaller.
212		set reduction .96
213		error_check_good \
214		    file_size [expr [expr $size1 * $reduction] > $size2] 1
215
216		puts "\tTest$tnum.e: Contents are the same after compaction."
217		if { $txnenv == 1 } {
218			set t [$env txn]
219			error_check_good txn [is_valid_txn $t $env] TRUE
220			set txn "-txn $t"
221		}
222		dump_file $db $txn $t2
223		if { $txnenv == 1 } {
224			error_check_good txn_commit [$t commit] 0
225		}
226
227		error_check_good filecmp [filecmp $t1 $t2] 0
228
229		puts "\tTest$tnum.f: Add more entries to database."
230		# Use integers as keys instead of strings, just to mix it up
231		# a little.
232		if { $txnenv == 1 } {
233			set t [$env txn]
234			error_check_good txn [is_valid_txn $t $env] TRUE
235			set txn "-txn $t"
236		}
237		for { set i 1 } { $i < $nentries } { incr i } {
238			set key $i
239			set str $i
240			set ret [eval \
241			    {$db put} $txn {$key [chop_data $method $str]}]
242			error_check_good put $ret 0
243		}
244		if { $txnenv == 1 } {
245			error_check_good t_commit [$t commit] 0
246		}
247		error_check_good db_sync [$db sync] 0
248
249		set size3 [file size $filename]
250		set free3 [stat_field $db stat "Pages on freelist"]
251		set leaf3 [stat_field $db stat "Leaf pages"]
252		set internal3 [stat_field $db stat "Internal pages"]
253
254		puts "\tTest$tnum.g: Remove more entries, this time by cursor."
255		set count 0
256		if { $txnenv == 1 } {
257			set t [$env txn]
258			error_check_good txn [is_valid_txn $t $env] TRUE
259			set txn "-txn $t"
260		}
261		set dbc [eval {$db cursor} $txn]
262
263		# Delete all items except those evenly divisible by
264		# $maxdelete -- so the db is nearly empty.
265		for { set dbt [$dbc get -first] } { [llength $dbt] > 0 }\
266		    { set dbt [$dbc get -next] ; incr count } {
267			if { [expr $count % $maxdelete] != 0 } {
268				error_check_good dbc_del [$dbc del] 0
269			}
270		}
271
272		error_check_good cursor_close [$dbc close] 0
273		if { $txnenv == 1 } {
274			error_check_good t_commit [$t commit] 0
275		}
276		error_check_good db_sync [$db sync] 0
277
278		puts "\tTest$tnum.h: Save contents."
279		if { $txnenv == 1 } {
280			set t [$env txn]
281			error_check_good txn [is_valid_txn $t $env] TRUE
282			set txn "-txn $t"
283		}
284		dump_file $db $txn $t1
285		if { $txnenv == 1 } {
286			error_check_good t_commit [$t commit] 0
287		}
288
289		puts "\tTest$tnum.i: Compact and verify database again."
290		set ret [$db compact -freespace]
291		error_check_good db_sync [$db sync] 0
292		error_check_good verify_dir [verify_dir $testdir] 0
293
294		set size4 [file size $filename]
295		set free4 [stat_field $db stat "Pages on freelist"]
296		set leaf4 [stat_field $db stat "Leaf pages"]
297		set internal4 [stat_field $db stat "Internal pages"]
298
299		# The sum of internal pages, leaf pages, and pages freed
300		# should decrease on compaction, indicating that pages
301		# have been freed to the file system.
302		set sum3 [expr $free3 + $leaf3 + $internal3]
303		set sum4 [expr $free4 + $leaf4 + $internal4]
304		error_check_good pages_freed [expr $sum3 > $sum4] 1
305
306		# File should be smaller as well.
307		error_check_good \
308		    file_size [expr [expr $size3 * $reduction] > $size4] 1
309
310		puts "\tTest$tnum.j: Contents are the same after compaction."
311		if { $txnenv == 1 } {
312			set t [$env txn]
313			error_check_good txn [is_valid_txn $t $env] TRUE
314			set txn "-txn $t"
315		}
316		dump_file $db $txn $t2
317		if { $txnenv == 1 } {
318			error_check_good t_commit [$t commit] 0
319		}
320		error_check_good filecmp [filecmp $t1 $t2] 0
321
322		error_check_good db_close [$db close] 0
323		close $did
324	}
325}
326