1#See the file LICENSE for redistribution information.
2#
3# Copyright (c) 2001,2008 Oracle.  All rights reserved.
4#
5# $Id: siutils.tcl,v 12.7 2008/01/08 20:58:53 bostic Exp $
6#
7# Secondary index utilities.  This file used to be known as
8# sindex.tcl.
9#
10# The secondary index tests themselves live in si0*.tcl.
11#
12# Standard number of secondary indices to create if a single-element
13# list of methods is passed into the secondary index tests.
14global nsecondaries
15set nsecondaries 2
16
17# The callback function we use for each given secondary in most tests
18# is a simple function of its place in the list of secondaries (0-based)
19# and the access method (since recnos may need different callbacks).
20#
21# !!!
22# Note that callbacks 0-3 return unique secondary keys if the input data
23# are unique;  callbacks 4 and higher may not, so don't use them with
24# the normal wordlist and secondaries that don't support dups.
25# The callbacks that incorporate a key don't work properly with recno
26# access methods, at least not in the current test framework (the
27# error_check_good lines test for e.g. 1foo, when the database has
28# e.g. 0x010x000x000x00foo).
29proc callback_n { n } {
30	switch $n {
31		0 { return _s_reversedata }
32		1 { return _s_noop }
33		2 { return _s_concatkeydata }
34		3 { return _s_concatdatakey }
35		4 { return _s_reverseconcat }
36		5 { return _s_truncdata }
37		6 { return _s_constant }
38		7 { return _s_twokeys }
39		8 { return _s_variablekeys }
40	}
41	return _s_noop
42}
43
44proc _s_noop { a b } { return $b }
45proc _s_reversedata { a b } { return [reverse $b] }
46proc _s_truncdata { a b } { return [string range $b 1 end] }
47proc _s_concatkeydata { a b } { return $a$b }
48proc _s_concatdatakey { a b } { return $b$a }
49proc _s_reverseconcat { a b } { return [reverse $a$b] }
50proc _s_constant { a b } { return "constant-data" }
51proc _s_twokeys { a b } { return [list 1 2] }
52proc _s_variablekeys { a b } {
53	set rlen [string length $b]
54	set result {}
55	for {set i 0} {$i < $rlen} {incr i} {
56		lappend $result $i
57	}
58	return $result
59}
60
61# Should the check_secondary routines print lots of output?
62set verbose_check_secondaries 0
63
64# Given a primary database handle, a list of secondary handles, a
65# number of entries, and arrays of keys and data, verify that all
66# databases have what they ought to.
67proc check_secondaries { pdb sdbs nentries keyarr dataarr {pref "Check"} \
68    {errp NONE} {errs NONE} {errsg NONE}} {
69	upvar $keyarr keys
70	upvar $dataarr data
71	global verbose_check_secondaries
72
73	if { [string compare $errp NONE] != 0 } {
74		upvar $errp errorp
75	}
76	set errorp 0
77	if { [string compare $errs NONE] != 0 } {
78		upvar $errs errors
79	}
80	set errors 0
81	if { [string compare $errsg NONE] != 0 } {
82		upvar $errsg errorsg
83	}
84	set errorsg 0
85	# Make sure each key/data pair is in the primary.
86	if { $verbose_check_secondaries } {
87		puts "\t\t$pref.1: Each key/data pair is in the primary"
88	}
89	for { set i 0 } { $i < $nentries } { incr i } {
90		if { [string equal $errp NONE] } {
91			error_check_good pdb_get($i) [$pdb get $keys($i)] \
92			    [list [list $keys($i) $data($i)]]
93		} else {
94			set stat [catch {$pdb get $keys($i)} ret]
95			if { $stat == 1 } {
96				set errorp $ret
97				break
98			} else {
99				error_check_good pdb_get($i) $ret \
100				    [list [list $keys($i) $data($i)]]
101			}
102		}
103	}
104
105	for { set j 0 } { $j < [llength $sdbs] } { incr j } {
106		# Make sure each key/data pair is in this secondary.
107		if { $verbose_check_secondaries } {
108			puts "\t\t$pref.2:\
109			    Each skey/key/data tuple is in secondary #$j"
110		}
111		set sdb [lindex $sdbs $j]
112		set nskeys 0
113		for { set i 0 } { $i < $nentries } { incr i } {
114			set skeys [[callback_n $j] $keys($i) $data($i)]
115			if { [llength $skeys] == 0 } {
116				set skeys [list $skeys]
117			}
118			foreach skey $skeys {
119				incr nskeys
120				# Check with pget on the secondary.
121				set stat [catch {$sdb pget -get_both \
122				    $skey $keys($i)} ret]
123				if { [string equal $errs NONE] } {
124					error_check_good stat $stat 0
125					error_check_good sdb($j)_pget($i) $ret \
126					    [list [list \
127					    $skey $keys($i) $data($i)]]
128				} else {
129					if { $stat == 1 } {
130						set errors $ret
131					} else {
132						error_check_good \
133						    sdb($j)_pget($i) $ret \
134						    [list [list \
135						    $skey $keys($i) $data($i)]]
136					}
137				}
138				# Check again with get on the secondary.  Since
139				# get_both is not an allowed option with get on
140				# a secondary handle, we can't guarantee an
141				# exact match on method 5 and over.  We just
142				# make sure that one of the returned key/data
143				# pairs is the right one.
144				if { $j >= 5 } {
145					error_check_good sdb($j)_get($i) \
146					    [is_substr [$sdb get $skey] \
147					    [list [list $skey $data($i)]]] 1
148				} else {
149					set stat [catch {$sdb get $skey} ret]
150					if { [string equal $errs NONE] } {
151						error_check_good \
152						    sdb($j)_get($i) $ret \
153						    [list [list \
154						    $skey $data($i)]]
155					} else {
156						if { $stat == 1 } {
157							set errorsg $ret
158							break
159						} else {
160							error_check_good \
161							    sdb($j)_get($i) \
162							    $ret [list [list \
163							    $skey $data($i)]]
164						}
165					}
166				}
167				#
168				# We couldn't break above because we need to
169				# execute the errorsg error as well.
170				#
171				if { $errors != 0 } {
172					break
173				}
174			}
175		}
176		if { $errors != 0 || $errorsg != 0 } {
177			break
178		}
179
180		# Make sure this secondary contains only $nskeys
181		# items.
182		if { $verbose_check_secondaries } {
183			puts "\t\t$pref.3: Secondary #$j has $nskeys items"
184		}
185		set dbc [$sdb cursor]
186		error_check_good dbc($i) \
187		    [is_valid_cursor $dbc $sdb] TRUE
188		for { set k 0 } { [llength [$dbc get -next]] > 0 } \
189		    { incr k } { }
190		error_check_good numitems($i) $k $nskeys
191		error_check_good dbc($i)_close [$dbc close] 0
192	}
193	if { $errorp != 0 || $errors != 0 || $errorsg != 0 } {
194		return
195	}
196
197	if { $verbose_check_secondaries } {
198		puts "\t\t$pref.4: Primary has $nentries items"
199	}
200	set dbc [$pdb cursor]
201	error_check_good pdbc [is_valid_cursor $dbc $pdb] TRUE
202	for { set k 0 } { [llength [$dbc get -next]] > 0 } { incr k } { }
203	error_check_good numitems $k $nentries
204	error_check_good pdbc_close [$dbc close] 0
205}
206
207# Given a primary database handle and a list of secondary handles, walk
208# through the primary and make sure all the secondaries are correct,
209# then walk through the secondaries and make sure the primary is correct.
210#
211# This is slightly less rigorous than the normal check_secondaries--we
212# use it whenever we don't have up-to-date "keys" and "data" arrays.
213proc cursor_check_secondaries { pdb sdbs nentries { pref "Check" } } {
214	global verbose_check_secondaries
215
216	# Make sure each key/data pair in the primary is in each secondary.
217	set pdbc [$pdb cursor]
218	error_check_good ccs_pdbc [is_valid_cursor $pdbc $pdb] TRUE
219	set i 0
220	if { $verbose_check_secondaries } {
221		puts "\t\t$pref.1:\
222		    Key/data in primary => key/data in secondaries"
223	}
224
225	for { set dbt [$pdbc get -first] } { [llength $dbt] > 0 } \
226	    { set dbt [$pdbc get -next] } {
227		incr i
228		set pkey [lindex [lindex $dbt 0] 0]
229		set pdata [lindex [lindex $dbt 0] 1]
230		for { set j 0 } { $j < [llength $sdbs] } { incr j } {
231			set sdb [lindex $sdbs $j]
232			# Check with pget.
233			foreach skey [[callback_n $j] $pkey $pdata] {
234			set sdbt [$sdb pget -get_both $skey $pkey]
235			error_check_good pkey($pkey,$j) \
236			    [lindex [lindex $sdbt 0] 1] $pkey
237			error_check_good pdata($pdata,$j) \
238			    [lindex [lindex $sdbt 0] 2] $pdata
239			}
240		}
241	}
242	error_check_good ccs_pdbc_close [$pdbc close] 0
243	error_check_good primary_has_nentries $i $nentries
244
245	for { set j 0 } { $j < [llength $sdbs] } { incr j } {
246		if { $verbose_check_secondaries } {
247			puts "\t\t$pref.2:\
248			    Key/data in secondary #$j => key/data in primary"
249		}
250		set sdb [lindex $sdbs $j]
251		set sdbc [$sdb cursor]
252		error_check_good ccs_sdbc($j) [is_valid_cursor $sdbc $sdb] TRUE
253		for { set dbt [$sdbc pget -first] } { [llength $dbt] > 0 } \
254		    { set dbt [$sdbc pget -next] } {
255			set pkey [lindex [lindex $dbt 0] 1]
256			set pdata [lindex [lindex $dbt 0] 2]
257			error_check_good pdb_get($pkey/$pdata,$j) \
258			    [$pdb get -get_both $pkey $pdata] \
259			    [list [list $pkey $pdata]]
260		}
261
262		# To exercise pget -last/pget -prev, we do it backwards too.
263		for { set dbt [$sdbc pget -last] } { [llength $dbt] > 0 } \
264		    { set dbt [$sdbc pget -prev] } {
265			set pkey [lindex [lindex $dbt 0] 1]
266			set pdata [lindex [lindex $dbt 0] 2]
267			error_check_good pdb_get_bkwds($pkey/$pdata,$j) \
268			    [$pdb get -get_both $pkey $pdata] \
269			    [list [list $pkey $pdata]]
270		}
271
272		error_check_good ccs_sdbc_close($j) [$sdbc close] 0
273	}
274}
275
276# The secondary index tests take a list of the access methods that
277# each array ought to use.  Convert at one blow into a list of converted
278# argses and omethods for each method in the list.
279proc convert_argses { methods largs } {
280	set ret {}
281	foreach m $methods {
282		lappend ret [convert_args $m $largs]
283	}
284	return $ret
285}
286proc convert_methods { methods } {
287	set ret {}
288	foreach m $methods {
289		lappend ret [convert_method $m]
290	}
291	return $ret
292}
293