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