File: test126.tcl

package info (click to toggle)
db5.3 5.3.28%2Bdfsg2-1
  • links: PTS, VCS
  • area: main
  • in suites: bookworm
  • size: 158,500 kB
  • sloc: ansic: 448,411; java: 111,824; tcl: 80,544; sh: 44,264; cs: 33,697; cpp: 21,604; perl: 14,557; xml: 10,799; makefile: 4,077; javascript: 1,998; yacc: 1,003; awk: 965; sql: 801; erlang: 342; python: 216; php: 24; asm: 14
file content (385 lines) | stat: -rw-r--r-- 11,297 bytes parent folder | download | duplicates (9)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
# See the file LICENSE for redistribution information.
#
# Copyright (c) 2010, 2013 Oracle and/or its affiliates.  All rights reserved.
#
# $Id$
#
# TEST	test126
# TEST	Test database bulk update for non-duplicate databases.
# TEST
# TEST	Put with -multiple, then with -multiple_key,
# TEST	and make sure the items in database are what we put.
# TEST  Later, delete some items with -multiple, then with -multiple_key,
# TEST	and make sure if the correct items are deleted.

proc test126 {method { nentries 10000 } { tnum "126" } {callback 1} 
    {subdb 0} {secondary 0} {sort_multiple 0} args } {
	source ./include.tcl

	# For rrecno, when keys are deleted, the ones after will move forward,
	# and the keys change, which is not good to verify after delete.
	# So, we skip rrecno temporarily.
        if {[is_rrecno $method] } {
		puts "Skipping test$tnum for $method test."
		return
	}

	# It is only makes sense for btree database to sort bulk buffer.
	if {$sort_multiple && ![is_btree $method]} {
		puts "Skipping test$tnum for $method with -sort_multiple."
		return
	}

	# For compressed databases, we need to sort the items in
	# the bulk buffer before doing the bulk put/delete operations.
	if {[is_compressed $args] && !$sort_multiple} {
		puts "Skipping test$tnum for compressed databases\
		    without -sort_multiple."
		return
	}

	set subname ""
	set sub_msg ""

	# Check if we use sub database.
	if { $subdb } {
		if {[is_queue $method] || [is_heap $method]} {
			puts "Skipping test$tnum with sub database for $method."
			    return
		}
		if {[is_partitioned $args]} {
			puts "Skipping test$tnum with sub database\
		       	    for partitioned $method test."
			    return		
		}
		set subname "subdb"
		set sub_msg "using sub databases"
	}

	set sec_msg ""
	# Check if we use secondary database.
	if { $secondary } {
		set sec_msg "with secondary databases"
	}

	# If we are using an env, then testfile should just be the db name.
	# Otherwise it is the test directory and the name.
	set eindex [lsearch -exact $args "-env"]
	set txnenv 0
	set txn ""
	if { $eindex == -1 } {
		set testfile $testdir/test$tnum.db
		set env NULL
		if {$subdb && $secondary } {
			puts "Skipping test$tnum $sub_msg $sec_msg for non-env test."
			return
		}
	} else {
		set testfile test$tnum.db
		incr eindex
		set env [lindex $args $eindex]
		set txnenv [is_txnenv $env]
		if { $txnenv == 1 } {
			append args " -auto_commit "
		}
		set testdir [get_home $env]
	}

	cleanup $testdir $env
	set sec_args $args

	set args [convert_args $method $args]
	set omethod [convert_method $method]	

	set extra_op ""
	if {$sort_multiple} {
		set extra_op "-sort_multiple"
	}

	puts "Test$tnum: $method ($args)\
	    Database bulk update $sub_msg $sec_msg."

	set db [eval {berkdb_open_noerr -create -mode 0644} \
	    $args $omethod $testfile $subname]
	error_check_good dbopen [is_valid_db $db] TRUE

	# Open the secondary database and do association. 
	# This is the test for [#18878].
	if { $secondary } {
		if { $subdb } {
			set sec_subname "subdb-secondary"
			set sec_testfile $testfile
		} else {
			set sec_subname ""
			if { $eindex == -1 } {
				set sec_testfile $testdir/test$tnum-secondary.db
			} else {
				set sec_testfile test$tnum-secondary.db
			}
		}
		# Open a simple dupsort btree database.
		# In order to be consistent, we need to use all the passed-in 
		# am-unrelated flags.
		set sec_args [convert_args "btree" $sec_args]
		set sec_db [eval {berkdb_open_noerr -create -mode 0644} $sec_args \
		    -dup -dupsort -btree $sec_testfile $sec_subname]
		error_check_good secdb_open [is_valid_db $sec_db] TRUE
		set ret [$db associate -create [callback_n $callback] $sec_db]
		error_check_good db_associate $ret 0
	}
	
	if { $txnenv == 1 } {
		set t [$env txn]
		error_check_good txn [is_valid_txn $t $env] TRUE
		set txn "-txn $t"
	}

	set did [open $dict]
	set count 0

	
	# Do bulk put.
	# First, we put half the entries using put -multiple.
	# Then, we put the rest half using put -multiple_key.

	puts "\tTest$tnum.a: Bulk put data using -multiple $extra_op."
	set key_list1 {}
	set data_list1 {}
	while { [gets $did str] != -1 && $count < $nentries / 2 } {
		if { [is_record_based $method] == 1 } {
			set key [expr $count + 1]
		} else {
			set key $str
			set str [reverse $str]
		}
		set data [make_fixed_length $method $str]
		lappend key_list1 $key
		lappend data_list1 $data
		incr count
		if { [is_heap $method] } {
		    set ret [eval {$db put} $txn {$key $data}]
		}
	}

	if { [is_heap $method] == 0 } {
	 	set ret [eval {$db put} $txn -multiple $extra_op \
 		    {$key_list1 $data_list1}]
 		error_check_good "put(-multiple $extra_op)" $ret 0
	}

	# Put again, should succeed
 	set ret [eval {$db put} $txn -multiple $extra_op \
 	    {$key_list1 $data_list1}]
 	error_check_good "put_again(-multiple $extra_op)" $ret 0
  
 	puts "\tTest$tnum.b: Bulk put data using -multiple_key $extra_op."
	set pair_list1 {}
	while { [gets $did str] != -1 && $count < $nentries } {
		if { [is_record_based $method] == 1 } {
			set key [expr $count + 1]
		} else {
			set key $str
			set str [reverse $str]
		}
		set data [make_fixed_length $method $str]
		lappend pair_list1 $key $data
		incr count	
		if { [is_heap $method] } {
			set ret [eval {$db put} $txn $key $data]
		}
	}

	if { [is_heap $method] == 0 } {
	 	set ret [eval {$db put} $txn -multiple_key $extra_op \
		    {$pair_list1}]
 		error_check_good "put(-multiple_key $extra_op)" $ret 0	
	}

	# Put again, should succeed
 	set ret [eval {$db put} $txn -multiple_key $extra_op \
 	    {$pair_list1}]
 	error_check_good "put_again(-multiple_key $extra_op)" $ret 0

	close $did	

	puts "\tTest$tnum.c: Verify the data after bulk put."
	set len [llength $pair_list1]
	for {set indx1 0; set indx2 1} {$indx2 < $len} \
	    {incr indx1 2; incr indx2 2} {
		lappend key_list1 [lindex $pair_list1 $indx1]
		lappend data_list1 [lindex $pair_list1 $indx2]
	}

	test126_check_prirecords $db $key_list1 $data_list1 $txn

	if { $secondary } {
		puts "\tTest$tnum.c.2: Verify the data in secondary database."
		set sec_key_list {}
		foreach key $key_list1 data $data_list1 {
			lappend sec_key_list \
			    [[callback_n $callback] $key $data]
		}
		test126_check_secrecords $sec_db $sec_key_list \
		    $key_list1 $data_list1 $txn
	}

	puts "\tTest$tnum.d: Bulk delete data using -multiple $extra_op."
	set key_list2 {}
	for { set i 0 } { $i < $nentries} { incr i 3 } {
		lappend key_list2 [lindex $key_list1 $i]
	}
	set ret [eval {$db del} $txn -multiple $extra_op {$key_list2}]
	error_check_good "del(-multiple $extra_op)" $ret 0

	# Delete again, should return DB_NOTFOUND/DB_KEYEMPTY.
	set ret [catch {eval {$db del} $txn -multiple $extra_op \
	    {$key_list2}} res]
	error_check_good {Check DB_NOTFOUND/DB_KEYEMPTY} \
	    [expr [is_substr $res DB_NOTFOUND] || \
	    [is_substr $res DB_KEYEMPTY]] 1

	puts "\tTest$tnum.e: Bulk delete data using -multiple_key $extra_op."
	set pair_list2 {}
	for { set i 1 } { $i < $nentries} { incr i 3} {
		lappend pair_list2 [lindex $key_list1 $i] \
		    [lindex $data_list1 $i]
	}

	set ret [eval {$db del} $txn -multiple_key $extra_op {$pair_list2}]
	error_check_good "del(-multiple_key $extra_op)" $ret 0

	# Delete again, should return DB_NOTFOUND/DB_KEYEMPTY.
	set ret [catch {eval {$db del} $txn -multiple_key $extra_op \
	    {$pair_list2}} res]
	error_check_good {Check DB_NOTFOUND/DB_KEYEMPTY} \
	    [expr [is_substr $res DB_NOTFOUND] || \
	    [is_substr $res DB_KEYEMPTY]] 1


	puts "\tTest$tnum.f: Verify the data after bulk delete."	

	# Check if the specified items are deleted
	set dbc [eval $db cursor $txn]
	error_check_good $dbc [is_valid_cursor $dbc $db] TRUE
	set len [llength $key_list2]
	for {set i 0} {$i < $len} {incr i} {
		set key [lindex $key_list2 $i]
		set pair [$dbc get -set $key]
		error_check_good pair [llength $pair] 0
	}

	set len [llength $pair_list2]
	for {set indx1 0; set indx2 1} {$indx2 < $len} \
       	    {incr indx1 2; incr indx2 2} {
		set key [lindex $pair_list2 $indx1]
		set data [lindex $pair_list2 $indx2]
		set pair [$dbc get -get_both $key $data]
		error_check_good pair [llength $pair] 0
	}

	error_check_good $dbc.close [$dbc close] 0	

	# Remove the deleted items from the original key-data lists.
	# Since the primary database is non-duplicate, it is enough 
	# for us to just compare using keys.
	set orig_key_list $key_list1
	set orig_data_list $data_list1
	set key_list1 {}
	set data_list1 {}
	set i 0
	set j 0
	set k 0
	while {$i < $nentries} {
		set key1 [lindex $orig_key_list $i]
		set key2 [lindex $key_list2 $j]
		set key3 [lindex $pair_list2 $k]
		if {$key1 == $key2} {
			incr i
			incr j
		} elseif {$key1  == $key3} {
			incr i
	    		incr k 2
		} else {
			lappend key_list1 $key1
			lappend data_list1 [lindex $orig_data_list $i]
			incr i
		}
	}

	test126_check_prirecords $db $key_list1 $data_list1 $txn

	if { $secondary } {
		puts "\tTest$tnum.f.2: Verify the data in secondary database."
		set sec_key_list {}
		foreach key $key_list1 data $data_list1 {
			lappend sec_key_list \
			    [[callback_n $callback] $key $data]
		}
		test126_check_secrecords $sec_db $sec_key_list \
		    $key_list1 $data_list1 $txn
	}
	
	if { $txnenv == 1 } {
		error_check_good txn_commit [$t commit] 0
	}
	error_check_good db_close [$db close] 0
	if { $secondary } {
		error_check_good secdb_close [$sec_db close] 0
	}
}

proc test126_check_prirecords {db key_list data_list txnarg} {

	set dbc [eval $db cursor $txnarg]
	error_check_good $dbc [is_valid_cursor $dbc $db] TRUE

	# Check if all the records are in key_list(key) and data_list(data).
	for {set pair [$dbc get -first]} {[llength $pair] > 0} \
	    {set pair [$dbc get -next]} {
		set key [lindex [lindex $pair 0] 0]
		set data [lindex [lindex $pair 0] 1]		
		set index [lsearch -exact $key_list $key]
		error_check_bad key_index $index -1
		error_check_good data $data [lindex $data_list $index]
	}

	# Check if all the items in the lists are in the database.
	set len [llength $key_list]
	for {set i 0} {$i < $len} {incr i} {
		set pair [$dbc get -get_both [lindex $key_list $i] \
		    [lindex $data_list $i]]
		error_check_bad pair [llength $pair] 0
	}

	error_check_good $dbc.close [$dbc close] 0
}

proc test126_check_secrecords {db sec_key_list pri_key_list data_list txnarg} {

	set dbc [eval $db cursor $txnarg]
	error_check_good $dbc [is_valid_cursor $dbc $db] TRUE

	# Check if all the records are in the lists
	for {set pair [$dbc pget -first]} {[llength $pair] > 0} \
	    {set pair [$dbc pget -next]} {
		set sec_key [lindex [lindex $pair 0] 0]
		set pri_key [lindex [lindex $pair 0] 1]
		set data [lindex [lindex $pair 0] 2]		
		set index [lsearch -exact $pri_key_list $pri_key]
		error_check_bad key_index $index -1
		error_check_good seckey $sec_key [lindex $sec_key_list $index]
		error_check_good data1 $data [lindex $data_list $index]
	}

	# Check if all the items in the lists are in the secondary database.
	set len [llength $sec_key_list]
	for {set i 0} {$i < $len} {incr i} {
		set pair [$dbc pget -get_both [lindex $sec_key_list $i] \
		    [lindex $pri_key_list $i]]
		error_check_bad pair [llength $pair] 0
		error_check_good data2 [lindex $data_list $i] \
		    [lindex [lindex $pair 0] 2]
	}

	error_check_good $dbc.close [$dbc close] 0
}