1# See the file LICENSE for redistribution information. 2# 3# Copyright (c) 1999,2008 Oracle. All rights reserved. 4# 5# $Id: test050.tcl,v 12.6 2008/01/08 20:58:53 bostic Exp $ 6# 7# TEST test050 8# TEST Overwrite test of small/big key/data with cursor checks for Recno. 9proc test050 { method args } { 10 global alphabet 11 global errorInfo 12 global errorCode 13 source ./include.tcl 14 15 set tstn 050 16 17 set args [convert_args $method $args] 18 set omethod [convert_method $method] 19 20 if { [is_rrecno $method] != 1 } { 21 puts "Test$tstn skipping for method $method." 22 return 23 } 24 25 puts "\tTest$tstn:\ 26 Overwrite test with cursor and small/big key/data ($method)." 27 28 set data "data" 29 set txn "" 30 set flags "" 31 32 puts "\tTest$tstn: Create $method database." 33 set txnenv 0 34 set eindex [lsearch -exact $args "-env"] 35 # 36 # If we are using an env, then testfile should just be the db name. 37 # Otherwise it is the test directory and the name. 38 if { $eindex == -1 } { 39 set testfile $testdir/test0$tstn.db 40 set env NULL 41 } else { 42 set testfile test0$tstn.db 43 incr eindex 44 set env [lindex $args $eindex] 45 set txnenv [is_txnenv $env] 46 if { $txnenv == 1 } { 47 append args " -auto_commit " 48 } 49 set testdir [get_home $env] 50 } 51 set t1 $testdir/t1 52 cleanup $testdir $env 53 54 set oflags "-create -mode 0644 $args $omethod" 55 set db [eval {berkdb_open_noerr} $oflags $testfile] 56 error_check_good dbopen [is_valid_db $db] TRUE 57 58 # keep nkeys even 59 set nkeys 20 60 61 # Fill page w/ small key/data pairs 62 # 63 puts "\tTest$tstn: Fill page with $nkeys small key/data pairs." 64 for { set i 1 } { $i <= $nkeys } { incr i } { 65 if { $txnenv == 1 } { 66 set t [$env txn] 67 error_check_good txn [is_valid_txn $t $env] TRUE 68 set txn "-txn $t" 69 } 70 set ret [eval {$db put} $txn {$i [chop_data $method $data$i]}] 71 error_check_good dbput $ret 0 72 if { $txnenv == 1 } { 73 error_check_good txn [$t commit] 0 74 } 75 } 76 77 if { $txnenv == 1 } { 78 set t [$env txn] 79 error_check_good txn [is_valid_txn $t $env] TRUE 80 set txn "-txn $t" 81 } 82 # open curs to db 83 set dbc [eval {$db cursor} $txn] 84 error_check_good db_cursor [is_valid_cursor $dbc $db] TRUE 85 86 # get db order of keys 87 for {set i 0; set ret [$dbc get -first]} { [llength $ret] != 0} { \ 88 set ret [$dbc get -next]} { 89 set key_set($i) [lindex [lindex $ret 0] 0] 90 set data_set($i) [lindex [lindex $ret 0] 1] 91 incr i 92 } 93 94 # verify ordering: should be unnecessary, but hey, why take chances? 95 # key_set is zero indexed but keys start at 1 96 for {set i 0} { $i < $nkeys } {incr i} { 97 error_check_good \ 98 verify_order:$i $key_set($i) [pad_data $method [expr $i+1]] 99 } 100 101 puts "\tTest$tstn.a: Inserts before/after by cursor." 102 puts "\t\tTest$tstn.a.1:\ 103 Insert with uninitialized cursor (should fail)." 104 error_check_good dbc_close [$dbc close] 0 105 if { $txnenv == 1 } { 106 error_check_good txn [$t commit] 0 107 } 108 if { $txnenv == 1 } { 109 set t [$env txn] 110 error_check_good txn [is_valid_txn $t $env] TRUE 111 set txn "-txn $t" 112 } 113 set dbc [eval {$db cursor} $txn] 114 error_check_good db_cursor [is_valid_cursor $dbc $db] TRUE 115 catch {$dbc put -before DATA1} ret 116 error_check_good dbc_put:before:uninit [is_substr $errorCode EINVAL] 1 117 118 catch {$dbc put -after DATA2} ret 119 error_check_good dbc_put:after:uninit [is_substr $errorCode EINVAL] 1 120 121 puts "\t\tTest$tstn.a.2: Insert with deleted cursor (should succeed)." 122 set ret [$dbc get -first] 123 error_check_bad dbc_get:first [llength $ret] 0 124 error_check_good dbc_del [$dbc del] 0 125 set ret [$dbc put -current DATAOVER1] 126 error_check_good dbc_put:current:deleted $ret 0 127 128 puts "\t\tTest$tstn.a.3: Insert by cursor before cursor (DB_BEFORE)." 129 set currecno [lindex [lindex [$dbc get -current] 0] 0] 130 set ret [$dbc put -before DATAPUTBEFORE] 131 error_check_good dbc_put:before $ret $currecno 132 set old1 [$dbc get -next] 133 error_check_bad dbc_get:next [llength $old1] 0 134 error_check_good \ 135 dbc_get:next(compare) [lindex [lindex $old1 0] 1] DATAOVER1 136 137 puts "\t\tTest$tstn.a.4: Insert by cursor after cursor (DB_AFTER)." 138 set ret [$dbc get -first] 139 error_check_bad dbc_get:first [llength $ret] 0 140 error_check_good dbc_get:first [lindex [lindex $ret 0] 1] DATAPUTBEFORE 141 set currecno [lindex [lindex [$dbc get -current] 0] 0] 142 set ret [$dbc put -after DATAPUTAFTER] 143 error_check_good dbc_put:after $ret [expr $currecno + 1] 144 set ret [$dbc get -prev] 145 error_check_bad dbc_get:prev [llength $ret] 0 146 error_check_good \ 147 dbc_get:prev [lindex [lindex $ret 0] 1] DATAPUTBEFORE 148 149 puts "\t\tTest$tstn.a.5: Verify that all keys have been renumbered." 150 # should be $nkeys + 2 keys, starting at 1 151 for {set i 1; set ret [$dbc get -first]} { \ 152 $i <= $nkeys && [llength $ret] != 0 } {\ 153 incr i; set ret [$dbc get -next]} { 154 error_check_good check_renumber $i [lindex [lindex $ret 0] 0] 155 } 156 157 # tested above 158 159 puts "\tTest$tstn.b: Overwrite tests (cursor and key)." 160 # For the next part of the test, we need a db with no dups to test 161 # overwrites 162 # 163 # we should have ($nkeys + 2) keys, ordered: 164 # DATAPUTBEFORE, DATAPUTAFTER, DATAOVER1, data1, ..., data$nkeys 165 # 166 # Prepare cursor on item 167 # 168 set ret [$dbc get -first] 169 error_check_bad dbc_get:first [llength $ret] 0 170 171 # Prepare unique big/small values for an initial 172 # and an overwrite set of data 173 set databig DATA_BIG_[repeat alphabet 250] 174 set datasmall DATA_SMALL 175 176 # Now, we want to overwrite data: 177 # by key and by cursor 178 # 1. small by small 179 # 2. small by big 180 # 3. big by small 181 # 4. big by big 182 # 183 set i 0 184 # Do all overwrites for key and cursor 185 foreach type { by_key by_cursor } { 186 incr i 187 puts "\tTest$tstn.b.$i: Overwrites $type." 188 foreach pair { {small small} \ 189 {small big} {big small} {big big} } { 190 # put in initial type 191 set data $data[lindex $pair 0] 192 set ret [$dbc put -current $data] 193 error_check_good dbc_put:curr:init:($pair) $ret 0 194 195 # Now, try to overwrite: dups not supported in this db 196 if { [string compare $type by_key] == 0 } { 197 puts "\t\tTest$tstn.b.$i:\ 198 Overwrite:($pair):$type" 199 set ret [eval {$db put} $txn \ 200 1 {OVER$pair$data[lindex $pair 1]}] 201 error_check_good dbput:over:($pair) $ret 0 202 } else { 203 # This is a cursor overwrite 204 puts "\t\tTest$tstn.b.$i:\ 205 Overwrite:($pair) by cursor." 206 set ret [$dbc put \ 207 -current OVER$pair$data[lindex $pair 1]] 208 error_check_good dbcput:over:($pair) $ret 0 209 } 210 } ;# foreach pair 211 } ;# foreach type key/cursor 212 213 puts "\tTest$tstn.c: Cleanup and close cursor." 214 error_check_good dbc_close [$dbc close] 0 215 if { $txnenv == 1 } { 216 error_check_good txn [$t commit] 0 217 } 218 error_check_good db_close [$db close] 0 219 220} 221