1# See the file LICENSE for redistribution information.
2#
3# Copyright (c) 2005,2008 Oracle.  All rights reserved.
4#
5# $Id: test117.tcl,v 12.10 2008/01/08 20:58:53 bostic Exp $
6#
7# TEST	test117
8# TEST	Test database compaction with requested fill percent.
9# TEST
10# TEST	Populate a database.  Remove a high proportion of entries.
11# TEST	Dump and save contents.  Compact the database, requesting
12# TEST	fill percentages starting at 10% and working our way up to
13# TEST	100.  On each cycle, make sure we still have the same contents.
14# TEST
15# TEST	Unlike the other compaction tests, this one does not
16# TEST	use -freespace.
17
18proc test117 { method {nentries 10000} {tnum "117"} args } {
19	source ./include.tcl
20
21	# Compaction is an option for btree and recno databases only.
22	if { [is_hash $method] == 1 || [is_queue $method] == 1 } {
23		puts "Skipping test$tnum for method $method."
24		return
25	}
26
27	set args [convert_args $method $args]
28	set omethod [convert_method $method]
29
30	# If we are using an env, then testfile should just be the db name.
31	# Otherwise it is the test directory and the name.
32	set txnenv 0
33	set eindex [lsearch -exact $args "-env"]
34	if { $eindex == -1 } {
35		set basename $testdir/test$tnum
36		set env NULL
37	} else {
38		set basename test$tnum
39		incr eindex
40		set env [lindex $args $eindex]
41		set rpcenv [is_rpcenv $env]
42		if { $rpcenv == 1 } {
43			puts "Test$tnum: skipping for RPC"
44			return
45		}
46		set txnenv [is_txnenv $env]
47		if { $txnenv == 1 } {
48			append args " -auto_commit "
49		}
50		set testdir [get_home $env]
51	}
52	puts "Test$tnum: ($method $args) Database compaction and fillpercent."
53	set t1 $testdir/t1
54	set t2 $testdir/t2
55	set splitopts { "" "-revsplitoff" }
56	set txn ""
57
58	if { [is_record_based $method] == 1 } {
59		set checkfunc test001_recno.check
60	} else {
61		set checkfunc test001.check
62	}
63
64	foreach splitopt $splitopts {
65		set testfile $basename.db
66		if { $splitopt == "-revsplitoff" } {
67			set testfile $basename.rev.db
68	 		if { [is_record_based $method] == 1 } {
69				puts "Skipping\
70				    -revsplitoff option for method $method."
71				continue
72			}
73		}
74		set did [open $dict]
75		if { $env != "NULL" } {
76			set testdir [get_home $env]
77		}
78		cleanup $testdir $env
79
80		puts "\tTest$tnum.a: Create and populate database ($splitopt)."
81		set db [eval {berkdb_open -create \
82		    -mode 0644} $splitopt $args $omethod $testfile]
83		error_check_good dbopen [is_valid_db $db] TRUE
84
85		set count 0
86		if { $txnenv == 1 } {
87			set t [$env txn]
88			error_check_good txn [is_valid_txn $t $env] TRUE
89			set txn "-txn $t"
90		}
91		while { [gets $did str] != -1 && $count < $nentries } {
92			global kvals
93
94			if { [is_record_based $method] == 1 } {
95				set key [expr $count + 1]
96				set kvals($key) [pad_data $method $str]
97			} else {
98				set key $str
99				set str [reverse $str]
100			}
101
102			set ret [eval \
103			    {$db put} $txn {$key [chop_data $method $str]}]
104			error_check_good put $ret 0
105			incr count
106
107		}
108		if { $txnenv == 1 } {
109			error_check_good txn_commit [$t commit] 0
110		}
111		close $did
112		error_check_good db_sync [$db sync] 0
113
114		if { $env != "NULL" } {
115			set testdir [get_home $env]
116			set filename $testdir/$testfile
117		} else {
118			set filename $testfile
119		}
120		set size1 [file size $filename]
121		set free1 [stat_field $db stat "Pages on freelist"]
122
123		puts "\tTest$tnum.b: Delete most entries from database."
124		set did [open $dict]
125		set count [expr $nentries - 1]
126		set n 17
127
128		# Leave every nth item.  Since rrecno renumbers, we
129		# delete starting at nentries and working down to 0.
130		if { $txnenv == 1 } {
131			set t [$env txn]
132			error_check_good txn [is_valid_txn $t $env] TRUE
133			set txn "-txn $t"
134		}
135		while { [gets $did str] != -1 && $count > 0 } {
136			if { [is_record_based $method] == 1 } {
137				set key [expr $count + 1]
138			} else {
139				set key $str
140			}
141
142			if { [expr $count % $n] != 0 } {
143				set ret [eval {$db del} $txn {$key}]
144				error_check_good del $ret 0
145			}
146			incr count -1
147		}
148		if { $txnenv == 1 } {
149			error_check_good t_commit [$t commit] 0
150		}
151		error_check_good db_sync [$db sync] 0
152
153		puts "\tTest$tnum.c: Do a dump_file on contents."
154		if { $txnenv == 1 } {
155			set t [$env txn]
156			error_check_good txn [is_valid_txn $t $env] TRUE
157			set txn "-txn $t"
158		}
159		dump_file $db $txn $t1
160		if { $txnenv == 1 } {
161			error_check_good txn_commit [$t commit] 0
162		}
163
164		# Start by compacting pages filled less than 10% and
165		# work up to 100%.
166		for { set fillpercent 10 } { $fillpercent <= 100 }\
167		    { incr fillpercent 10 } {
168
169			puts "\tTest$tnum.d: Compact and verify database\
170			    with fillpercent $fillpercent."
171			set ret [$db compact -fillpercent $fillpercent]
172			error_check_good db_sync [$db sync] 0
173			set size2 [file size $filename]
174			error_check_good verify_dir [verify_dir $testdir] 0
175			set free2 [stat_field $db stat "Pages on freelist"]
176
177			# The number of free pages should never decline.
178			error_check_good pages_freed [expr $free2 >= $free1] 1
179			error_check_good file_size [expr $size2 <= $size1] 1
180
181			puts "\tTest$tnum.e:\
182			    Contents are the same after compaction."
183			if { $txnenv == 1 } {
184				set t [$env txn]
185				error_check_good txn [is_valid_txn $t $env] TRUE
186				set txn "-txn $t"
187			}
188			dump_file $db $txn $t2
189			if { $txnenv == 1 } {
190				error_check_good txn_commit [$t commit] 0
191			}
192			error_check_good filecmp [filecmp $t1 $t2] 0
193			set free1 $free2
194			set size1 $size2
195		}
196		error_check_good db_close [$db close] 0
197		close $did
198	}
199}
200