1# See the file LICENSE for redistribution information.
2#
3# Copyright (c) 1999,2008 Oracle.  All rights reserved.
4#
5# $Id: sdb006.tcl,v 12.6 2008/01/08 20:58:53 bostic Exp $
6#
7# TEST	sdb006
8# TEST	Tests intra-subdb join
9# TEST
10# TEST	We'll test 2-way, 3-way, and 4-way joins and figure that if those work,
11# TEST	everything else does as well.  We'll create test databases called
12# TEST	sub1.db, sub2.db, sub3.db, and sub4.db.  The number on the database
13# TEST	describes the duplication -- duplicates are of the form 0, N, 2N, 3N,
14# TEST	...  where N is the number of the database.  Primary.db is the primary
15# TEST	database, and sub0.db is the database that has no matching duplicates.
16# TEST	All of these are within a single database.
17#
18# We should test this on all btrees, all hash, and a combination thereof
19proc sdb006 {method {nentries 100} args } {
20	source ./include.tcl
21	global rand_init
22
23	# NB: these flags are internal only, ok
24	set args [convert_args $method $args]
25	set omethod [convert_method $method]
26
27	if { [is_record_based $method] == 1 || [is_rbtree $method] } {
28		puts "\tSubdb006 skipping for method $method."
29		return
30	}
31
32	set txnenv 0
33	set eindex [lsearch -exact $args "-env"]
34	#
35	# If we are using an env, then testfile should just be the db name.
36	# Otherwise it is the test directory and the name.
37	if { $eindex == -1 } {
38		set testfile $testdir/subdb006.db
39		set env NULL
40	} else {
41		set testfile subdb006.db
42		incr eindex
43		set env [lindex $args $eindex]
44		set txnenv [is_txnenv $env]
45		if { $txnenv == 1 } {
46			append args " -auto_commit "
47			if { $nentries == 100 } {
48				# !!!
49				# nentries must be greater than the number
50				# of do_join_subdb calls below.
51				#
52				set nentries 35
53			}
54		}
55		set testdir [get_home $env]
56	}
57	berkdb srand $rand_init
58
59	set oargs $args
60	foreach opt {" -dup" " -dupsort"} {
61		append args $opt
62
63		puts "Subdb006: $method ( $args ) Intra-subdb join"
64		set txn ""
65		#
66		# Get a cursor in each subdb and move past the end of each
67		# subdb.  Make sure we don't end up in another subdb.
68		#
69		puts "\tSubdb006.a: Intra-subdb join"
70
71		if { $env != "NULL" } {
72			set testdir [get_home $env]
73		}
74		cleanup $testdir $env
75
76		set psize 8192
77		set duplist {0 50 25 16 12}
78		set numdb [llength $duplist]
79		build_all_subdb $testfile [list $method] $psize \
80		    $duplist $nentries $args
81
82		# Build the primary
83		puts "Subdb006: Building the primary database $method"
84		set oflags "-create -mode 0644 [conv $omethod \
85		    [berkdb random_int 1 2]]"
86		set db [eval {berkdb_open} $oflags $oargs $testfile primary.db]
87		error_check_good dbopen [is_valid_db $db] TRUE
88		for { set i 0 } { $i < 1000 } { incr i } {
89			if { $txnenv == 1 } {
90				set t [$env txn]
91				error_check_good txn [is_valid_txn $t $env] TRUE
92				set txn "-txn $t"
93			}
94			set key [format "%04d" $i]
95			set ret [eval {$db put} $txn {$key stub}]
96			error_check_good "primary put" $ret 0
97			if { $txnenv == 1 } {
98				error_check_good txn [$t commit] 0
99			}
100		}
101		error_check_good "primary close" [$db close] 0
102		set did [open $dict]
103		gets $did str
104		do_join_subdb $testfile primary.db "1 0" $str $oargs
105		gets $did str
106		do_join_subdb $testfile primary.db "2 0" $str $oargs
107		gets $did str
108		do_join_subdb $testfile primary.db "3 0" $str $oargs
109		gets $did str
110		do_join_subdb $testfile primary.db "4 0" $str $oargs
111		gets $did str
112		do_join_subdb $testfile primary.db "1" $str $oargs
113		gets $did str
114		do_join_subdb $testfile primary.db "2" $str $oargs
115		gets $did str
116		do_join_subdb $testfile primary.db "3" $str $oargs
117		gets $did str
118		do_join_subdb $testfile primary.db "4" $str $oargs
119		gets $did str
120		do_join_subdb $testfile primary.db "1 2" $str $oargs
121		gets $did str
122		do_join_subdb $testfile primary.db "1 2 3" $str $oargs
123		gets $did str
124		do_join_subdb $testfile primary.db "1 2 3 4" $str $oargs
125		gets $did str
126		do_join_subdb $testfile primary.db "2 1" $str $oargs
127		gets $did str
128		do_join_subdb $testfile primary.db "3 2 1" $str $oargs
129		gets $did str
130		do_join_subdb $testfile primary.db "4 3 2 1" $str $oargs
131		gets $did str
132		do_join_subdb $testfile primary.db "1 3" $str $oargs
133		gets $did str
134		do_join_subdb $testfile primary.db "3 1" $str $oargs
135		gets $did str
136		do_join_subdb $testfile primary.db "1 4" $str $oargs
137		gets $did str
138		do_join_subdb $testfile primary.db "4 1" $str $oargs
139		gets $did str
140		do_join_subdb $testfile primary.db "2 3" $str $oargs
141		gets $did str
142		do_join_subdb $testfile primary.db "3 2" $str $oargs
143		gets $did str
144		do_join_subdb $testfile primary.db "2 4" $str $oargs
145		gets $did str
146		do_join_subdb $testfile primary.db "4 2" $str $oargs
147		gets $did str
148		do_join_subdb $testfile primary.db "3 4" $str $oargs
149		gets $did str
150		do_join_subdb $testfile primary.db "4 3" $str $oargs
151		gets $did str
152		do_join_subdb $testfile primary.db "2 3 4" $str $oargs
153		gets $did str
154		do_join_subdb $testfile primary.db "3 4 1" $str $oargs
155		gets $did str
156		do_join_subdb $testfile primary.db "4 2 1" $str $oargs
157		gets $did str
158		do_join_subdb $testfile primary.db "0 2 1" $str $oargs
159		gets $did str
160		do_join_subdb $testfile primary.db "3 2 0" $str $oargs
161		gets $did str
162		do_join_subdb $testfile primary.db "4 3 2 1" $str $oargs
163		gets $did str
164		do_join_subdb $testfile primary.db "4 3 0 1" $str $oargs
165
166		close $did
167	}
168}
169