1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184
|
# See the file LICENSE for redistribution information.
#
# Copyright (c) 1999-2002
# Sleepycat Software. All rights reserved.
#
# $Id: test049.tcl,v 1.1.1.1 2003/11/20 22:14:00 toshok Exp $
#
# TEST test049
# TEST Cursor operations on uninitialized cursors.
proc test049 { method args } {
global errorInfo
global errorCode
source ./include.tcl
set tstn 049
set renum [is_rrecno $method]
set args [convert_args $method $args]
set omethod [convert_method $method]
puts "\tTest$tstn: Test of cursor routines with uninitialized cursors."
set key "key"
set data "data"
set txn ""
set flags ""
set rflags ""
if { [is_record_based $method] == 1 } {
set key ""
}
puts "\tTest$tstn.a: Create $method database."
set txnenv 0
set eindex [lsearch -exact $args "-env"]
#
# If we are using an env, then testfile should just be the db name.
# Otherwise it is the test directory and the name.
if { $eindex == -1 } {
set testfile $testdir/test0$tstn.db
set env NULL
} else {
set testfile test0$tstn.db
incr eindex
set env [lindex $args $eindex]
set txnenv [is_txnenv $env]
if { $txnenv == 1 } {
append args " -auto_commit "
}
set testdir [get_home $env]
}
set t1 $testdir/t1
cleanup $testdir $env
set oflags "-create -mode 0644 $rflags $omethod $args"
if { [is_record_based $method] == 0 && [is_rbtree $method] != 1 } {
append oflags " -dup"
}
set db [eval {berkdb_open_noerr} $oflags $testfile]
error_check_good dbopen [is_valid_db $db] TRUE
set nkeys 10
puts "\tTest$tstn.b: Fill page with $nkeys small key/data pairs."
for { set i 1 } { $i <= $nkeys } { incr i } {
if { $txnenv == 1 } {
set t [$env txn]
error_check_good txn [is_valid_txn $t $env] TRUE
set txn "-txn $t"
}
set ret [eval {$db put} $txn {$key$i $data$i}]
error_check_good dbput:$i $ret 0
if { $i == 1 } {
for {set j 0} { $j < [expr $nkeys / 2]} {incr j} {
set ret [eval {$db put} $txn \
{$key$i DUPLICATE$j}]
error_check_good dbput:dup:$j $ret 0
}
}
if { $txnenv == 1 } {
error_check_good txn [$t commit] 0
}
}
# DBC GET
if { $txnenv == 1 } {
set t [$env txn]
error_check_good txn [is_valid_txn $t $env] TRUE
set txn "-txn $t"
}
set dbc_u [eval {$db cursor} $txn]
error_check_good db:cursor [is_valid_cursor $dbc_u $db] TRUE
puts "\tTest$tstn.c: Test dbc->get interfaces..."
set i 0
foreach flag { current first last next prev nextdup} {
puts "\t\t...dbc->get($flag)"
catch {$dbc_u get -$flag} ret
error_check_good dbc:get:$flag [is_substr $errorCode EINVAL] 1
}
foreach flag { set set_range get_both} {
puts "\t\t...dbc->get($flag)"
if { [string compare $flag get_both] == 0} {
catch {$dbc_u get -$flag $key$i data0} ret
} else {
catch {$dbc_u get -$flag $key$i} ret
}
error_check_good dbc:get:$flag [is_substr $errorCode EINVAL] 1
}
puts "\t\t...dbc->get(current, partial)"
catch {$dbc_u get -current -partial {0 0}} ret
error_check_good dbc:get:partial [is_substr $errorCode EINVAL] 1
puts "\t\t...dbc->get(current, rmw)"
catch {$dbc_u get -rmw -current } ret
error_check_good dbc_get:rmw [is_substr $errorCode EINVAL] 1
puts "\tTest$tstn.d: Test dbc->put interface..."
# partial...depends on another
foreach flag { after before current keyfirst keylast } {
puts "\t\t...dbc->put($flag)"
if { [string match key* $flag] == 1 } {
if { [is_record_based $method] == 1 } {
# keyfirst/keylast not allowed in recno
puts "\t\t...Skipping dbc->put($flag) for $method."
continue
} else {
# keyfirst/last should succeed
puts "\t\t...dbc->put($flag)...should succeed for $method"
error_check_good dbcput:$flag \
[$dbc_u put -$flag $key$i data0] 0
# now uninitialize cursor
error_check_good dbc_close [$dbc_u close] 0
set dbc_u [eval {$db cursor} $txn]
error_check_good \
db_cursor [is_substr $dbc_u $db] 1
}
} elseif { [string compare $flag before ] == 0 ||
[string compare $flag after ] == 0 } {
if { [is_record_based $method] == 0 &&
[is_rbtree $method] == 0} {
set ret [$dbc_u put -$flag data0]
error_check_good "$dbc_u:put:-$flag" $ret 0
} elseif { $renum == 1 } {
# Renumbering recno will return a record number
set currecno \
[lindex [lindex [$dbc_u get -current] 0] 0]
set ret [$dbc_u put -$flag data0]
if { [string compare $flag after] == 0 } {
error_check_good "$dbc_u put $flag" \
$ret [expr $currecno + 1]
} else {
error_check_good "$dbc_u put $flag" \
$ret $currecno
}
} else {
puts "\t\tSkipping $flag for $method"
}
} else {
set ret [$dbc_u put -$flag data0]
error_check_good "$dbc_u:put:-$flag" $ret 0
}
}
# and partial
puts "\t\t...dbc->put(partial)"
catch {$dbc_u put -partial {0 0} $key$i $data$i} ret
error_check_good dbc_put:partial [is_substr $errorCode EINVAL] 1
# XXX dbc->dup, db->join (dbc->get join_item)
# dbc del
puts "\tTest$tstn.e: Test dbc->del interface."
catch {$dbc_u del} ret
error_check_good dbc_del [is_substr $errorCode EINVAL] 1
error_check_good dbc_close [$dbc_u close] 0
if { $txnenv == 1 } {
error_check_good txn [$t commit] 0
}
error_check_good db_close [$db close] 0
puts "\tTest$tstn complete."
}
|