1# See the file LICENSE for redistribution information. 2# 3# Copyright (c) 1999,2008 Oracle. All rights reserved. 4# 5# $Id: sdb002.tcl,v 12.6 2008/01/08 20:58:53 bostic Exp $ 6# 7# TEST sdb002 8# TEST Tests basic subdb functionality 9# TEST Small keys, small data 10# TEST Put/get per key 11# TEST Dump file 12# TEST Close, reopen 13# TEST Dump file 14# TEST 15# TEST Use the first 10,000 entries from the dictionary. 16# TEST Insert each with self as key and data; retrieve each. 17# TEST After all are entered, retrieve all; compare output to original. 18# TEST Close file, reopen, do retrieve and re-verify. 19# TEST Then repeat using an environment. 20proc sdb002 { method {nentries 10000} args } { 21 global passwd 22 global has_crypto 23 24 set eindex [lsearch -exact $args "-env"] 25 if { $eindex != -1 } { 26 set env NULL 27 incr eindex 28 set env [lindex $args $eindex] 29 puts "Subdb002 skipping for env $env" 30 return 31 } 32 set largs $args 33 subdb002_main $method $nentries $largs 34 append largs " -chksum " 35 subdb002_main $method $nentries $largs 36 37 # Skip remainder of test if release does not support encryption. 38 if { $has_crypto == 0 } { 39 return 40 } 41 42 append largs "-encryptaes $passwd " 43 subdb002_main $method $nentries $largs 44} 45 46proc subdb002_main { method nentries largs } { 47 source ./include.tcl 48 global encrypt 49 50 set largs [convert_args $method $largs] 51 set omethod [convert_method $method] 52 53 env_cleanup $testdir 54 55 puts "Subdb002: $method ($largs) basic subdb tests" 56 set testfile $testdir/subdb002.db 57 subdb002_body $method $omethod $nentries $largs $testfile NULL 58 59 # Run convert_encrypt so that old_encrypt will be reset to 60 # the proper value and cleanup will work. 61 convert_encrypt $largs 62 set encargs "" 63 set largs [split_encargs $largs encargs] 64 65 cleanup $testdir NULL 66 if { [is_queue $omethod] == 1 } { 67 set sdb002_env berkdb_env_noerr 68 } else { 69 set sdb002_env berkdb_env 70 } 71 set env [eval {$sdb002_env -create -cachesize {0 10000000 0} \ 72 -mode 0644} -home $testdir $encargs] 73 error_check_good env_open [is_valid_env $env] TRUE 74 puts "Subdb002: $method ($largs) basic subdb tests in an environment" 75 76 # We're in an env--use default path to database rather than specifying 77 # it explicitly. 78 set testfile subdb002.db 79 subdb002_body $method $omethod $nentries $largs $testfile $env 80 error_check_good env_close [$env close] 0 81} 82 83proc subdb002_body { method omethod nentries largs testfile env } { 84 global encrypt 85 global passwd 86 source ./include.tcl 87 88 # Create the database and open the dictionary 89 set subdb subdb0 90 set t1 $testdir/t1 91 set t2 $testdir/t2 92 set t3 $testdir/t3 93 94 if { [is_queue $omethod] == 1 } { 95 set sdb002_open berkdb_open_noerr 96 } else { 97 set sdb002_open berkdb_open 98 } 99 100 if { $env == "NULL" } { 101 set ret [catch {eval {$sdb002_open -create -mode 0644} $largs \ 102 {$omethod $testfile $subdb}} db] 103 } else { 104 set ret [catch {eval {$sdb002_open -create -mode 0644} $largs \ 105 {-env $env $omethod $testfile $subdb}} db] 106 } 107 108 # 109 # If -queue method, we need to make sure that trying to 110 # create a subdb fails. 111 if { [is_queue $method] == 1 } { 112 error_check_bad dbopen $ret 0 113 puts "Subdb002: skipping remainder of test for method $method" 114 return 115 } 116 117 error_check_good dbopen $ret 0 118 error_check_good dbopen [is_valid_db $db] TRUE 119 120 set did [open $dict] 121 122 set pflags "" 123 set gflags "" 124 set count 0 125 126 if { [is_record_based $method] == 1 } { 127 set checkfunc subdb002_recno.check 128 append gflags " -recno" 129 } else { 130 set checkfunc subdb002.check 131 } 132 puts "\tSubdb002.a: put/get loop" 133 # Here is the loop where we put and get each key/data pair 134 while { [gets $did str] != -1 && $count < $nentries } { 135 if { [is_record_based $method] == 1 } { 136 global kvals 137 138 set key [expr $count + 1] 139 set kvals($key) [pad_data $method $str] 140 } else { 141 set key $str 142 } 143 set ret [eval \ 144 {$db put} $pflags {$key [chop_data $method $str]}] 145 error_check_good put $ret 0 146 147 set ret [eval {$db get} $gflags {$key}] 148 error_check_good \ 149 get $ret [list [list $key [pad_data $method $str]]] 150 incr count 151 } 152 close $did 153 # Now we will get each key from the DB and compare the results 154 # to the original. 155 puts "\tSubdb002.b: dump file" 156 set txn "" 157 dump_file $db $txn $t1 $checkfunc 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} {set i [incr i]} { 164 puts $oid $i 165 } 166 close $oid 167 file rename -force $t1 $t3 168 } else { 169 set q q 170 filehead $nentries $dict $t3 171 filesort $t3 $t2 172 filesort $t1 $t3 173 } 174 175 error_check_good Subdb002:diff($t3,$t2) \ 176 [filecmp $t3 $t2] 0 177 178 puts "\tSubdb002.c: close, open, and dump file" 179 # Now, reopen the file and run the last test again. 180 open_and_dump_subfile $testfile $env $t1 $checkfunc \ 181 dump_file_direction "-first" "-next" $subdb 182 if { [is_record_based $method] != 1 } { 183 filesort $t1 $t3 184 } 185 186 error_check_good Subdb002:diff($t2,$t3) \ 187 [filecmp $t2 $t3] 0 188 189 # Now, reopen the file and run the last test again in the 190 # reverse direction. 191 puts "\tSubdb002.d: close, open, and dump file in reverse direction" 192 open_and_dump_subfile $testfile $env $t1 $checkfunc \ 193 dump_file_direction "-last" "-prev" $subdb 194 195 if { [is_record_based $method] != 1 } { 196 filesort $t1 $t3 197 } 198 199 error_check_good Subdb002:diff($t3,$t2) \ 200 [filecmp $t3 $t2] 0 201 202 puts "\tSubdb002.e: db_dump with subdatabase" 203 set outfile $testdir/subdb002.dump 204 set dumpargs " -f $outfile -s $subdb " 205 if { $encrypt > 0 } { 206 append dumpargs " -P $passwd " 207 } 208 if { $env != "NULL" } { 209 append dumpargs " -h $testdir " 210 } 211 append dumpargs " $testfile" 212 set stat [catch {eval {exec $util_path/db_dump} $dumpargs} ret] 213 error_check_good dbdump.subdb $stat 0 214} 215 216# Check function for Subdb002; keys and data are identical 217proc subdb002.check { key data } { 218 error_check_good "key/data mismatch" $data $key 219} 220 221proc subdb002_recno.check { key data } { 222 global dict 223 global kvals 224 225 error_check_good key"$key"_exists [info exists kvals($key)] 1 226 error_check_good "key/data mismatch, key $key" $data $kvals($key) 227} 228