1# See the file LICENSE for redistribution information.
2#
3# Copyright (c) 1996-2009 Oracle.  All rights reserved.
4#
5# $Id$
6#
7# TEST	test013
8# TEST	Partial put test
9# TEST		Overwrite entire records using partial puts.
10# TEST		Make sure that NOOVERWRITE flag works.
11# TEST
12# TEST	1. Insert 10000 keys and retrieve them (equal key/data pairs).
13# TEST	2. Attempt to overwrite keys with NO_OVERWRITE set (expect error).
14# TEST	3. Actually overwrite each one with its datum reversed.
15# TEST
16# TEST	No partial testing here.
17proc test013 { method {nentries 10000} args } {
18	global errorCode
19	global errorInfo
20	global fixed_len
21
22	source ./include.tcl
23
24	set args [convert_args $method $args]
25	set omethod [convert_method $method]
26
27	# Create the database and open the dictionary
28	set txnenv 0
29	set eindex [lsearch -exact $args "-env"]
30	#
31	# If we are using an env, then testfile should just be the db name.
32	# Otherwise it is the test directory and the name.
33	if { $eindex == -1 } {
34		set testfile $testdir/test013.db
35		set env NULL
36	} else {
37		set testfile test013.db
38		incr eindex
39		set env [lindex $args $eindex]
40		set txnenv [is_txnenv $env]
41		if { $txnenv == 1 } {
42			append args " -auto_commit "
43			#
44			# If we are using txns and running with the
45			# default, set the default down a bit.
46			#
47			if { $nentries == 10000 } {
48				set nentries 100
49			}
50		}
51		set testdir [get_home $env]
52	}
53	puts "Test013: $method ($args) $nentries equal key/data pairs, put test"
54
55	set t1 $testdir/t1
56	set t2 $testdir/t2
57	set t3 $testdir/t3
58	cleanup $testdir $env
59
60	set db [eval {berkdb_open \
61	     -create -mode 0644} $args {$omethod $testfile}]
62	error_check_good dbopen [is_valid_db $db] TRUE
63
64	set did [open $dict]
65
66	set pflags ""
67	set gflags ""
68	set txn ""
69	set count 0
70
71	if { [is_record_based $method] == 1 } {
72		set checkfunc test013_recno.check
73		append gflags " -recno"
74		global kvals
75	} else {
76		set checkfunc test013.check
77	}
78	puts "\tTest013.a: put/get loop"
79	# Here is the loop where we put and get each key/data pair
80	while { [gets $did str] != -1 && $count < $nentries } {
81		if { [is_record_based $method] == 1 } {
82			set key [expr $count + 1]
83			set kvals($key) [pad_data $method $str]
84		} else {
85			set key $str
86		}
87		if { $txnenv == 1 } {
88			set t [$env txn]
89			error_check_good txn [is_valid_txn $t $env] TRUE
90			set txn "-txn $t"
91		}
92		set ret [eval {$db put} \
93		    $txn $pflags {$key [chop_data $method $str]}]
94		error_check_good put $ret 0
95
96		set ret [eval {$db get} $gflags $txn {$key}]
97		error_check_good \
98		    get $ret [list [list $key [pad_data $method $str]]]
99		if { $txnenv == 1 } {
100			error_check_good txn [$t commit] 0
101		}
102		incr count
103	}
104	close $did
105
106	# Now we will try to overwrite each datum, but set the
107	# NOOVERWRITE flag.
108	puts "\tTest013.b: overwrite values with NOOVERWRITE flag."
109	set did [open $dict]
110	set count 0
111	while { [gets $did str] != -1 && $count < $nentries } {
112		if { [is_record_based $method] == 1 } {
113			set key [expr $count + 1]
114		} else {
115			set key $str
116		}
117
118		if { $txnenv == 1 } {
119			set t [$env txn]
120			error_check_good txn [is_valid_txn $t $env] TRUE
121			set txn "-txn $t"
122		}
123		set ret [eval {$db put} $txn $pflags \
124		    {-nooverwrite $key [chop_data $method $str]}]
125		error_check_good put [is_substr $ret "DB_KEYEXIST"] 1
126
127		# Value should be unchanged.
128		set ret [eval {$db get} $txn $gflags {$key}]
129		error_check_good \
130		    get $ret [list [list $key [pad_data $method $str]]]
131		if { $txnenv == 1 } {
132			error_check_good txn [$t commit] 0
133		}
134		incr count
135	}
136	close $did
137
138	# Now we will replace each item with its datum capitalized.
139	puts "\tTest013.c: overwrite values with capitalized datum"
140	set did [open $dict]
141	set count 0
142	while { [gets $did str] != -1 && $count < $nentries } {
143		if { [is_record_based $method] == 1 } {
144			set key [expr $count + 1]
145		} else {
146			set key $str
147		}
148		set rstr [string toupper $str]
149		if { $txnenv == 1 } {
150			set t [$env txn]
151			error_check_good txn [is_valid_txn $t $env] TRUE
152			set txn "-txn $t"
153		}
154		set r [eval {$db put} \
155		    $txn $pflags {$key [chop_data $method $rstr]}]
156		error_check_good put $r 0
157
158		# Value should be changed.
159		set ret [eval {$db get} $txn $gflags {$key}]
160		error_check_good \
161		    get $ret [list [list $key [pad_data $method $rstr]]]
162		if { $txnenv == 1 } {
163			error_check_good txn [$t commit] 0
164		}
165		incr count
166	}
167	close $did
168
169	# Now make sure that everything looks OK
170	puts "\tTest013.d: check entire file contents"
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	dump_file $db $txn $t1 $checkfunc
177	if { $txnenv == 1 } {
178		error_check_good txn [$t commit] 0
179	}
180	error_check_good db_close [$db close] 0
181
182	# Now compare the keys to see if they match the dictionary (or ints)
183	if { [is_record_based $method] == 1 } {
184		set oid [open $t2 w]
185		for {set i 1} {$i <= $nentries} {incr i} {
186			puts $oid $i
187		}
188		close $oid
189		file rename -force $t1 $t3
190	} else {
191		set q q
192		filehead $nentries $dict $t3
193		filesort $t3 $t2
194		filesort $t1 $t3
195	}
196
197	error_check_good \
198	    Test013:diff($t3,$t2) [filecmp $t3 $t2] 0
199
200	puts "\tTest013.e: close, open, and dump file"
201	# Now, reopen the file and run the last test again.
202	eval open_and_dump_file $testfile $env $t1 $checkfunc \
203	    dump_file_direction "-first" "-next" $args
204
205	if { [is_record_based $method] == 0 } {
206		filesort $t1 $t3
207	}
208
209	error_check_good \
210	    Test013:diff($t3,$t2) [filecmp $t3 $t2] 0
211
212	# Now, reopen the file and run the last test again in the
213	# reverse direction.
214	puts "\tTest013.f: close, open, and dump file in reverse direction"
215	eval open_and_dump_file $testfile $env $t1 $checkfunc \
216	    dump_file_direction "-last" "-prev" $args
217
218	if { [is_record_based $method] == 0 } {
219		filesort $t1 $t3
220	}
221
222	error_check_good \
223	    Test013:diff($t3,$t2) [filecmp $t3 $t2] 0
224}
225
226# Check function for test013; keys and data are identical
227proc test013.check { key data } {
228	error_check_good \
229	    "key/data mismatch for $key" $data [string toupper $key]
230}
231
232proc test013_recno.check { key data } {
233	global dict
234	global kvals
235
236	error_check_good key"$key"_exists [info exists kvals($key)] 1
237	error_check_good \
238	    "data mismatch for $key" $data [string toupper $kvals($key)]
239}
240