1# See the file LICENSE for redistribution information. 2# 3# Copyright (c) 1996-2009 Oracle. All rights reserved. 4# 5# $Id$ 6# 7# TEST test013 8# TEST Partial put test 9# TEST Overwrite entire records using partial puts. 10# TEST Make sure that NOOVERWRITE flag works. 11# TEST 12# TEST 1. Insert 10000 keys and retrieve them (equal key/data pairs). 13# TEST 2. Attempt to overwrite keys with NO_OVERWRITE set (expect error). 14# TEST 3. Actually overwrite each one with its datum reversed. 15# TEST 16# TEST No partial testing here. 17proc test013 { method {nentries 10000} args } { 18 global errorCode 19 global errorInfo 20 global fixed_len 21 22 source ./include.tcl 23 24 set args [convert_args $method $args] 25 set omethod [convert_method $method] 26 27 # Create the database and open the dictionary 28 set txnenv 0 29 set eindex [lsearch -exact $args "-env"] 30 # 31 # If we are using an env, then testfile should just be the db name. 32 # Otherwise it is the test directory and the name. 33 if { $eindex == -1 } { 34 set testfile $testdir/test013.db 35 set env NULL 36 } else { 37 set testfile test013.db 38 incr eindex 39 set env [lindex $args $eindex] 40 set txnenv [is_txnenv $env] 41 if { $txnenv == 1 } { 42 append args " -auto_commit " 43 # 44 # If we are using txns and running with the 45 # default, set the default down a bit. 46 # 47 if { $nentries == 10000 } { 48 set nentries 100 49 } 50 } 51 set testdir [get_home $env] 52 } 53 puts "Test013: $method ($args) $nentries equal key/data pairs, put test" 54 55 set t1 $testdir/t1 56 set t2 $testdir/t2 57 set t3 $testdir/t3 58 cleanup $testdir $env 59 60 set db [eval {berkdb_open \ 61 -create -mode 0644} $args {$omethod $testfile}] 62 error_check_good dbopen [is_valid_db $db] TRUE 63 64 set did [open $dict] 65 66 set pflags "" 67 set gflags "" 68 set txn "" 69 set count 0 70 71 if { [is_record_based $method] == 1 } { 72 set checkfunc test013_recno.check 73 append gflags " -recno" 74 global kvals 75 } else { 76 set checkfunc test013.check 77 } 78 puts "\tTest013.a: put/get loop" 79 # Here is the loop where we put and get each key/data pair 80 while { [gets $did str] != -1 && $count < $nentries } { 81 if { [is_record_based $method] == 1 } { 82 set key [expr $count + 1] 83 set kvals($key) [pad_data $method $str] 84 } else { 85 set key $str 86 } 87 if { $txnenv == 1 } { 88 set t [$env txn] 89 error_check_good txn [is_valid_txn $t $env] TRUE 90 set txn "-txn $t" 91 } 92 set ret [eval {$db put} \ 93 $txn $pflags {$key [chop_data $method $str]}] 94 error_check_good put $ret 0 95 96 set ret [eval {$db get} $gflags $txn {$key}] 97 error_check_good \ 98 get $ret [list [list $key [pad_data $method $str]]] 99 if { $txnenv == 1 } { 100 error_check_good txn [$t commit] 0 101 } 102 incr count 103 } 104 close $did 105 106 # Now we will try to overwrite each datum, but set the 107 # NOOVERWRITE flag. 108 puts "\tTest013.b: overwrite values with NOOVERWRITE flag." 109 set did [open $dict] 110 set count 0 111 while { [gets $did str] != -1 && $count < $nentries } { 112 if { [is_record_based $method] == 1 } { 113 set key [expr $count + 1] 114 } else { 115 set key $str 116 } 117 118 if { $txnenv == 1 } { 119 set t [$env txn] 120 error_check_good txn [is_valid_txn $t $env] TRUE 121 set txn "-txn $t" 122 } 123 set ret [eval {$db put} $txn $pflags \ 124 {-nooverwrite $key [chop_data $method $str]}] 125 error_check_good put [is_substr $ret "DB_KEYEXIST"] 1 126 127 # Value should be unchanged. 128 set ret [eval {$db get} $txn $gflags {$key}] 129 error_check_good \ 130 get $ret [list [list $key [pad_data $method $str]]] 131 if { $txnenv == 1 } { 132 error_check_good txn [$t commit] 0 133 } 134 incr count 135 } 136 close $did 137 138 # Now we will replace each item with its datum capitalized. 139 puts "\tTest013.c: overwrite values with capitalized datum" 140 set did [open $dict] 141 set count 0 142 while { [gets $did str] != -1 && $count < $nentries } { 143 if { [is_record_based $method] == 1 } { 144 set key [expr $count + 1] 145 } else { 146 set key $str 147 } 148 set rstr [string toupper $str] 149 if { $txnenv == 1 } { 150 set t [$env txn] 151 error_check_good txn [is_valid_txn $t $env] TRUE 152 set txn "-txn $t" 153 } 154 set r [eval {$db put} \ 155 $txn $pflags {$key [chop_data $method $rstr]}] 156 error_check_good put $r 0 157 158 # Value should be changed. 159 set ret [eval {$db get} $txn $gflags {$key}] 160 error_check_good \ 161 get $ret [list [list $key [pad_data $method $rstr]]] 162 if { $txnenv == 1 } { 163 error_check_good txn [$t commit] 0 164 } 165 incr count 166 } 167 close $did 168 169 # Now make sure that everything looks OK 170 puts "\tTest013.d: check entire file contents" 171 if { $txnenv == 1 } { 172 set t [$env txn] 173 error_check_good txn [is_valid_txn $t $env] TRUE 174 set txn "-txn $t" 175 } 176 dump_file $db $txn $t1 $checkfunc 177 if { $txnenv == 1 } { 178 error_check_good txn [$t commit] 0 179 } 180 error_check_good db_close [$db close] 0 181 182 # Now compare the keys to see if they match the dictionary (or ints) 183 if { [is_record_based $method] == 1 } { 184 set oid [open $t2 w] 185 for {set i 1} {$i <= $nentries} {incr i} { 186 puts $oid $i 187 } 188 close $oid 189 file rename -force $t1 $t3 190 } else { 191 set q q 192 filehead $nentries $dict $t3 193 filesort $t3 $t2 194 filesort $t1 $t3 195 } 196 197 error_check_good \ 198 Test013:diff($t3,$t2) [filecmp $t3 $t2] 0 199 200 puts "\tTest013.e: close, open, and dump file" 201 # Now, reopen the file and run the last test again. 202 eval open_and_dump_file $testfile $env $t1 $checkfunc \ 203 dump_file_direction "-first" "-next" $args 204 205 if { [is_record_based $method] == 0 } { 206 filesort $t1 $t3 207 } 208 209 error_check_good \ 210 Test013:diff($t3,$t2) [filecmp $t3 $t2] 0 211 212 # Now, reopen the file and run the last test again in the 213 # reverse direction. 214 puts "\tTest013.f: close, open, and dump file in reverse direction" 215 eval open_and_dump_file $testfile $env $t1 $checkfunc \ 216 dump_file_direction "-last" "-prev" $args 217 218 if { [is_record_based $method] == 0 } { 219 filesort $t1 $t3 220 } 221 222 error_check_good \ 223 Test013:diff($t3,$t2) [filecmp $t3 $t2] 0 224} 225 226# Check function for test013; keys and data are identical 227proc test013.check { key data } { 228 error_check_good \ 229 "key/data mismatch for $key" $data [string toupper $key] 230} 231 232proc test013_recno.check { key data } { 233 global dict 234 global kvals 235 236 error_check_good key"$key"_exists [info exists kvals($key)] 1 237 error_check_good \ 238 "data mismatch for $key" $data [string toupper $kvals($key)] 239} 240