1# See the file LICENSE for redistribution information.
2#
3# Copyright (c) 1996,2008 Oracle.  All rights reserved.
4#
5# $Id: test014.tcl,v 12.6 2008/01/08 20:58:53 bostic Exp $
6#
7# TEST	test014
8# TEST	Exercise partial puts on short data
9# TEST		Run 5 combinations of numbers of characters to replace,
10# TEST		and number of times to increase the size by.
11# TEST
12# TEST	Partial put test, small data, replacing with same size.  The data set
13# TEST	consists of the first nentries of the dictionary.  We will insert them
14# TEST	(and retrieve them) as we do in test 1 (equal key/data pairs).  Then
15# TEST	we'll try to perform partial puts of some characters at the beginning,
16# TEST	some at the end, and some at the middle.
17proc test014 { method {nentries 10000} args } {
18	set fixed 0
19	set args [convert_args $method $args]
20
21	if { [is_fixed_length $method] == 1 } {
22		set fixed 1
23	}
24
25	puts "Test014: $method ($args) $nentries equal key/data pairs, put test"
26
27	# flagp indicates whether this is a postpend or a
28	# normal partial put
29	set flagp 0
30
31	eval {test014_body $method $flagp 1 1 $nentries} $args
32	eval {test014_body $method $flagp 1 4 $nentries} $args
33	eval {test014_body $method $flagp 2 4 $nentries} $args
34	eval {test014_body $method $flagp 1 128 $nentries} $args
35	eval {test014_body $method $flagp 2 16 $nentries} $args
36	if { $fixed == 0 } {
37		eval {test014_body $method $flagp 0 1 $nentries} $args
38		eval {test014_body $method $flagp 0 4 $nentries} $args
39		eval {test014_body $method $flagp 0 128 $nentries} $args
40
41		# POST-PENDS :
42		# partial put data after the end of the existent record
43		# chars: number of empty spaces that will be padded with null
44		# increase: is the length of the str to be appended (after pad)
45		#
46		set flagp 1
47		eval {test014_body $method $flagp 1 1 $nentries} $args
48		eval {test014_body $method $flagp 4 1 $nentries} $args
49		eval {test014_body $method $flagp 128 1 $nentries} $args
50		eval {test014_body $method $flagp 1 4 $nentries} $args
51		eval {test014_body $method $flagp 1 128 $nentries} $args
52	}
53	puts "Test014 complete."
54}
55
56proc test014_body { method flagp chars increase {nentries 10000} args } {
57	source ./include.tcl
58
59	set omethod [convert_method $method]
60
61	if { [is_fixed_length $method] == 1 && $chars != $increase } {
62		puts "Test014: $method: skipping replace\
63		    $chars chars with string $increase times larger."
64		return
65	}
66
67	if { $flagp == 1} {
68		puts "Test014: Postpending string of len $increase with \
69		    gap $chars."
70	} else {
71		puts "Test014: Replace $chars chars with string \
72		    $increase times larger"
73	}
74
75	# Create the database and open the dictionary
76	set txnenv 0
77	set eindex [lsearch -exact $args "-env"]
78	#
79	# If we are using an env, then testfile should just be the db name.
80	# Otherwise it is the test directory and the name.
81	if { $eindex == -1 } {
82		set testfile $testdir/test014.db
83		set env NULL
84	} else {
85		set testfile test014.db
86		incr eindex
87		set env [lindex $args $eindex]
88		set txnenv [is_txnenv $env]
89		if { $txnenv == 1 } {
90			append args " -auto_commit "
91			#
92			# If we are using txns and running with the
93			# default, set the default down a bit.
94			#
95			if { $nentries == 10000 } {
96				set nentries 100
97			}
98		}
99		set testdir [get_home $env]
100	}
101	set t1 $testdir/t1
102	set t2 $testdir/t2
103	set t3 $testdir/t3
104	cleanup $testdir $env
105
106	set db [eval {berkdb_open \
107	     -create -mode 0644} $args {$omethod $testfile}]
108	error_check_good dbopen [is_valid_db $db] TRUE
109
110	set gflags ""
111	set pflags ""
112	set txn ""
113	set count 0
114
115	if { [is_record_based $method] == 1 } {
116		append gflags " -recno"
117	}
118
119	puts "\tTest014.a: put/get loop"
120	# Here is the loop where we put and get each key/data pair
121	# We will do the initial put and then three Partial Puts
122	# for the beginning, middle and end of the string.
123	set did [open $dict]
124	while { [gets $did str] != -1 && $count < $nentries } {
125		if { [is_record_based $method] == 1 } {
126			set key [expr $count + 1]
127		} else {
128			set key $str
129		}
130		if { $flagp == 1 } {
131			# this is for postpend only
132			global dvals
133
134			# initial put
135			if { $txnenv == 1 } {
136				set t [$env txn]
137				error_check_good txn [is_valid_txn $t $env] TRUE
138				set txn "-txn $t"
139			}
140			set ret [eval {$db put} $txn {$key $str}]
141			if { $txnenv == 1 } {
142				error_check_good txn [$t commit] 0
143			}
144			error_check_good dbput $ret 0
145
146			set offset [string length $str]
147
148			# increase is the actual number of new bytes
149			# to be postpended (besides the null padding)
150			set data [repeat "P" $increase]
151
152			# chars is the amount of padding in between
153			# the old data and the new
154			set len [expr $offset + $chars + $increase]
155			set dvals($key) [binary format \
156			    a[set offset]x[set chars]a[set increase] \
157			    $str $data]
158			set offset [expr $offset + $chars]
159			if { $txnenv == 1 } {
160				set t [$env txn]
161				error_check_good txn [is_valid_txn $t $env] TRUE
162				set txn "-txn $t"
163			}
164			set ret [eval {$db put -partial [list $offset 0]} \
165			    $txn {$key $data}]
166			error_check_good dbput:post $ret 0
167			if { $txnenv == 1 } {
168				error_check_good txn [$t commit] 0
169			}
170		} else {
171			if { $txnenv == 1 } {
172				set t [$env txn]
173				error_check_good txn [is_valid_txn $t $env] TRUE
174				set txn "-txn $t"
175			}
176			partial_put $method $db $txn \
177			    $gflags $key $str $chars $increase
178			if { $txnenv == 1 } {
179				error_check_good txn [$t commit] 0
180			}
181		}
182		incr count
183	}
184	close $did
185
186	# Now make sure that everything looks OK
187	puts "\tTest014.b: check entire file contents"
188	if { $txnenv == 1 } {
189		set t [$env txn]
190		error_check_good txn [is_valid_txn $t $env] TRUE
191		set txn "-txn $t"
192	}
193	dump_file $db $txn $t1 test014.check
194	if { $txnenv == 1 } {
195		error_check_good txn [$t commit] 0
196	}
197	error_check_good db_close [$db close] 0
198
199	# Now compare the keys to see if they match the dictionary (or ints)
200	if { [is_record_based $method] == 1 } {
201		set oid [open $t2 w]
202		for {set i 1} {$i <= $nentries} {set i [incr i]} {
203			puts $oid $i
204		}
205		close $oid
206		file rename -force $t1 $t3
207	} else {
208		set q q
209		filehead $nentries $dict $t3
210		filesort $t3 $t2
211		filesort $t1 $t3
212	}
213
214	error_check_good \
215	    Test014:diff($t3,$t2) [filecmp $t3 $t2] 0
216
217	puts "\tTest014.c: close, open, and dump file"
218	# Now, reopen the file and run the last test again.
219	open_and_dump_file $testfile $env \
220	    $t1 test014.check dump_file_direction "-first" "-next"
221
222	if { [string compare $omethod "-recno"] != 0 } {
223		filesort $t2 $t3
224		file rename -force $t3 $t2
225		filesort $t1 $t3
226	}
227
228	error_check_good \
229	    Test014:diff($t3,$t2) [filecmp $t3 $t2] 0
230	# Now, reopen the file and run the last test again in the
231	# reverse direction.
232	puts "\tTest014.d: close, open, and dump file in reverse direction"
233	open_and_dump_file $testfile $env $t1 \
234	    test014.check dump_file_direction "-last" "-prev"
235
236	if { [string compare $omethod "-recno"] != 0 } {
237		filesort $t2 $t3
238		file rename -force $t3 $t2
239		filesort $t1 $t3
240	}
241
242	error_check_good \
243	    Test014:diff($t3,$t2) [filecmp $t3 $t2] 0
244}
245
246# Check function for test014; keys and data are identical
247proc test014.check { key data } {
248	global dvals
249
250	error_check_good key"$key"_exists [info exists dvals($key)] 1
251	error_check_good "data mismatch for key $key" $data $dvals($key)
252}
253