1# See the file LICENSE for redistribution information.
2#
3# Copyright (c) 2000,2008 Oracle.  All rights reserved.
4#
5# $Id: test102.tcl,v 12.6 2008/01/08 20:58:53 bostic Exp $
6#
7# TEST	test102
8# TEST	Bulk get test for record-based methods. [#2934]
9proc test102 { method {nsets 1000} {tnum "102"} args } {
10	source ./include.tcl
11	set args [convert_args $method $args]
12	set omethod [convert_method $method]
13
14	if { [is_rbtree $method] == 1 || [is_record_based $method] == 0} {
15		puts "Test$tnum skipping for method $method"
16		return
17	}
18
19	set txnenv 0
20	set eindex [lsearch -exact $args "-env"]
21	#
22	# If we are using an env, then testfile should just be the db name.
23	# Otherwise it is the test directory and the name.
24	if { $eindex == -1 } {
25		set basename $testdir/test$tnum
26		set env NULL
27		# If we've our own env, no reason to swap--this isn't
28		# an mpool test.
29		set carg { -cachesize {0 25000000 0} }
30	} else {
31		set basename test$tnum
32		incr eindex
33		set env [lindex $args $eindex]
34		set txnenv [is_txnenv $env]
35		if { $txnenv == 1 } {
36			puts "Skipping for environment with txns"
37			return
38		}
39		set testdir [get_home $env]
40		set carg {}
41	}
42	cleanup $testdir $env
43
44	puts "Test$tnum: $method ($args) Bulk get test"
45
46	# Open and populate the database.
47	puts "\tTest$tnum.a: Creating $method database\
48	    with $nsets entries."
49	set dargs "$carg $args"
50	set testfile $basename.db
51	set db [eval {berkdb_open_noerr -create} $omethod $dargs $testfile]
52	error_check_good db_open [is_valid_db $db] TRUE
53	t102_populate $db $method $nsets $txnenv 0
54
55	# Determine the pagesize so we can use it to size the buffer.
56	set stat [$db stat]
57	set pagesize [get_pagesize $stat]
58
59	# Run get tests.  The gettest should succeed as long as
60	# the buffer is at least as large as the page size.  Test for
61	# failure of a small buffer unless the page size is so small
62	# we can't define a smaller buffer (buffers must be multiples
63	# of 1024).  A "big buffer" should succeed in all cases because
64	# we define it to be larger than 65536, the largest page
65	# currently allowed.
66	set maxpage [expr 1024 * 64]
67	set bigbuf [expr $maxpage + 1024]
68	set smallbuf 1024
69
70	# Run regular db->get tests.
71	if { $pagesize > 1024 } {
72		t102_gettest $db $tnum b $smallbuf 1
73	} else {
74		puts "Skipping Test$tnum.b for small pagesize."
75	}
76	t102_gettest $db $tnum c $bigbuf 0
77
78	# Run cursor get tests.
79	if { $pagesize > 1024 } {
80		t102_gettest $db $tnum d $smallbuf 1
81	} else {
82		puts "Skipping Test$tnum.b for small pagesize."
83	}
84	t102_cgettest $db $tnum e $bigbuf 0
85
86	if { [is_fixed_length $method] == 1 } {
87		puts "Skipping overflow tests for fixed-length method $omethod."
88	} else {
89
90		# Set up for overflow tests
91		puts "\tTest$tnum.f: Growing database with overflow sets"
92		t102_populate $db $method [expr $nsets / 100] $txnenv 10000
93
94		# Run overflow get tests.  Test should fail for overflow pages
95		# with our standard big buffer but succeed at twice that size.
96		t102_gettest $db $tnum g $bigbuf 1
97		t102_gettest $db $tnum h [expr $bigbuf * 2] 0
98
99		# Run overflow cursor get tests.  Test will fail for overflow
100		# pages with 8K buffer but succeed with a large buffer.
101		t102_cgettest $db $tnum i 8192 1
102		t102_cgettest $db $tnum j $bigbuf 0
103	}
104	error_check_good db_close [$db close] 0
105}
106
107proc t102_gettest { db tnum letter bufsize expectfail } {
108	t102_gettest_body $db $tnum $letter $bufsize $expectfail 0
109}
110proc t102_cgettest { db tnum letter bufsize expectfail } {
111	t102_gettest_body $db $tnum $letter $bufsize $expectfail 1
112}
113
114# Basic get test
115proc t102_gettest_body { db tnum letter bufsize expectfail usecursor } {
116	global errorCode
117
118	foreach flag { multi multi_key } {
119		if { $usecursor == 0 } {
120			if { $flag == "multi_key" } {
121				# db->get does not allow multi_key
122				continue
123			} else {
124				set action "db get -$flag"
125			}
126		} else {
127			set action "dbc get -$flag -set/-next"
128		}
129		puts "\tTest$tnum.$letter: $action with bufsize $bufsize"
130
131		set allpassed TRUE
132		set saved_err ""
133
134		# Cursor for $usecursor.
135		if { $usecursor != 0 } {
136			set getcurs [$db cursor]
137			error_check_good \
138			    getcurs [is_valid_cursor $getcurs $db] TRUE
139		}
140
141		# Traverse DB with cursor;  do get/c_get($flag) on each item.
142		set dbc [$db cursor]
143		error_check_good is_valid_dbc [is_valid_cursor $dbc $db] TRUE
144		for { set dbt [$dbc get -first] } { [llength $dbt] != 0 } \
145		    { set dbt [$dbc get -next] } {
146			set key [lindex [lindex $dbt 0] 0]
147			set datum [lindex [lindex $dbt 0] 1]
148
149			if { $usecursor == 0 } {
150				set ret [catch \
151				    {eval $db get -$flag $bufsize $key} res]
152			} else {
153				set res {}
154				for { set ret [catch {eval $getcurs get\
155				    -$flag $bufsize -set $key} tres] } \
156				    { $ret == 0 && [llength $tres] != 0 } \
157				    { set ret [catch {eval $getcurs get\
158				    -$flag $bufsize -next} tres]} {
159					eval lappend res $tres
160				}
161			}
162
163			# If we expect a failure, be more tolerant if the above
164			# fails; just make sure it's a DB_BUFFER_SMALL or an
165			# EINVAL (if the buffer is smaller than the pagesize,
166			# it's EINVAL), mark it, and move along.
167			if { $expectfail != 0 && $ret != 0 } {
168				if { [is_substr $errorCode DB_BUFFER_SMALL] != 1 && \
169				    [is_substr $errorCode EINVAL] != 1 } {
170					error_check_good \
171					    "$flag failure errcode" \
172					    $errorCode "DB_BUFFER_SMALL or EINVAL"
173				}
174				set allpassed FALSE
175				continue
176			}
177			error_check_good "get_$flag ($key)" $ret 0
178		}
179
180		if { $expectfail == 1 } {
181			error_check_good allpassed $allpassed FALSE
182			puts "\t\tTest$tnum.$letter:\
183			    returned at least one DB_BUFFER_SMALL (as expected)"
184		} else {
185			error_check_good allpassed $allpassed TRUE
186			puts "\t\tTest$tnum.$letter: succeeded (as expected)"
187		}
188
189		error_check_good dbc_close [$dbc close] 0
190		if { $usecursor != 0 } {
191			error_check_good getcurs_close [$getcurs close] 0
192		}
193	}
194}
195
196proc t102_populate { db method nentries txnenv pad_bytes } {
197	source ./include.tcl
198
199	set did [open $dict]
200	set count 0
201	set txn ""
202	set pflags ""
203	set gflags " -recno "
204
205	while { [gets $did str] != -1 && $count < $nentries } {
206		set key [expr $count + 1]
207		set datastr $str
208		# Create overflow pages only if method is not fixed-length.
209		if { [is_fixed_length $method] == 0 } {
210			append datastr [repeat "a" $pad_bytes]
211		}
212		if { $txnenv == 1 } {
213			set t [$env txn]
214			error_check_good txn [is_valid_txn $t $env] TRUE
215			set txn "-txn $t"
216		}
217		set ret [eval {$db put} \
218		    $txn $pflags {$key [chop_data $method $datastr]}]
219		error_check_good put $ret 0
220		if { $txnenv == 1 } {
221			error_check_good txn [$t commit] 0
222		}
223
224		set ret [eval {$db get} $gflags {$key}]
225		error_check_good $key:dbget [llength $ret] 1
226		incr count
227	}
228	close $did
229
230	# This will make debugging easier, and since the database is
231	# read-only from here out, it's cheap.
232	error_check_good db_sync [$db sync] 0
233}
234
235