1# See the file LICENSE for redistribution information. 2# 3# Copyright (c) 1996,2008 Oracle. All rights reserved. 4# 5# $Id: test004.tcl,v 12.6 2008/01/08 20:58:53 bostic Exp $ 6# 7# TEST test004 8# TEST Small keys/medium data 9# TEST Put/get per key 10# TEST Sequential (cursor) get/delete 11# TEST 12# TEST Check that cursor operations work. Create a database. 13# TEST Read through the database sequentially using cursors and 14# TEST delete each element. 15proc test004 { method {nentries 10000} {reopen "004"} {build_only 0} args} { 16 source ./include.tcl 17 18 set do_renumber [is_rrecno $method] 19 set args [convert_args $method $args] 20 set omethod [convert_method $method] 21 22 set tnum test$reopen 23 24 # Create the database and open the dictionary 25 set txnenv 0 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 { $eindex == -1 } { 31 set testfile $testdir/$tnum.db 32 set env NULL 33 } else { 34 set testfile $tnum.db 35 incr eindex 36 set env [lindex $args $eindex] 37 set txnenv [is_txnenv $env] 38 if { $txnenv == 1 } { 39 append args " -auto_commit " 40 # 41 # If we are using txns and running with the 42 # default, set the default down a bit. 43 # 44 if { $nentries == 10000 } { 45 set nentries 100 46 } 47 } 48 set testdir [get_home $env] 49 } 50 51 puts -nonewline "$tnum:\ 52 $method ($args) $nentries delete small key; medium data pairs" 53 if {$reopen == "005"} { 54 puts "(with close)" 55 } else { 56 puts "" 57 } 58 59 # Create the database and open the dictionary 60 set t1 $testdir/t1 61 set t2 $testdir/t2 62 set t3 $testdir/t3 63 cleanup $testdir $env 64 set db [eval {berkdb_open -create -mode 0644} $args {$omethod $testfile}] 65 error_check_good dbopen [is_valid_db $db] TRUE 66 67 set did [open $dict] 68 69 set pflags "" 70 set gflags "" 71 set txn "" 72 set count 0 73 74 if { [is_record_based $method] == 1 } { 75 append gflags " -recno" 76 } 77 78 # Here is the loop where we put and get each key/data pair 79 set kvals "" 80 puts "\tTest$reopen.a: put/get loop" 81 while { [gets $did str] != -1 && $count < $nentries } { 82 if { [is_record_based $method] == 1 } { 83 set key [expr $count + 1] 84 lappend kvals $str 85 } else { 86 set key $str 87 } 88 89 set datastr [ make_data_str $str ] 90 91 if { $txnenv == 1 } { 92 set t [$env txn] 93 error_check_good txn [is_valid_txn $t $env] TRUE 94 set txn "-txn $t" 95 } 96 set ret [eval {$db put} $txn $pflags \ 97 {$key [chop_data $method $datastr]}] 98 error_check_good put $ret 0 99 if { $txnenv == 1 } { 100 error_check_good txn [$t commit] 0 101 } 102 103 set ret [eval {$db get} $gflags {$key}] 104 error_check_good "$tnum:put" $ret \ 105 [list [list $key [pad_data $method $datastr]]] 106 incr count 107 } 108 close $did 109 if { $build_only == 1 } { 110 return $db 111 } 112 if { $reopen == "005" } { 113 error_check_good db_close [$db close] 0 114 115 set db [eval {berkdb_open} $args {$testfile}] 116 error_check_good dbopen [is_valid_db $db] TRUE 117 } 118 puts "\tTest$reopen.b: get/delete loop" 119 # Now we will get each key from the DB and compare the results 120 # to the original, then delete it. 121 set outf [open $t1 w] 122 if { $txnenv == 1 } { 123 set t [$env txn] 124 error_check_good txn [is_valid_txn $t $env] TRUE 125 set txn "-txn $t" 126 } 127 set c [eval {$db cursor} $txn] 128 129 set count 0 130 for {set d [$c get -first] } { [llength $d] != 0 } { 131 set d [$c get -next] } { 132 set k [lindex [lindex $d 0] 0] 133 set d2 [lindex [lindex $d 0] 1] 134 if { [is_record_based $method] == 1 } { 135 set datastr \ 136 [make_data_str [lindex $kvals [expr $k - 1]]] 137 } else { 138 set datastr [make_data_str $k] 139 } 140 error_check_good $tnum:$k $d2 [pad_data $method $datastr] 141 puts $outf $k 142 $c del 143 if { [is_record_based $method] == 1 && \ 144 $do_renumber == 1 } { 145 set kvals [lreplace $kvals 0 0] 146 } 147 incr count 148 } 149 close $outf 150 error_check_good curs_close [$c close] 0 151 if { $txnenv == 1 } { 152 error_check_good txn [$t commit] 0 153 } 154 155 # Now compare the keys to see if they match the dictionary 156 if { [is_record_based $method] == 1 } { 157 error_check_good test$reopen:keys_deleted $count $nentries 158 } else { 159 set q q 160 filehead $nentries $dict $t3 161 filesort $t3 $t2 162 filesort $t1 $t3 163 error_check_good Test$reopen:diff($t3,$t2) \ 164 [filecmp $t3 $t2] 0 165 } 166 167 error_check_good db_close [$db close] 0 168} 169