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