1# See the file LICENSE for redistribution information. 2# 3# Copyright (c) 1999,2008 Oracle. All rights reserved. 4# 5# $Id: sdb005.tcl,v 12.6 2008/01/08 20:58:53 bostic Exp $ 6# 7# TEST sdb005 8# TEST Tests cursor operations in subdbs 9# TEST Put/get per key 10# TEST Verify cursor operations work within subdb 11# TEST Verify cursor operations do not work across subdbs 12# TEST 13# 14# We should test this on all btrees, all hash, and a combination thereof 15proc sdb005 {method {nentries 100} args } { 16 source ./include.tcl 17 18 set args [convert_args $method $args] 19 set omethod [convert_method $method] 20 21 if { [is_queue $method] == 1 } { 22 puts "Subdb005: skipping for method $method" 23 return 24 } 25 26 puts "Subdb005: $method ( $args ) subdb cursor operations test" 27 set txnenv 0 28 set envargs "" 29 set eindex [lsearch -exact $args "-env"] 30 # 31 # If we are using an env, then testfile should just be the db name. 32 # Otherwise it is the test directory and the name. 33 if { $eindex == -1 } { 34 set testfile $testdir/subdb005.db 35 set env NULL 36 } else { 37 set testfile subdb005.db 38 incr eindex 39 set env [lindex $args $eindex] 40 set envargs " -env $env " 41 set txnenv [is_txnenv $env] 42 if { $txnenv == 1 } { 43 append args " -auto_commit " 44 append envargs " -auto_commit " 45 if { $nentries == 100 } { 46 set nentries 20 47 } 48 } 49 set testdir [get_home $env] 50 } 51 52 cleanup $testdir $env 53 set txn "" 54 set psize 8192 55 set duplist {-1 -1 -1 -1 -1} 56 build_all_subdb \ 57 $testfile [list $method] $psize $duplist $nentries $args 58 set numdb [llength $duplist] 59 # 60 # Get a cursor in each subdb and move past the end of each 61 # subdb. Make sure we don't end up in another subdb. 62 # 63 puts "\tSubdb005.a: Cursor ops - first/prev and last/next" 64 if { $txnenv == 1 } { 65 set t [$env txn] 66 error_check_good txn [is_valid_txn $t $env] TRUE 67 set txn "-txn $t" 68 } 69 for {set i 0} {$i < $numdb} {incr i} { 70 set db [eval {berkdb_open -unknown} $args {$testfile sub$i.db}] 71 error_check_good dbopen [is_valid_db $db] TRUE 72 set db_handle($i) $db 73 # Used in 005.c test 74 lappend subdbnames sub$i.db 75 76 set dbc [eval {$db cursor} $txn] 77 error_check_good db_cursor [is_valid_cursor $dbc $db] TRUE 78 set d [$dbc get -first] 79 error_check_good dbc_get [expr [llength $d] != 0] 1 80 81 # Used in 005.b test 82 set db_key($i) [lindex [lindex $d 0] 0] 83 84 set d [$dbc get -prev] 85 error_check_good dbc_get [expr [llength $d] == 0] 1 86 set d [$dbc get -last] 87 error_check_good dbc_get [expr [llength $d] != 0] 1 88 set d [$dbc get -next] 89 error_check_good dbc_get [expr [llength $d] == 0] 1 90 error_check_good dbc_close [$dbc close] 0 91 } 92 # 93 # Get a key from each subdb and try to get this key in a 94 # different subdb. Make sure it fails 95 # 96 puts "\tSubdb005.b: Get keys in different subdb's" 97 for {set i 0} {$i < $numdb} {incr i} { 98 set n [expr $i + 1] 99 if {$n == $numdb} { 100 set n 0 101 } 102 set db $db_handle($i) 103 if { [is_record_based $method] == 1 } { 104 set d [eval {$db get -recno} $txn {$db_key($n)}] 105 error_check_good \ 106 db_get [expr [llength $d] == 0] 1 107 } else { 108 set d [eval {$db get} $txn {$db_key($n)}] 109 error_check_good db_get [expr [llength $d] == 0] 1 110 } 111 } 112 if { $txnenv == 1 } { 113 error_check_good txn [$t commit] 0 114 } 115 # 116 # Clean up 117 # 118 for {set i 0} {$i < $numdb} {incr i} { 119 error_check_good db_close [$db_handle($i) close] 0 120 } 121 122 # 123 # Check contents of DB for subdb names only. Makes sure that 124 # every subdbname is there and that nothing else is there. 125 # 126 puts "\tSubdb005.c: Check DB is read-only" 127 error_check_bad dbopen [catch \ 128 {berkdb_open_noerr -unknown $testfile} ret] 0 129 130 puts "\tSubdb005.d: Check contents of DB for subdb names only" 131 set db [eval {berkdb_open -unknown -rdonly} $envargs {$testfile}] 132 error_check_good dbopen [is_valid_db $db] TRUE 133 set subdblist [$db get -glob *] 134 foreach kd $subdblist { 135 # subname also used in subdb005.e,f below 136 set subname [lindex $kd 0] 137 set i [lsearch $subdbnames $subname] 138 error_check_good subdb_search [expr $i != -1] 1 139 set subdbnames [lreplace $subdbnames $i $i] 140 } 141 error_check_good subdb_done [llength $subdbnames] 0 142 143 error_check_good db_close [$db close] 0 144 return 145} 146