1# See the file LICENSE for redistribution information.
2#
3# Copyright (c) 1996,2008 Oracle.  All rights reserved.
4#
5# $Id: test043.tcl,v 12.6 2008/01/08 20:58:53 bostic Exp $
6#
7# TEST	test043
8# TEST	Recno renumbering and implicit creation test
9# TEST	Test the Record number implicit creation and renumbering options.
10proc test043 { method {nentries 10000} args} {
11	source ./include.tcl
12
13	set do_renumber [is_rrecno $method]
14	set args [convert_args $method $args]
15	set omethod [convert_method $method]
16
17	puts "Test043: $method ($args)"
18
19	if { [is_record_based $method] != 1 } {
20		puts "Test043 skipping for method $method"
21		return
22	}
23
24	# Create the database and open the dictionary
25	set txnenv 0
26	set eindex [lsearch -exact $args "-env"]
27	#
28	# If we are using an env, then testfile should just be the db name.
29	# Otherwise it is the test directory and the name.
30	if { $eindex == -1 } {
31		set testfile $testdir/test043.db
32		set env NULL
33	} else {
34		set testfile test043.db
35		incr eindex
36		set env [lindex $args $eindex]
37		set txnenv [is_txnenv $env]
38		if { $txnenv == 1 } {
39			append args " -auto_commit "
40			#
41			# If we are using txns and running with the
42			# default, set the default down a bit.
43			#
44			if { $nentries == 10000 } {
45				set nentries 100
46			}
47		}
48		set testdir [get_home $env]
49	}
50	cleanup $testdir $env
51
52	# Create the database
53	set db [eval {berkdb_open -create -mode 0644} $args \
54		{$omethod $testfile}]
55	error_check_good dbopen [is_valid_db $db] TRUE
56
57	set pflags ""
58	set gflags " -recno"
59	set txn ""
60
61	# First test implicit creation and retrieval
62	set count 1
63	set interval 5
64	if { $nentries < $interval } {
65		set nentries [expr $interval + 1]
66	}
67	puts "\tTest043.a: insert keys at $interval record intervals"
68	while { $count <= $nentries } {
69		if { $txnenv == 1 } {
70			set t [$env txn]
71			error_check_good txn [is_valid_txn $t $env] TRUE
72			set txn "-txn $t"
73		}
74		set ret [eval {$db put} \
75		    $txn $pflags {$count [chop_data $method $count]}]
76		error_check_good "$db put $count" $ret 0
77		if { $txnenv == 1 } {
78			error_check_good txn [$t commit] 0
79		}
80		set last $count
81		incr count $interval
82	}
83
84	puts "\tTest043.b: get keys using DB_FIRST/DB_NEXT"
85	if { $txnenv == 1 } {
86		set t [$env txn]
87		error_check_good txn [is_valid_txn $t $env] TRUE
88		set txn "-txn $t"
89	}
90	set dbc [eval {$db cursor} $txn]
91	error_check_good "$db cursor" [is_valid_cursor $dbc $db] TRUE
92
93	set check 1
94	for { set rec [$dbc get -first] } { [llength $rec] != 0 } {
95	    set rec [$dbc get -next] } {
96		set k [lindex [lindex $rec 0] 0]
97		set d [pad_data $method [lindex [lindex $rec 0] 1]]
98		error_check_good "$dbc get key==data" [pad_data $method $k] $d
99		error_check_good "$dbc get sequential" $k $check
100		if { $k > $nentries } {
101			error_check_good "$dbc get key too large" $k $nentries
102		}
103		incr check $interval
104	}
105
106	# Now make sure that we get DB_KEYEMPTY for non-existent keys
107	puts "\tTest043.c: Retrieve non-existent keys"
108	global errorInfo
109
110	set check 1
111	for { set rec [$dbc get -first] } { [llength $rec] != 0 } {
112		set rec [$dbc get -next] } {
113		set k [lindex [lindex $rec 0] 0]
114
115		set ret [eval {$db get} $txn $gflags {[expr $k + 1]}]
116		error_check_good "$db \
117		    get [expr $k + 1]" $ret [list]
118
119		incr check $interval
120		# Make sure we don't do a retrieve past the end of file
121		if { $check >= $last }  {
122			break
123		}
124	}
125
126	# Now try deleting and make sure the right thing happens.
127	puts "\tTest043.d: Delete tests"
128	set rec [$dbc get -first]
129	error_check_bad "$dbc get -first" [llength $rec] 0
130	error_check_good  "$dbc get -first key" [lindex [lindex $rec 0] 0] 1
131	error_check_good  "$dbc get -first data" \
132	    [lindex [lindex $rec 0] 1] [pad_data $method 1]
133
134	# Delete the first item
135	error_check_good "$dbc del" [$dbc del] 0
136
137	# Retrieving 1 should always fail
138	set ret [eval {$db get} $txn $gflags {1}]
139	error_check_good "$db get 1" $ret [list]
140
141	# Now, retrieving other keys should work; keys will vary depending
142	# upon renumbering.
143	if { $do_renumber == 1 } {
144		set count [expr 0 + $interval]
145		set max [expr $nentries - 1]
146	} else {
147		set count [expr 1 + $interval]
148		set max $nentries
149	}
150
151	while { $count <= $max } {
152	set rec [eval {$db get} $txn $gflags {$count}]
153		if { $do_renumber == 1 } {
154			set data [expr $count + 1]
155		} else {
156			set data $count
157		}
158		error_check_good "$db get $count" \
159		    [pad_data $method $data] [lindex [lindex $rec 0] 1]
160		incr count $interval
161	}
162	set max [expr $count - $interval]
163
164	puts "\tTest043.e: Verify LAST/PREV functionality"
165	set count $max
166	for { set rec [$dbc get -last] } { [llength $rec] != 0 } {
167	    set rec [$dbc get -prev] } {
168		set k [lindex [lindex $rec 0] 0]
169		set d [lindex [lindex $rec 0] 1]
170		if { $do_renumber == 1 } {
171			set data [expr $k + 1]
172		} else {
173			set data $k
174		}
175		error_check_good \
176		    "$dbc get key==data" [pad_data $method $data] $d
177		error_check_good "$dbc get sequential" $k $count
178		if { $k > $nentries } {
179			error_check_good "$dbc get key too large" $k $nentries
180		}
181		set count [expr $count - $interval]
182		if { $count < 1 } {
183			break
184		}
185	}
186	error_check_good dbc_close [$dbc close] 0
187	if { $txnenv == 1 } {
188		error_check_good txn [$t commit] 0
189	}
190	error_check_good db_close [$db close] 0
191}
192