1# See the file LICENSE for redistribution information. 2# 3# Copyright (c) 1996,2008 Oracle. All rights reserved. 4# 5# $Id: test036.tcl,v 12.6 2008/01/08 20:58:53 bostic Exp $ 6# 7# TEST test036 8# TEST Test KEYFIRST and KEYLAST when the key doesn't exist 9# TEST Put nentries key/data pairs (from the dictionary) using a cursor 10# TEST and KEYFIRST and KEYLAST (this tests the case where use use cursor 11# TEST put for non-existent keys). 12proc test036 { method {nentries 10000} args } { 13 source ./include.tcl 14 15 set args [convert_args $method $args] 16 set omethod [convert_method $method] 17 if { [is_record_based $method] == 1 } { 18 puts "Test036 skipping for method recno" 19 return 20 } 21 22 # Create the database and open the dictionary 23 set txnenv 0 24 set eindex [lsearch -exact $args "-env"] 25 # 26 # If we are using an env, then testfile should just be the db name. 27 # Otherwise it is the test directory and the name. 28 if { $eindex == -1 } { 29 set testfile $testdir/test036.db 30 set env NULL 31 } else { 32 set testfile test036.db 33 incr eindex 34 set env [lindex $args $eindex] 35 set txnenv [is_txnenv $env] 36 if { $txnenv == 1 } { 37 append args " -auto_commit " 38 # 39 # If we are using txns and running with the 40 # default, set the default down a bit. 41 # 42 if { $nentries == 10000 } { 43 set nentries 100 44 } 45 } 46 set testdir [get_home $env] 47 } 48 49 puts "Test036: $method ($args) $nentries equal key/data pairs" 50 set t1 $testdir/t1 51 set t2 $testdir/t2 52 set t3 $testdir/t3 53 cleanup $testdir $env 54 set db [eval {berkdb_open \ 55 -create -mode 0644} $args {$omethod $testfile}] 56 error_check_good dbopen [is_valid_db $db] TRUE 57 set did [open $dict] 58 59 set pflags "" 60 set gflags "" 61 set txn "" 62 set count 0 63 64 if { [is_record_based $method] == 1 } { 65 set checkfunc test036_recno.check 66 append gflags " -recno" 67 } else { 68 set checkfunc test036.check 69 } 70 puts "\tTest036.a: put/get loop KEYFIRST" 71 # Here is the loop where we put and get each key/data pair 72 if { $txnenv == 1 } { 73 set t [$env txn] 74 error_check_good txn [is_valid_txn $t $env] TRUE 75 set txn "-txn $t" 76 } 77 set dbc [eval {$db cursor} $txn] 78 error_check_good cursor [is_valid_cursor $dbc $db] TRUE 79 while { [gets $did str] != -1 && $count < $nentries } { 80 if { [is_record_based $method] == 1 } { 81 global kvals 82 83 set key [expr $count + 1] 84 set kvals($key) $str 85 } else { 86 set key $str 87 } 88 set ret [eval {$dbc put} $pflags {-keyfirst $key $str}] 89 error_check_good put $ret 0 90 91 set ret [eval {$db get} $txn $gflags {$key}] 92 error_check_good get [lindex [lindex $ret 0] 1] $str 93 incr count 94 } 95 error_check_good dbc_close [$dbc close] 0 96 if { $txnenv == 1 } { 97 error_check_good txn [$t commit] 0 98 } 99 100 puts "\tTest036.a: put/get loop KEYLAST" 101 if { $txnenv == 1 } { 102 set t [$env txn] 103 error_check_good txn [is_valid_txn $t $env] TRUE 104 set txn "-txn $t" 105 } 106 set dbc [eval {$db cursor} $txn] 107 error_check_good cursor [is_valid_cursor $dbc $db] TRUE 108 while { [gets $did str] != -1 && $count < $nentries } { 109 if { [is_record_based $method] == 1 } { 110 global kvals 111 112 set key [expr $count + 1] 113 set kvals($key) $str 114 } else { 115 set key $str 116 } 117 set ret [eval {$dbc put} $txn $pflags {-keylast $key $str}] 118 error_check_good put $ret 0 119 120 set ret [eval {$db get} $txn $gflags {$key}] 121 error_check_good get [lindex [lindex $ret 0] 1] $str 122 incr count 123 } 124 error_check_good dbc_close [$dbc close] 0 125 if { $txnenv == 1 } { 126 error_check_good txn [$t commit] 0 127 } 128 close $did 129 130 # Now we will get each key from the DB and compare the results 131 # to the original. 132 puts "\tTest036.c: dump file" 133 if { $txnenv == 1 } { 134 set t [$env txn] 135 error_check_good txn [is_valid_txn $t $env] TRUE 136 set txn "-txn $t" 137 } 138 dump_file $db $txn $t1 $checkfunc 139 if { $txnenv == 1 } { 140 error_check_good txn [$t commit] 0 141 } 142 error_check_good db_close [$db close] 0 143 144 # Now compare the keys to see if they match the dictionary (or ints) 145 if { [is_record_based $method] == 1 } { 146 set oid [open $t2 w] 147 for {set i 1} {$i <= $nentries} {set i [incr i]} { 148 puts $oid $i 149 } 150 close $oid 151 file rename -force $t1 $t3 152 } else { 153 set q q 154 filehead $nentries $dict $t3 155 filesort $t3 $t2 156 filesort $t1 $t3 157 } 158 159} 160 161# Check function for test036; keys and data are identical 162proc test036.check { key data } { 163 error_check_good "key/data mismatch" $data $key 164} 165 166proc test036_recno.check { key data } { 167 global dict 168 global kvals 169 170 error_check_good key"$key"_exists [info exists kvals($key)] 1 171 error_check_good "key/data mismatch, key $key" $data $kvals($key) 172} 173