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