1# See the file LICENSE for redistribution information. 2# 3# Copyright (c) 1996,2008 Oracle. All rights reserved. 4# 5# $Id: test001.tcl,v 12.6 2008/01/08 20:58:53 bostic Exp $ 6# 7# TEST test001 8# TEST Small keys/data 9# TEST Put/get per key 10# TEST Dump file 11# TEST Close, reopen 12# TEST Dump file 13# TEST 14# TEST Use the first 10,000 entries from the dictionary. 15# TEST Insert each with self as key and data; retrieve each. 16# TEST After all are entered, retrieve all; compare output to original. 17# TEST Close file, reopen, do retrieve and re-verify. 18proc test001 { method {nentries 10000} \ 19 {start 0} {skip 0} {tnum "001"} args } { 20 source ./include.tcl 21 22 set args [convert_args $method $args] 23 set omethod [convert_method $method] 24 25 # Create the database and open the dictionary 26 set eindex [lsearch -exact $args "-env"] 27 # 28 # If we are using an env, then testfile should just be the db name. 29 # Otherwise it is the test directory and the name. 30 # If we are not using an external env, then test setting 31 # the database cache size and using multiple caches. 32 set txnenv 0 33 if { $eindex == -1 } { 34 set testfile $testdir/test$tnum.db 35 append args " -cachesize {0 1048576 3} " 36 set env NULL 37 } else { 38 set testfile test$tnum.db 39 incr eindex 40 set env [lindex $args $eindex] 41 set txnenv [is_txnenv $env] 42 if { $txnenv == 1 } { 43 append args " -auto_commit " 44 # 45 # If we are using txns and running with the 46 # default, set the default down a bit. 47 # 48 if { $nentries == 10000 } { 49 set nentries 100 50 } 51 } 52 set testdir [get_home $env] 53 } 54 puts "Test$tnum: $method ($args) $nentries equal key/data pairs" 55 set did [open $dict] 56 57 # The "start" variable determines the record number to start 58 # with, if we're using record numbers. The "skip" variable 59 # determines the dictionary entry to start with. 60 # In normal use, skip will match start. 61 62 puts "\tTest$tnum: Starting at $start with dictionary entry $skip" 63 if { $skip != 0 } { 64 for { set count 0 } { $count < $skip } { incr count } { 65 gets $did str 66 } 67 } 68 69 set t1 $testdir/t1 70 set t2 $testdir/t2 71 set t3 $testdir/t3 72 set temp $testdir/temp 73 cleanup $testdir $env 74 75 set db [eval {berkdb_open \ 76 -create -mode 0644} $args $omethod $testfile] 77 error_check_good dbopen [is_valid_db $db] TRUE 78 79 set pflags "" 80 set gflags "" 81 set txn "" 82 83 if { [is_record_based $method] == 1 } { 84 set checkfunc test001_recno.check 85 append gflags " -recno" 86 } else { 87 set checkfunc test001.check 88 } 89 puts "\tTest$tnum.a: put/get loop" 90 # Here is the loop where we put and get each key/data pair 91 set count 0 92 while { [gets $did str] != -1 && $count < $nentries } { 93 if { [is_record_based $method] == 1 } { 94 global kvals 95 96 set key [expr $count + 1 + $start] 97 if { 0xffffffff > 0 && $key > 0xffffffff } { 98 set key [expr $key - 0x100000000] 99 } 100 if { $key == 0 || $key - 0xffffffff == 1 } { 101 incr key 102 incr count 103 } 104 set kvals($key) [pad_data $method $str] 105 } else { 106 set key $str 107 set str [reverse $str] 108 } 109 if { $txnenv == 1 } { 110 set t [$env txn] 111 error_check_good txn [is_valid_txn $t $env] TRUE 112 set txn "-txn $t" 113 } 114 set ret [eval \ 115 {$db put} $txn $pflags {$key [chop_data $method $str]}] 116 error_check_good put $ret 0 117 if { $txnenv == 1 } { 118 error_check_good txn [$t commit] 0 119 if { $count % 50 == 0 } { 120 error_check_good txn_checkpoint($count) \ 121 [$env txn_checkpoint] 0 122 } 123 } 124 125 set ret [eval {$db get} $gflags {$key}] 126 error_check_good \ 127 get $ret [list [list $key [pad_data $method $str]]] 128 129 # Test DB_GET_BOTH for success 130 set ret [$db get -get_both $key [pad_data $method $str]] 131 error_check_good \ 132 getboth $ret [list [list $key [pad_data $method $str]]] 133 134 # Test DB_GET_BOTH for failure 135 set ret [$db get -get_both $key [pad_data $method BAD$str]] 136 error_check_good getbothBAD [llength $ret] 0 137 138 incr count 139 } 140 close $did 141 if { $txnenv == 1 } { 142 set t [$env txn] 143 error_check_good txn [is_valid_txn $t $env] TRUE 144 set txn "-txn $t" 145 } 146 # Now we will get each key from the DB and compare the results 147 # to the original. 148 149 puts "\tTest$tnum.b: dump file" 150 dump_file $db $txn $t1 $checkfunc 151 # 152 # dump_file should just have been "get" calls, so 153 # aborting a get should really be a no-op. Abort 154 # just for the fun of it. 155 if { $txnenv == 1 } { 156 error_check_good txn [$t abort] 0 157 } 158 error_check_good db_close [$db close] 0 159 160 # Now compare the keys to see if they match the dictionary (or ints) 161 if { [is_record_based $method] == 1 } { 162 set oid [open $t2 w] 163 for { set i 1 } { $i <= $nentries } { incr i } { 164 set j [expr $i + $start] 165 if { 0xffffffff > 0 && $j > 0xffffffff } { 166 set j [expr $j - 0x100000000] 167 } 168 if { $j == 0 } { 169 incr i 170 incr j 171 } 172 puts $oid $j 173 } 174 close $oid 175 } else { 176 filehead [expr $nentries + $start] $dict $t2 [expr $start + 1] 177 } 178 filesort $t2 $temp 179 file rename -force $temp $t2 180 filesort $t1 $t3 181 182 error_check_good Test$tnum:diff($t3,$t2) \ 183 [filecmp $t3 $t2] 0 184 185 puts "\tTest$tnum.c: close, open, and dump file" 186 # Now, reopen the file and run the last test again. 187 open_and_dump_file $testfile $env $t1 $checkfunc \ 188 dump_file_direction "-first" "-next" 189 if { [string compare $omethod "-recno"] != 0 } { 190 filesort $t1 $t3 191 } 192 193 error_check_good Test$tnum:diff($t2,$t3) \ 194 [filecmp $t2 $t3] 0 195 196 # Now, reopen the file and run the last test again in the 197 # reverse direction. 198 puts "\tTest$tnum.d: close, open, and dump file in reverse direction" 199 open_and_dump_file $testfile $env $t1 $checkfunc \ 200 dump_file_direction "-last" "-prev" 201 202 if { [string compare $omethod "-recno"] != 0 } { 203 filesort $t1 $t3 204 } 205 206 error_check_good Test$tnum:diff($t3,$t2) \ 207 [filecmp $t3 $t2] 0 208} 209 210# Check function for test001; keys and data are identical 211proc test001.check { key data } { 212 error_check_good "key/data mismatch" $data [reverse $key] 213} 214 215proc test001_recno.check { key data } { 216 global dict 217 global kvals 218 219 error_check_good key"$key"_exists [info exists kvals($key)] 1 220 error_check_good "key/data mismatch, key $key" $data $kvals($key) 221} 222