File: test131.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 (475 lines) | stat: -rw-r--r-- 15,183 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
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
# See the file LICENSE for redistribution information.
#
# Copyright (c) 2011, 2013 Oracle and/or its affiliates.  All rights reserved.
#
# $Id$
#
# TEST	test131
# TEST  Test foreign database operations.
# TEST  Create a foreign db, and put some records into it.
# TEST  Then associate the foreign db with a secondary db, and
# TEST  put records into the primary db.
# TEST  Do operations in the foreign db and check results.
# TEST  Finally, verify the foreign relation between the foreign db 
# TEST  and secondary db.
# TEST  Here, we test three different foreign delete constraints:
# TEST      - DB_FOREIGN_ABORT
# TEST      - DB_FOREIGN_CASCADE
# TEST      - DB_FOREIGN_NULLIFY

proc test131 {method {nentries 1000} {tnum "131"} {ndups 5} {subdb 0} 
    {inmem 0} args } {
	source ./include.tcl

	# For rrecno, when keys are deleted, the ones after will move forward,
	# and the keys change. It is not good to use rrecno for the primary
	# database.
	if {[is_rrecno $method]} {
		puts "Skipping test$tnum for $method test."
		return
	}

	set sub_msg ""
	# Check if we use sub databases.
	if { $subdb } {
		if {[is_queue $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		
		}
		if {[is_heap $method]} {
			puts "Skipping test$tnum with sub database\
			     for $method."
			return
		}
		# Check if the sub databases should be in-memory.
		if {$inmem} {
			set sub_msg "using in-memory sub databases"
		} else {
			set sub_msg "using sub databases"
		}
	}

	# If we are using an env, then basename should just be the name prefix.
	# Otherwise it is the test directory and the name prefix.
	set eindex [lsearch -exact $args "-env"]
	set txnenv 0
	set txn ""
	if { $eindex == -1 } {
		set basename $testdir/test$tnum
		set env NULL
		if {$subdb} {
			puts "Skipping test$tnum $sub_msg for non-env test."
			return
		}
	} else {
		set basename test$tnum
		set nentries 200
		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

	# To simplify the case, just set the type of foreign database as 
	# btree or hash. And for the secondary database, the type is dupsort
	# hash/btree. 
	set origargs $args
	set args [convert_args $method $args]
	set omethod [convert_method $method]

	puts "Test$tnum: $method ($args) Foreign operations $sub_msg."

	# The type-pairs for the foreign and secondary databases.
	set typepairs {
		{"-btree" "-btree"}
		{"-btree" "-hash"}
		{"-hash" "-btree"}
		{"-hash" "-hash"}
	}
	
	# The sub procs which test specific foreign operations.
	set subtests {
		{"test131_sub1" "-abort" "0"}
		{"test131_sub2" "-cascade" "0"}
		{"test131_sub3" "-nullify test131_nullify_cb1" "1"}
		{"test131_sub4" "-nullify test131_nullify_cb2" "0"}
	}

	set i 0

	foreach subtest $subtests {
		foreach typepair $typepairs {
			# Initialize the names
			set pri_subname ""
			set sec_subname ""
			set foreign_subname ""
			set pri_file $basename.db
			set sec_file $basename.db
			set foreign_file $basename.db
			if {$inmem} {
				set pri_file ""
				set sec_file ""
				set foreign_file ""
			}

			set foreign_proc [lindex $subtest 0]
			set foreign_arg [lindex $subtest 1]
			set foreign_vrfy [lindex $subtest 2]
			set foreign_method [lindex $typepair 0]
			set sec_method [lindex $typepair 1]
			if {$subdb} {
				set pri_subname "primary_db$i"
				set sec_subname "secondary_db$i"
				set foreign_subname "foreign_db$i"
			} else {
				set pri_file "${basename}_primary$i.db"
				set sec_file "${basename}_secondary$i.db"
				set foreign_file "${basename}_foreign$i.db"
			}

			puts "\tTest$tnum.$i subtest={$subtest}, \
			    typepair={$typepair}"

			# Skip partition range test and compression test
			# when there are non-btree databases.
			if {![is_btree $foreign_method] || \
			    ![is_btree $sec_method]} {
				set skip 0
				if {[is_partitioned $origargs] && \
				    ![is_partition_callback $origargs]} {
					set skip 1
				}
				if {[is_compressed $origargs]} {
					set skip 1
				}
				if {$skip} {
					puts "\tSkipping for {$origargs}"
					continue
				}
			}

			set txn ""
			if {$txnenv == 1} {
				set t [$env txn]
				error_check_good txn \
				    [is_valid_txn $t $env] TRUE
				set txn "-txn $t"
			}
			# Open the foreign database.
			puts "\tTest$tnum.$i.a Open and truncate the databases."
			set foreign_args [convert_args $foreign_method $origargs]
			set foreign_db [eval berkdb_open_noerr -create \
			    -mode 0644 $foreign_method $foreign_args \
			    {$foreign_file} $foreign_subname]
			error_check_good foreign_db_open \
			    [is_valid_db $foreign_db] TRUE

			# Open the primary database.
			set pri_db [eval berkdb_open_noerr -create -mode 0644 \
			    $omethod $args {$pri_file} $pri_subname]
			error_check_good pri_db_open \
			    [is_valid_db $pri_db] TRUE

			# Open the secondary database.
			set secargs [convert_args $sec_method $origargs]
			set sec_db [eval berkdb_open_noerr -create -mode 0644 \
			    $sec_method $secargs -dup -dupsort \
			    {$sec_file} $sec_subname]
			error_check_good sec_db_open \
			    [is_valid_db $sec_db] TRUE

			# Truncate the databases.
			# For some tests(e.g. run_secenv), we will run this 
			# unit twice. The "cleanup $testdir" could clean the
			# on-disk database files, but it can not clean the 
			# in-memory ones, so the records are still in the 
			# in-memory databases, which will affect our test.
			# So, we need to truncate these databases first.
			error_check_good foreign_db_trunc \
			    [expr [eval $foreign_db truncate $txn] >= 0] 1
			error_check_good pri_db_trunc \
			    [expr [eval $pri_db truncate $txn] >= 0] 1
			error_check_good sec_db_trunc \
			    [expr [eval $sec_db truncate $txn] >= 0] 1

			# Establish the relations between the databases.
			set ret [eval $pri_db \
			    associate -create $txn test131_sec_cb1 $sec_db]
			error_check_good db_associate $ret 0

			set ret [eval $foreign_db \
			    associate_foreign $foreign_arg $sec_db]
			error_check_good db_associate_foreign $ret 0

			puts "\tTest$tnum.$i.b Populate the foreign database."			
			test131_populate_foreigndb $txn $foreign_db $nentries	

			# Put records into the primary database.
			puts "\tTest$tnum.$i.c Populate primary database."
			test131_populate_pridb \
			    $txn $pri_db $method $nentries $ndups

			# Check records in the secondary database.
			puts "\tTest$tnum.$i.d\
			    Check records in secondary database."
			test131_check_secdb $txn $sec_db $nentries $ndups

			# Update the foreign database.
			puts "\tTest$tnum.$i.e Update the foreign database."
			test131_update_foreigndb $txn $foreign_db $nentries

			# Delete the keys only in the foreign database.
			puts "\tTest$tnum.$i.f Delete foreign-only keys."
			test131_delitems_foreigndb $txn $foreign_db $nentries

			# Test different foreign delete constraints.
			puts "\tTest$tnum.$i.g\
			    Test specific foreign delete constraints."
			$foreign_proc $txn $foreign_db $pri_db $sec_db \
			    $nentries $ndups "Test$tnum.$i.g"

			puts "\tTest$tnum.$i.h Verifying foreign key \
			    relationships ..."
			error_check_good verify_foreign [verify_foreign \
			    $txn $foreign_db $sec_db 0] $foreign_vrfy

			if {$txnenv == 1} {
				error_check_good txn_commit [$t commit] 0
			}

			error_check_good foreign_db_close [$foreign_db close] 0
			error_check_good pri_db_close [$pri_db close] 0
			error_check_good sec_db_close [$sec_db close] 0

			incr i
		}
	}
}

# Test for DB_FOREIGN_ABORT
# Delete the keys which exist in the secondary database.
# The delete should fail because DB_FOREIGN_ABORT has been set.
proc test131_sub1 {txn foreign_db pri_db sec_db nentries ndups msghdr} {
	puts "\t\t$msghdr.1 Test DB_FOREIGN_ABORT"
	set nentries2 [expr $nentries / 2]
	for {set i 0} {$i < $nentries2} {incr i} {
		set ret [catch {eval $foreign_db del $txn $i} res]
		error_check_bad foreign_del $ret 0
		error_check_good "check DB_FOREIGN_CONFLICT" \
		    [is_substr $res DB_FOREIGN_CONFLICT] 1		
		error_check_good check_ndups \
		    [llength [eval $sec_db get $txn $i]] $ndups
		error_check_good check_foreign \
		    [llength [eval $foreign_db get $txn $i]] 1
	}
}

# Test the DB_FOREIGN_CASCADE.
# Delete the keys which exist in the secondary database.
# The delete should succeed, and all the related records in
# the secondary database should be deleted as well.
proc test131_sub2 {txn foreign_db pri_db sec_db nentries ndups msghdr} {
	puts "\t\t$msghdr.1 Test DB_FOREIGN_CASCADE"
	set nentries2 [expr $nentries / 2]
	for {set i 0} {$i < $nentries2} {incr i} {
		set ret [catch {eval $foreign_db del $txn $i} res]
		error_check_good foreign_del $ret 0
		error_check_good check_ndups \
		    [llength [eval $sec_db get $txn $i]] 0
		error_check_good check_foreign \
		    [llength [eval $foreign_db get $txn $i]] 0
	}
}

# Test the DB_FOREIGN_NULLIFY with a bad nullify function(
# the nullify function does not change the data).
# Delete the keys which exist in the secondary database.
# The delete should fail, but the records in the foreign
# database should be removed anyway, while the related records
# in the primary/secondary are still there.
proc test131_sub3 {txn foreign_db pri_db sec_db nentries ndups msghdr} {
	puts "\t\t$msghdr.1 \
	    Test DB_FOREIGN_NULLIFY with a bad nullify function."
	set nentries2 [expr $nentries / 2]
	for {set i 0} {$i < $nentries2} {incr i} {
		set ret [catch {eval $foreign_db del $txn $i} res]
		error_check_good foreign_del $ret 0
		error_check_good check_ndups \
		    [llength [eval $sec_db get $txn $i]] $ndups
		error_check_good check_foreign \
		    [llength [eval $foreign_db get $txn $i]] 0
	}
}

# Test the DB_FOREIGN_NULLIFY with a good nullify function.
# Delete the keys which exist in the secondary database.
# The delete should succeed, and the records in the foreign
# database should be removed, while the related records
# in the primary/secondary are changed.
proc test131_sub4 {txn foreign_db pri_db sec_db nentries ndups msghdr} {
	puts "\t\t$msghdr.1 \
	    Test DB_FOREIGN_NULLIFY with a good nullify function."
	set nentries2 [expr $nentries / 2 - 1]
	for {set i 0} {$i < $nentries2} {incr i 2} {
		set ret [catch {eval $foreign_db del $txn $i} res]
		error_check_good foreign_del $ret 0
		error_check_good check_ndups \
		    [llength [eval $sec_db get $txn $i]] 0
		error_check_good check_foreign \
		    [llength [eval $foreign_db get $txn $i]] 0
		set newkey [expr $i + 1]
		error_check_good check_ndups \
		    [llength [eval $sec_db get $txn $newkey]] [expr $ndups * 2]
		error_check_good check_foreign \
		    [llength [eval $foreign_db get $txn $newkey]] 1
	}
}

# The callback function for secondary database.
proc test131_sec_cb1 {pkey pdata} {
	set indx [string first "-" $pdata]
	error_check_bad good_indx [expr $indx > 0] 0
	return [string range $pdata 0 [expr $indx - 1]]
}

# The 1st callback function for foreign.
proc test131_nullify_cb1 {pkey pdata fkey} {
	return $pdata
}

# The 2nd callback function for foreign.
proc test131_nullify_cb2 {pkey pdata fkey} {
	# We should make sure the size does not grow, since
	# that will cause queue test to fail.
	set indx [string first "-" $pdata]
	error_check_bad good_indx [expr $indx > 0] 0
	set num [string range $pdata 0 [expr $indx - 1]]
	set str [string range $pdata [expr $indx + 1] end]
	return "[expr $num + 1]-$str"
}

# Put records into the foreign database.
proc test131_populate_foreigndb {txn foreign_db nentries} {
	global alphabet
	for {set i 0} {$i < $nentries} {incr i} {
		set ret [eval $foreign_db put $txn $i $i$alphabet]	       
		error_check_good foreign_put $ret 0
	}
}

# Update the records in the foreign database.
proc test131_update_foreigndb {txn foreign_db nentries} {
	global alphabet
	for {set i 0} {$i < $nentries} {incr i} {
		set ret [eval $foreign_db get $txn $i]
		error_check_good check_pair [llength $ret] 1
		set key [lindex [lindex $ret 0] 0]
		set data [lindex [lindex $ret 0] 1]
		error_check_good check_key $key $i
		set ret [eval $foreign_db put $txn $key $data-NEW]
		error_check_good foreign_put $ret 0
	}
}

# Delete items which only exist in the foreign database.
proc test131_delitems_foreigndb {txn foreign_db nentries} {
	global alphabet
	set nentries2 [expr $nentries / 2]
	for {set i $nentries2} {$i < $nentries} {incr i 2} {
		set ret [eval $foreign_db del $txn $i]	       
		error_check_good foreign_del $ret 0
		set ret [eval $foreign_db get $txn $i]
		error_check_good check_empty [llength $ret] 0
	}
}

# Put records into the primary database.
# Here we make every key in the secondary database
# has $ndups duplicate records.
proc test131_populate_pridb {txn pri_db pri_method nentries ndups} {
	source ./include.tcl
	global alphabet
	
	set lastindx [expr [string length $alphabet] - 1]
	# We just cover the first half of keys in the foreign database.
	set nentries2 [expr $nentries / 2]
	set number 1
	for {set i 0} {$i < $nentries2} {incr i} {
		for {set j 0} {$j < $ndups} {incr j} {
			set beg [berkdb random_int 0 $lastindx]
			set end [berkdb random_int 0 $lastindx]
			if {$beg <= $end} {
				set str [string range $alphabet $beg $end]
			} else {
				set str [string range $alphabet $end $beg]
			}
			if {[is_record_based $pri_method] == 1} {
				set key $number
			} else {
				set key $number$str
			}
			set ret [eval $pri_db put $txn $key \
			    [make_fixed_length $pri_method "$i-$str"]]
			error_check_good pri_db_put $ret 0
			error_check_good pri_db_get \
			    [llength [eval $pri_db get $txn $key]] 1		
			incr number
		}
	}

	set nentries2 [expr $nentries + $nentries2]
	for {set i $nentries} {$i < $nentries2} {incr i} {
		for {set j 0} {$j < $ndups} {incr j} {
			set beg [berkdb random_int 0 $lastindx]
			set end [berkdb random_int 0 $lastindx]
			if {$beg <= $end} {
				set str [string range $alphabet $beg $end]
			} else {
				set str [string range $alphabet $end $beg]
			}
			if {[is_record_based $pri_method] == 1} {
				set key $number
			} else {
				set key $number$str
			}			
			set ret [catch {eval $pri_db put $txn $key \
			    [make_fixed_length $pri_method "$i-$str"]} res]
			error_check_bad pri_db_put $ret 0
			error_check_good "check DB_FOREIGN_CONFLICT" \
			    [is_substr $res DB_FOREIGN_CONFLICT] 1
			error_check_good pri_db_get \
			    [llength [eval $pri_db get $txn $key]] 0
			incr number
		}
	}
}

# Check the records in the secondary database.
proc test131_check_secdb {txn sec_db nentries ndups} {
	set nentries2 [expr $nentries / 2]
	for {set i 0} {$i < $nentries2} {incr i} {
		set ret [eval $sec_db get $txn $i]
		error_check_good check_rec_num [llength $ret] $ndups
	}
	for {set i $nentries2} {$i < $nentries} {incr i} {
		set ret [eval $sec_db get $txn $i]
		error_check_good check_rec_num [llength $ret] 0
	}

	set nentries2 [expr $nentries + $nentries2]
	for {set i $nentries} {$i < $nentries2} {incr i} {
		set ret [eval $sec_db get $txn $i]
		error_check_good check_rec_num [llength $ret] 0
	}
}