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