1# See the file LICENSE for redistribution information. 2# 3# Copyright (c) 1996,2008 Oracle. All rights reserved. 4# 5# $Id: test020.tcl,v 12.6 2008/01/08 20:58:53 bostic Exp $ 6# 7# TEST test020 8# TEST In-Memory database tests. 9proc test020 { method {nentries 10000} args } { 10 source ./include.tcl 11 12 set args [convert_args $method $args] 13 set omethod [convert_method $method] 14 if { [is_queueext $method] == 1 || \ 15 [is_rbtree $method] == 1 } { 16 puts "Test020 skipping for method $method" 17 return 18 } 19 # Create the database and open the dictionary 20 set t1 $testdir/t1 21 set t2 $testdir/t2 22 set t3 $testdir/t3 23 set txnenv 0 24 set eindex [lsearch -exact $args "-env"] 25 # 26 # Check if we are using an env. 27 if { $eindex == -1 } { 28 set env NULL 29 } else { 30 incr eindex 31 set env [lindex $args $eindex] 32 set txnenv [is_txnenv $env] 33 if { $txnenv == 1 } { 34 append args " -auto_commit " 35 # 36 # If we are using txns and running with the 37 # default, set the default down a bit. 38 # 39 if { $nentries == 10000 } { 40 set nentries 100 41 } 42 } 43 set testdir [get_home $env] 44 } 45 puts "Test020: $method ($args) $nentries equal key/data pairs" 46 47 cleanup $testdir $env 48 set db [eval {berkdb_open \ 49 -create -mode 0644} $args {$omethod}] 50 error_check_good dbopen [is_valid_db $db] TRUE 51 set did [open $dict] 52 53 set pflags "" 54 set gflags "" 55 set txn "" 56 set count 0 57 58 if { [is_record_based $method] == 1 } { 59 set checkfunc test020_recno.check 60 append gflags " -recno" 61 } else { 62 set checkfunc test020.check 63 } 64 puts "\tTest020.a: put/get loop" 65 # Here is the loop where we put and get each key/data pair 66 while { [gets $did str] != -1 && $count < $nentries } { 67 if { [is_record_based $method] == 1 } { 68 global kvals 69 70 set key [expr $count + 1] 71 set kvals($key) [pad_data $method $str] 72 } else { 73 set key $str 74 } 75 if { $txnenv == 1 } { 76 set t [$env txn] 77 error_check_good txn [is_valid_txn $t $env] TRUE 78 set txn "-txn $t" 79 } 80 set ret [eval {$db put} \ 81 $txn $pflags {$key [chop_data $method $str]}] 82 error_check_good put $ret 0 83 set ret [eval {$db get} $txn $gflags {$key}] 84 error_check_good \ 85 get $ret [list [list $key [pad_data $method $str]]] 86 if { $txnenv == 1 } { 87 error_check_good txn [$t commit] 0 88 } 89 incr count 90 } 91 close $did 92 # Now we will get each key from the DB and compare the results 93 # to the original. 94 puts "\tTest020.b: dump file" 95 if { $txnenv == 1 } { 96 set t [$env txn] 97 error_check_good txn [is_valid_txn $t $env] TRUE 98 set txn "-txn $t" 99 } 100 dump_file $db $txn $t1 $checkfunc 101 if { $txnenv == 1 } { 102 error_check_good txn [$t commit] 0 103 } 104 error_check_good db_close [$db close] 0 105 106 # Now compare the keys to see if they match the dictionary (or ints) 107 if { [is_record_based $method] == 1 } { 108 set oid [open $t2 w] 109 for {set i 1} {$i <= $nentries} {set i [incr i]} { 110 puts $oid $i 111 } 112 close $oid 113 file rename -force $t1 $t3 114 } else { 115 set q q 116 filehead $nentries $dict $t3 117 filesort $t3 $t2 118 filesort $t1 $t3 119 } 120 121 error_check_good Test020:diff($t3,$t2) \ 122 [filecmp $t3 $t2] 0 123} 124 125# Check function for test020; keys and data are identical 126proc test020.check { key data } { 127 error_check_good "key/data mismatch" $data $key 128} 129 130proc test020_recno.check { key data } { 131 global dict 132 global kvals 133 134 error_check_good key"$key"_exists [info exists kvals($key)] 1 135 error_check_good "data mismatch: key $key" $data $kvals($key) 136} 137