1# See the file LICENSE for redistribution information.
2#
3# Copyright (c) 1996,2008 Oracle.  All rights reserved.
4#
5# $Id: test006.tcl,v 12.6 2008/01/08 20:58:53 bostic Exp $
6#
7# TEST	test006
8# TEST	Small keys/medium data
9# TEST		Put/get per key
10# TEST		Keyed delete and verify
11# TEST
12# TEST	Keyed delete test.
13# TEST	Create database.
14# TEST	Go through database, deleting all entries by key.
15# TEST	Then do the same for unsorted and sorted dups.
16proc test006 { method {nentries 10000} {reopen 0} {tnum "006"} \
17    {ndups 5} args } {
18
19	test006_body $method $nentries $reopen $tnum 1 "" "" $args
20
21	# For methods supporting dups, run the test with sorted and
22	# with unsorted dups.
23	if { [is_btree $method] == 1 || [is_hash $method] == 1 } {
24		foreach {sort flags} {unsorted -dup sorted "-dup -dupsort"} {
25			test006_body $method $nentries $reopen \
26			    $tnum $ndups $sort $flags $args
27		}
28	}
29}
30
31proc test006_body { method {nentries 10000} {reopen 0} {tnum "006"} \
32    {ndups 5} sort flags {largs ""} } {
33	global is_je_test
34	source ./include.tcl
35
36	set do_renumber [is_rrecno $method]
37        set largs [convert_args $method $largs]
38        set omethod [convert_method $method]
39
40	set tname Test$tnum
41	set dbname test$tnum
42
43	# Create the database and open the dictionary
44	set txnenv 0
45	set eindex [lsearch -exact $largs "-env"]
46	#
47	# If we are using an env, then testfile should just be the db name.
48	# Otherwise it is the test directory and the name.
49	if { $eindex == -1 } {
50		set basename $testdir/$dbname
51		set env NULL
52	} else {
53		set basename $dbname
54		incr eindex
55		set env [lindex $largs $eindex]
56		if { $is_je_test && $sort == "unsorted" } {
57			puts "Test$tnum skipping $sort duplicates for JE"
58			return
59		}
60		set txnenv [is_txnenv $env]
61		if { $txnenv == 1 } {
62			append largs " -auto_commit "
63			#
64			# If we are using txns and running with the
65			# default, set the default down a bit.
66			#
67			if { $nentries == 10000 } {
68				set nentries 100
69			}
70		}
71		set testdir [get_home $env]
72	}
73	puts -nonewline "$tname: $method ($flags $largs) "
74	puts -nonewline "$nentries equal small key; medium data pairs"
75	if {$reopen == 1} {
76		puts " (with close)"
77	} else {
78		puts ""
79	}
80
81	set pflags ""
82	set gflags ""
83	set txn ""
84	if { [is_record_based $method] == 1 } {
85		append gflags " -recno"
86	}
87
88	cleanup $testdir $env
89
90	# Here is the loop where we put and get each key/data pair.
91
92	set count 0
93	set testfile $basename$sort.db
94	set db [eval {berkdb_open -create \
95	    -mode 0644} $largs $flags {$omethod $testfile}]
96	error_check_good dbopen [is_valid_db $db] TRUE
97
98	puts "\t$tname.a: put/get loop"
99	set did [open $dict]
100	while { [gets $did str] != -1 && $count < $nentries } {
101                if { [is_record_based $method] == 1 } {
102                        set key [expr $count + 1 ]
103                } else {
104                        set key $str
105                }
106
107		set str [make_data_str $str]
108		for { set j 1 } { $j <= $ndups } {incr j} {
109			set datastr $j$str
110			if { $txnenv == 1 } {
111	 			set t [$env txn]
112				error_check_good txn \
113				    [is_valid_txn $t $env] TRUE
114				set txn "-txn $t"
115			}
116			set ret [eval {$db put} $txn $pflags \
117			    {$key [chop_data $method $datastr]}]
118			error_check_good put $ret 0
119			if { $txnenv == 1 } {
120				error_check_good txn \
121				    [$t commit] 0
122			}
123		}
124		incr count
125	}
126	close $did
127
128	# Close and reopen database, if testing reopen.
129
130	if { $reopen == 1 } {
131		error_check_good db_close [$db close] 0
132
133		set db [eval {berkdb_open} $largs {$testfile}]
134		error_check_good dbopen [is_valid_db $db] TRUE
135	}
136
137	# Now we will get each key from the DB and compare the results
138	# to the original, then delete it.
139
140	puts "\t$tname.b: get/delete loop"
141	if { $txnenv == 1 } {
142		set t [$env txn]
143		error_check_good txn [is_valid_txn $t $env] TRUE
144		set txn "-txn $t"
145	}
146	set dbc [eval {$db cursor} $txn]
147	error_check_good db_cursor [is_substr $dbc $db] 1
148
149	set i 1
150	for { set ret [$dbc get -first] } \
151	    { [string length $ret] != 0 } \
152	    { set ret [$dbc get -next] } {
153		set key [lindex [lindex $ret 0] 0]
154		set data [lindex [lindex $ret 0] 1]
155		if { $i == 1 } {
156			set curkey $key
157		}
158		error_check_good seq_get:key $key $curkey
159
160		if { $i == $ndups } {
161			set i 1
162		} else {
163			incr i
164		}
165
166		# Now delete the key
167		set ret [$dbc del]
168		error_check_good db_del:$key $ret 0
169	}
170	error_check_good dbc_close [$dbc close] 0
171	if { $txnenv == 1 } {
172		error_check_good txn [$t commit] 0
173	}
174	error_check_good db_close [$db close] 0
175
176	puts "\t$tname.c: verify empty file"
177	# Double check that file is now empty
178	set db [eval {berkdb_open} $largs $testfile]
179	error_check_good dbopen [is_valid_db $db] TRUE
180	if { $txnenv == 1 } {
181		set t [$env txn]
182		error_check_good txn [is_valid_txn $t $env] TRUE
183		set txn "-txn $t"
184	}
185	set dbc [eval {$db cursor} $txn]
186	error_check_good db_cursor [is_substr $dbc $db] 1
187	set ret [$dbc get -first]
188	error_check_good get_on_empty [string length $ret] 0
189	error_check_good dbc_close [$dbc close] 0
190	if { $txnenv == 1 } {
191	error_check_good txn [$t commit] 0
192	}
193error_check_good db_close [$db close] 0
194}
195