1# See the file LICENSE for redistribution information. 2# 3# Copyright (c) 2004,2008 Oracle. All rights reserved. 4# 5# $Id: test109.tcl,v 12.12 2008/01/08 20:58:53 bostic Exp $ 6# 7# TEST test109 8# TEST 9# TEST Test of sequences. 10proc test109 { method {tnum "109"} args } { 11 source ./include.tcl 12 global rand_init 13 global fixed_len 14 global errorCode 15 16 set eindex [lsearch -exact $args "-env"] 17 set txnenv 0 18 set rpcenv 0 19 set sargs " -thread " 20 if { $eindex == -1 } { 21 set env NULL 22 } else { 23 incr eindex 24 set env [lindex $args $eindex] 25 set txnenv [is_txnenv $env] 26 set rpcenv [is_rpcenv $env] 27 if { $rpcenv == 1 } { 28 puts "Test$tnum: skipping for RPC" 29 return 30 } 31 if { $txnenv == 1 } { 32 append args " -auto_commit " 33 } 34 set testdir [get_home $env] 35 } 36 37 # Fixed_len must be increased from the default to 38 # accommodate fixed-record length methods. 39 set orig_fixed_len $fixed_len 40 set fixed_len 128 41 set args [convert_args $method $args] 42 set omethod [convert_method $method] 43 error_check_good random_seed [berkdb srand $rand_init] 0 44 45 # Test with in-memory dbs, regular dbs, and subdbs. 46 foreach filetype { subdb regular in-memory } { 47 puts "Test$tnum: $method ($args) Test of sequences ($filetype)." 48 49 # Skip impossible combinations. 50 if { $filetype == "subdb" && [is_queue $method] } { 51 puts "Skipping $filetype test for method $method." 52 continue 53 } 54 if { $filetype == "in-memory" && [is_queueext $method] } { 55 puts "Skipping $filetype test for method $method." 56 continue 57 } 58 59 # Reinitialize file name for each file type, then adjust. 60 if { $eindex == -1 } { 61 set testfile $testdir/test$tnum.db 62 } else { 63 set testfile test$tnum.db 64 set testdir [get_home $env] 65 } 66 if { $filetype == "subdb" } { 67 lappend testfile SUBDB 68 } 69 if { $filetype == "in-memory" } { 70 set testfile "" 71 } 72 73 cleanup $testdir $env 74 75 # Make the key numeric so we can test record-based methods. 76 set key 1 77 78 # Open a noerr db, since we expect errors. 79 set db [eval {berkdb_open_noerr \ 80 -create -mode 0644} $args $omethod $testfile] 81 error_check_good dbopen [is_valid_db $db] TRUE 82 83 puts "\tTest$tnum.a: Max must be greater than min." 84 set errorCode NONE 85 catch {set seq [eval {berkdb sequence} -create $sargs \ 86 -init 0 -min 100 -max 0 $db $key]} res 87 error_check_good max>min [is_substr $errorCode EINVAL] 1 88 89 puts "\tTest$tnum.b: Init can't be out of the min-max range." 90 set errorCode NONE 91 catch {set seq [eval {berkdb sequence} -create $sargs \ 92 -init 101 -min 0 -max 100 $db $key]} res 93 error_check_good init [is_substr $errorCode EINVAL] 1 94 95 # Test increment and decrement. 96 set min 0 97 set max 100 98 foreach { init inc } { $min -inc $max -dec } { 99 puts "\tTest$tnum.c: Test for overflow error with $inc." 100 test_sequence $env $db $key $min $max $init $inc 101 } 102 103 # Test cachesize without wrap. Make sure to test both 104 # cachesizes that evenly divide the number of items in the 105 # sequence, and that leave unused elements at the end. 106 set min 0 107 set max 99 108 set init 1 109 set cachesizes [list 2 7 11] 110 foreach csize $cachesizes { 111 foreach inc { -inc -dec } { 112 puts "\tTest$tnum.d:\ 113 -cachesize $csize, $inc, no wrap." 114 test_sequence $env $db $key \ 115 $min $max $init $inc $csize 116 } 117 } 118 error_check_good db_close [$db close] 0 119 120 # Open a regular db; we expect success on the rest of the tests. 121 set db [eval {berkdb_open \ 122 -create -mode 0644} $args $omethod $testfile] 123 error_check_good dbopen [is_valid_db $db] TRUE 124 125 # Test increment and decrement with wrap. Cross from negative 126 # to positive integers. 127 set min -50 128 set max 99 129 set wrap "-wrap" 130 set csize 1 131 foreach { init inc } { $min -inc $max -dec } { 132 puts "\tTest$tnum.e: Test wrapping with $inc." 133 test_sequence $env $db $key \ 134 $min $max $init $inc $csize $wrap 135 } 136 137 # Test cachesize with wrap. 138 set min 0 139 set max 99 140 set init 0 141 set wrap "-wrap" 142 foreach csize $cachesizes { 143 puts "\tTest$tnum.f: Test -cachesize $csize with wrap." 144 test_sequence $env $db $key \ 145 $min $max $init $inc $csize $wrap 146 } 147 148 # Test multiple handles on the same sequence. 149 foreach csize $cachesizes { 150 puts "\tTest$tnum.g:\ 151 Test multiple handles (-cachesize $csize) with wrap." 152 test_sequence $env $db $key \ 153 $min $max $init $inc $csize $wrap 1 154 } 155 error_check_good db_close [$db close] 0 156 } 157 set fixed_len $orig_fixed_len 158 return 159} 160 161proc test_sequence { env db key min max init \ 162 {inc "-inc"} {csize 1} {wrap "" } {second_handle 0} } { 163 global rand_init 164 global errorCode 165 166 set txn "" 167 set txnenv 0 168 if { $env != "NULL" } { 169 set txnenv [is_txnenv $env] 170 } 171 172 set sargs " -thread " 173 174 # The variable "skip" is the cachesize with a direction. 175 set skip $csize 176 if { $inc == "-dec" } { 177 set skip [expr $csize * -1] 178 } 179 180 # The "limit" is the closest number to the end of the 181 # sequence we can ever see. 182 set limit [expr [expr $max + 1] - $csize] 183 if { $inc == "-dec" } { 184 set limit [expr [expr $min - 1] + $csize] 185 } 186 187 # The number of items in the sequence. 188 set n [expr [expr $max - $min] + 1] 189 190 # Calculate the number of values returned in the first 191 # cycle, and in all other cycles. 192 if { $inc == "-inc" } { 193 set firstcyclehits \ 194 [expr [expr [expr $max - $init] + 1] / $csize] 195 } elseif { $inc == "-dec" } { 196 set firstcyclehits \ 197 [expr [expr [expr $init - $min] + 1] / $csize] 198 } else { 199 puts "FAIL: unknown inc flag $inc" 200 } 201 set hitspercycle [expr $n / $csize] 202 203 # Create the sequence. 204 if { $txnenv == 1 } { 205 set t [$env txn] 206 error_check_good txn [is_valid_txn $t $env] TRUE 207 set txn "-txn $t" 208 } 209 set seq [eval {berkdb sequence} -create $sargs -cachesize $csize \ 210 $wrap -init $init -min $min -max $max $txn $inc $db $key] 211 error_check_good is_valid_seq [is_valid_seq $seq] TRUE 212 if { $second_handle == 1 } { 213 set seq2 [eval {berkdb sequence} -create $sargs $txn $db $key] 214 error_check_good is_valid_seq2 [is_valid_seq $seq2] TRUE 215 } 216 if { $txnenv == 1 } { 217 error_check_good txn_commit [$t commit] 0 218 } 219 220 # Exercise get options. 221 set getdb [$seq get_db] 222 error_check_good seq_get_db $getdb $db 223 224 set flags [$seq get_flags] 225 set exp_flags [list $inc $wrap] 226 foreach item $exp_flags { 227 if { [llength $item] == 0 } { 228 set idx [lsearch -exact $exp_flags $item] 229 set exp_flags [lreplace $exp_flags $idx $idx] 230 } 231 } 232 error_check_good get_flags $flags $exp_flags 233 234 set range [$seq get_range] 235 error_check_good get_range_min [lindex $range 0] $min 236 error_check_good get_range_max [lindex $range 1] $max 237 238 set cache [$seq get_cachesize] 239 error_check_good get_cachesize $cache $csize 240 241 # Within the loop, for each successive seq get we calculate 242 # the value we expect to receive, then do the seq get and 243 # compare. 244 # 245 # Always test some multiple of the number of items in the 246 # sequence; this tests overflow and wrap-around. 247 # 248 set mult 2 249 for { set i 0 } { $i < [expr $n * $mult] } { incr i } { 250 # 251 # Calculate expected return value. 252 # 253 # On the first cycle, start from init. 254 set expected [expr $init + [expr $i * $skip]] 255 if { $i >= $firstcyclehits && $wrap != "-wrap" } { 256 set expected "overflow" 257 } 258 259 # On second and later cycles, start from min or max. 260 # We do a second cycle only if wrapping is specified. 261 if { $wrap == "-wrap" } { 262 if { $inc == "-inc" && $expected > $limit } { 263 set j [expr $i - $firstcyclehits] 264 while { $j >= $hitspercycle } { 265 set j [expr $j - $hitspercycle] 266 } 267 set expected [expr $min + [expr $j * $skip]] 268 } 269 270 if { $inc == "-dec" && $expected < $limit } { 271 set j [expr $i - $firstcyclehits] 272 while { $j >= $hitspercycle } { 273 set j [expr $j - $hitspercycle] 274 } 275 set expected [expr $max + [expr $j * $skip]] 276 } 277 } 278 279 # Get return value. If we've got a second handle, choose 280 # randomly which handle does the seq get. 281 if { $env != "NULL" && [is_txnenv $env] } { 282 set syncarg " -nosync " 283 } else { 284 set syncarg "" 285 } 286 set errorCode NONE 287 if { $second_handle == 0 } { 288 catch {eval {$seq get} $syncarg $csize} res 289 } elseif { [berkdb random_int 0 1] == 0 } { 290 catch {eval {$seq get} $syncarg $csize} res 291 } else { 292 catch {eval {$seq2 get} $syncarg $csize} res 293 } 294 295 # Compare expected to actual value. 296 if { $expected == "overflow" } { 297 error_check_good overflow [is_substr $errorCode EINVAL] 1 298 } else { 299 error_check_good seq_get_wrap $res $expected 300 } 301 } 302 303 # A single handle requires a 'seq remove', but a second handle 304 # should be closed, and then we can remove the sequence. 305 if { $second_handle == 1 } { 306 error_check_good seq2_close [$seq2 close] 0 307 } 308 if { $txnenv == 1 } { 309 set t [$env txn] 310 error_check_good txn [is_valid_txn $t $env] TRUE 311 set txn "-txn $t" 312 } 313 error_check_good seq_remove [eval {$seq remove} $txn] 0 314 if { $txnenv == 1 } { 315 error_check_good txn_commit [$t commit] 0 316 } 317} 318