1# See the file LICENSE for redistribution information. 2# 3# Copyright (c) 1996,2008 Oracle. All rights reserved. 4# 5# $Id: test006.tcl,v 12.6 2008/01/08 20:58:53 bostic Exp $ 6# 7# TEST test006 8# TEST Small keys/medium data 9# TEST Put/get per key 10# TEST Keyed delete and verify 11# TEST 12# TEST Keyed delete test. 13# TEST Create database. 14# TEST Go through database, deleting all entries by key. 15# TEST Then do the same for unsorted and sorted dups. 16proc test006 { method {nentries 10000} {reopen 0} {tnum "006"} \ 17 {ndups 5} args } { 18 19 test006_body $method $nentries $reopen $tnum 1 "" "" $args 20 21 # For methods supporting dups, run the test with sorted and 22 # with unsorted dups. 23 if { [is_btree $method] == 1 || [is_hash $method] == 1 } { 24 foreach {sort flags} {unsorted -dup sorted "-dup -dupsort"} { 25 test006_body $method $nentries $reopen \ 26 $tnum $ndups $sort $flags $args 27 } 28 } 29} 30 31proc test006_body { method {nentries 10000} {reopen 0} {tnum "006"} \ 32 {ndups 5} sort flags {largs ""} } { 33 global is_je_test 34 source ./include.tcl 35 36 set do_renumber [is_rrecno $method] 37 set largs [convert_args $method $largs] 38 set omethod [convert_method $method] 39 40 set tname Test$tnum 41 set dbname test$tnum 42 43 # Create the database and open the dictionary 44 set txnenv 0 45 set eindex [lsearch -exact $largs "-env"] 46 # 47 # If we are using an env, then testfile should just be the db name. 48 # Otherwise it is the test directory and the name. 49 if { $eindex == -1 } { 50 set basename $testdir/$dbname 51 set env NULL 52 } else { 53 set basename $dbname 54 incr eindex 55 set env [lindex $largs $eindex] 56 if { $is_je_test && $sort == "unsorted" } { 57 puts "Test$tnum skipping $sort duplicates for JE" 58 return 59 } 60 set txnenv [is_txnenv $env] 61 if { $txnenv == 1 } { 62 append largs " -auto_commit " 63 # 64 # If we are using txns and running with the 65 # default, set the default down a bit. 66 # 67 if { $nentries == 10000 } { 68 set nentries 100 69 } 70 } 71 set testdir [get_home $env] 72 } 73 puts -nonewline "$tname: $method ($flags $largs) " 74 puts -nonewline "$nentries equal small key; medium data pairs" 75 if {$reopen == 1} { 76 puts " (with close)" 77 } else { 78 puts "" 79 } 80 81 set pflags "" 82 set gflags "" 83 set txn "" 84 if { [is_record_based $method] == 1 } { 85 append gflags " -recno" 86 } 87 88 cleanup $testdir $env 89 90 # Here is the loop where we put and get each key/data pair. 91 92 set count 0 93 set testfile $basename$sort.db 94 set db [eval {berkdb_open -create \ 95 -mode 0644} $largs $flags {$omethod $testfile}] 96 error_check_good dbopen [is_valid_db $db] TRUE 97 98 puts "\t$tname.a: put/get loop" 99 set did [open $dict] 100 while { [gets $did str] != -1 && $count < $nentries } { 101 if { [is_record_based $method] == 1 } { 102 set key [expr $count + 1 ] 103 } else { 104 set key $str 105 } 106 107 set str [make_data_str $str] 108 for { set j 1 } { $j <= $ndups } {incr j} { 109 set datastr $j$str 110 if { $txnenv == 1 } { 111 set t [$env txn] 112 error_check_good txn \ 113 [is_valid_txn $t $env] TRUE 114 set txn "-txn $t" 115 } 116 set ret [eval {$db put} $txn $pflags \ 117 {$key [chop_data $method $datastr]}] 118 error_check_good put $ret 0 119 if { $txnenv == 1 } { 120 error_check_good txn \ 121 [$t commit] 0 122 } 123 } 124 incr count 125 } 126 close $did 127 128 # Close and reopen database, if testing reopen. 129 130 if { $reopen == 1 } { 131 error_check_good db_close [$db close] 0 132 133 set db [eval {berkdb_open} $largs {$testfile}] 134 error_check_good dbopen [is_valid_db $db] TRUE 135 } 136 137 # Now we will get each key from the DB and compare the results 138 # to the original, then delete it. 139 140 puts "\t$tname.b: get/delete loop" 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 set dbc [eval {$db cursor} $txn] 147 error_check_good db_cursor [is_substr $dbc $db] 1 148 149 set i 1 150 for { set ret [$dbc get -first] } \ 151 { [string length $ret] != 0 } \ 152 { set ret [$dbc get -next] } { 153 set key [lindex [lindex $ret 0] 0] 154 set data [lindex [lindex $ret 0] 1] 155 if { $i == 1 } { 156 set curkey $key 157 } 158 error_check_good seq_get:key $key $curkey 159 160 if { $i == $ndups } { 161 set i 1 162 } else { 163 incr i 164 } 165 166 # Now delete the key 167 set ret [$dbc del] 168 error_check_good db_del:$key $ret 0 169 } 170 error_check_good dbc_close [$dbc close] 0 171 if { $txnenv == 1 } { 172 error_check_good txn [$t commit] 0 173 } 174 error_check_good db_close [$db close] 0 175 176 puts "\t$tname.c: verify empty file" 177 # Double check that file is now empty 178 set db [eval {berkdb_open} $largs $testfile] 179 error_check_good dbopen [is_valid_db $db] TRUE 180 if { $txnenv == 1 } { 181 set t [$env txn] 182 error_check_good txn [is_valid_txn $t $env] TRUE 183 set txn "-txn $t" 184 } 185 set dbc [eval {$db cursor} $txn] 186 error_check_good db_cursor [is_substr $dbc $db] 1 187 set ret [$dbc get -first] 188 error_check_good get_on_empty [string length $ret] 0 189 error_check_good dbc_close [$dbc close] 0 190 if { $txnenv == 1 } { 191 error_check_good txn [$t commit] 0 192 } 193error_check_good db_close [$db close] 0 194} 195