1# See the file LICENSE for redistribution information. 2# 3# Copyright (c) 1996,2008 Oracle. All rights reserved. 4# 5# $Id: test016.tcl,v 12.6 2008/01/08 20:58:53 bostic Exp $ 6# 7# TEST test016 8# TEST Partial put test 9# TEST Partial put where the datum gets shorter as a result of the put. 10# TEST 11# TEST Partial put test where partial puts make the record smaller. 12# TEST Use the first 10,000 entries from the dictionary. 13# TEST Insert each with self as key and a fixed, medium length data string; 14# TEST retrieve each. After all are entered, go back and do partial puts, 15# TEST replacing a random-length string with the key value. 16# TEST Then verify. 17 18proc test016 { method {nentries 10000} args } { 19 global datastr 20 global dvals 21 global rand_init 22 source ./include.tcl 23 24 berkdb srand $rand_init 25 26 set args [convert_args $method $args] 27 set omethod [convert_method $method] 28 29 if { [is_fixed_length $method] == 1 } { 30 puts "Test016: skipping for method $method" 31 return 32 } 33 34 # Create the database and open the dictionary 35 set txnenv 0 36 set eindex [lsearch -exact $args "-env"] 37 # 38 # If we are using an env, then testfile should just be the db name. 39 # Otherwise it is the test directory and the name. 40 if { $eindex == -1 } { 41 set testfile $testdir/test016.db 42 set env NULL 43 } else { 44 set testfile test016.db 45 incr eindex 46 set env [lindex $args $eindex] 47 set txnenv [is_txnenv $env] 48 if { $txnenv == 1 } { 49 append args " -auto_commit " 50 # 51 # If we are using txns and running with the 52 # default, set the default down a bit. 53 # 54 if { $nentries == 10000 } { 55 set nentries 100 56 } 57 } 58 set testdir [get_home $env] 59 } 60 puts "Test016: $method ($args) $nentries partial put shorten" 61 62 set t1 $testdir/t1 63 set t2 $testdir/t2 64 set t3 $testdir/t3 65 cleanup $testdir $env 66 set db [eval {berkdb_open \ 67 -create -mode 0644} $args {$omethod $testfile}] 68 error_check_good dbopen [is_valid_db $db] TRUE 69 70 set pflags "" 71 set gflags "" 72 set txn "" 73 set count 0 74 75 if { [is_record_based $method] == 1 } { 76 append gflags " -recno" 77 } 78 79 # Here is the loop where we put and get each key/data pair 80 puts "\tTest016.a: put/get loop" 81 set did [open $dict] 82 while { [gets $did str] != -1 && $count < $nentries } { 83 if { [is_record_based $method] == 1 } { 84 set key [expr $count + 1] 85 } else { 86 set key $str 87 } 88 if { $txnenv == 1 } { 89 set t [$env txn] 90 error_check_good txn [is_valid_txn $t $env] TRUE 91 set txn "-txn $t" 92 } 93 set ret [eval {$db put} \ 94 $txn $pflags {$key [chop_data $method $datastr]}] 95 error_check_good put $ret 0 96 97 set ret [eval {$db get} $txn $gflags {$key}] 98 error_check_good \ 99 get $ret [list [list $key [pad_data $method $datastr]]] 100 if { $txnenv == 1 } { 101 error_check_good txn [$t commit] 0 102 } 103 incr count 104 } 105 close $did 106 107 # Next we will do a partial put replacement, making the data 108 # shorter 109 puts "\tTest016.b: partial put loop" 110 set did [open $dict] 111 set count 0 112 set len [string length $datastr] 113 while { [gets $did str] != -1 && $count < $nentries } { 114 if { [is_record_based $method] == 1 } { 115 set key [expr $count + 1] 116 } else { 117 set key $str 118 } 119 120 set repl_len [berkdb random_int [string length $key] $len] 121 set repl_off [berkdb random_int 0 [expr $len - $repl_len] ] 122 set s1 [string range $datastr 0 [ expr $repl_off - 1] ] 123 set s2 [string toupper $key] 124 set s3 [string range $datastr [expr $repl_off + $repl_len] end ] 125 set dvals($key) [pad_data $method $s1$s2$s3] 126 if { $txnenv == 1 } { 127 set t [$env txn] 128 error_check_good txn [is_valid_txn $t $env] TRUE 129 set txn "-txn $t" 130 } 131 set ret [eval {$db put} $txn {-partial \ 132 [list $repl_off $repl_len] $key [chop_data $method $s2]}] 133 error_check_good put $ret 0 134 set ret [eval {$db get} $txn $gflags {$key}] 135 error_check_good \ 136 put $ret [list [list $key [pad_data $method $s1$s2$s3]]] 137 if { $txnenv == 1 } { 138 error_check_good txn [$t commit] 0 139 } 140 incr count 141 } 142 close $did 143 144 # Now we will get each key from the DB and compare the results 145 # to the original. 146 puts "\tTest016.c: dump file" 147 if { $txnenv == 1 } { 148 set t [$env txn] 149 error_check_good txn [is_valid_txn $t $env] TRUE 150 set txn "-txn $t" 151 } 152 dump_file $db $txn $t1 test016.check 153 if { $txnenv == 1 } { 154 error_check_good txn [$t commit] 0 155 } 156 error_check_good db_close [$db close] 0 157 158 # Now compare the keys to see if they match the dictionary 159 if { [is_record_based $method] == 1 } { 160 set oid [open $t2 w] 161 for {set i 1} {$i <= $nentries} {set i [incr i]} { 162 puts $oid $i 163 } 164 close $oid 165 file rename -force $t1 $t3 166 } else { 167 set q q 168 filehead $nentries $dict $t3 169 filesort $t3 $t2 170 filesort $t1 $t3 171 } 172 173 error_check_good Test016:diff($t3,$t2) \ 174 [filecmp $t3 $t2] 0 175 176 # Now, reopen the file and run the last test again. 177 puts "\tTest016.d: close, open, and dump file" 178 open_and_dump_file $testfile $env $t1 test016.check \ 179 dump_file_direction "-first" "-next" 180 181 if { [ is_record_based $method ] == 0 } { 182 filesort $t1 $t3 183 } 184 error_check_good Test016:diff($t3,$t2) \ 185 [filecmp $t3 $t2] 0 186 187 # Now, reopen the file and run the last test again in reverse direction. 188 puts "\tTest016.e: close, open, and dump file in reverse direction" 189 open_and_dump_file $testfile $env $t1 test016.check \ 190 dump_file_direction "-last" "-prev" 191 192 if { [ is_record_based $method ] == 0 } { 193 filesort $t1 $t3 194 } 195 error_check_good Test016:diff($t3,$t2) \ 196 [filecmp $t3 $t2] 0 197} 198 199# Check function for test016; data should be whatever is set in dvals 200proc test016.check { key data } { 201 global datastr 202 global dvals 203 204 error_check_good key"$key"_exists [info exists dvals($key)] 1 205 error_check_good "data mismatch for key $key" $data $dvals($key) 206} 207