1# See the file LICENSE for redistribution information.
2#
3# Copyright (c) 1996-2009 Oracle.  All rights reserved.
4#
5# $Id$
6#
7# TEST	test089
8# TEST	Concurrent Data Store test (CDB)
9# TEST
10# TEST	Enhanced CDB testing to test off-page dups, cursor dups and
11# TEST	cursor operations like c_del then c_get.
12proc test089 { method {nentries 1000} args } {
13	global datastr
14	global encrypt
15	source ./include.tcl
16
17	#
18	# If we are using an env, then skip this test.  It needs its own.
19	set eindex [lsearch -exact $args "-env"]
20	if { $eindex != -1 } {
21		incr eindex
22		set env [lindex $args $eindex]
23		puts "Test089 skipping for env $env"
24		return
25	}
26	set encargs ""
27	set args [convert_args $method $args]
28	set oargs [split_encargs $args encargs]
29	set omethod [convert_method $method]
30	set pageargs ""
31	split_pageargs $args pageargs
32
33	puts "Test089: ($oargs) $method CDB Test cursor/dup operations"
34
35	# Process arguments
36	# Create the database and open the dictionary
37	set testfile test089.db
38	set testfile1 test089a.db
39
40	env_cleanup $testdir
41
42	set env [eval \
43	     {berkdb_env -create -cdb} $pageargs $encargs -home $testdir]
44	error_check_good dbenv [is_valid_env $env] TRUE
45
46	set db [eval {berkdb_open -env $env -create \
47	    -mode 0644 $omethod} $oargs {$testfile}]
48	error_check_good dbopen [is_valid_db $db] TRUE
49
50	set db1 [eval {berkdb_open -env $env -create \
51	    -mode 0644 $omethod} $oargs {$testfile1}]
52	error_check_good dbopen [is_valid_db $db1] TRUE
53
54	set pflags ""
55	set gflags ""
56	set txn ""
57	set count 0
58
59	# Here is the loop where we put each key/data pair
60	puts "\tTest089.a: Put loop"
61	set did [open $dict]
62	while { [gets $did str] != -1 && $count < $nentries } {
63		if { [is_record_based $method] == 1 } {
64			set key [expr $count + 1]
65		} else {
66			set key $str
67		}
68		set ret [eval {$db put} \
69		    $txn $pflags {$key [chop_data $method $datastr]}]
70		error_check_good put:$db $ret 0
71		set ret [eval {$db1 put} \
72		    $txn $pflags {$key [chop_data $method $datastr]}]
73		error_check_good put:$db1 $ret 0
74		incr count
75	}
76	close $did
77	error_check_good close:$db [$db close] 0
78	error_check_good close:$db1 [$db1 close] 0
79
80	# Database is created, now set up environment
81
82	# Remove old mpools and Open/create the lock and mpool regions
83	error_check_good env:close:$env [$env close] 0
84	set ret [eval {berkdb envremove} $encargs -home $testdir]
85	error_check_good env_remove $ret 0
86
87	set env [eval \
88	     {berkdb_env_noerr -create -cdb} $pageargs $encargs -home $testdir]
89	error_check_good dbenv [is_valid_widget $env env] TRUE
90
91	puts "\tTest089.b: CDB cursor dups"
92
93	set db1 [eval {berkdb_open_noerr -env $env -create \
94	    -mode 0644 $omethod} $oargs {$testfile1}]
95	error_check_good dbopen [is_valid_db $db1] TRUE
96
97	# Create a read-only cursor and make sure we can't write with it.
98	set dbcr [$db1 cursor]
99	error_check_good dbcursor [is_valid_cursor $dbcr $db1] TRUE
100	set ret [$dbcr get -first]
101	catch { [$dbcr put -current data] } ret
102	error_check_good is_read_only \
103	    [is_substr $ret "Write attempted on read-only cursor"] 1
104	error_check_good dbcr_close [$dbcr close] 0
105
106	# Create a write cursor and duplicate it.
107	set dbcw [$db1 cursor -update]
108	error_check_good dbcursor [is_valid_cursor $dbcw $db1] TRUE
109	set dup_dbcw [$dbcw dup]
110	error_check_good dup_write_cursor [is_valid_cursor $dup_dbcw $db1] TRUE
111
112	# Position both cursors at get -first.  They should find the same data.
113	set get_first [$dbcw get -first]
114	set get_first_dup [$dup_dbcw get -first]
115	error_check_good dup_read $get_first $get_first_dup
116
117	# Test that the write cursors can both write and that they
118	# read each other's writes correctly.  First write reversed
119	# datastr with original cursor and read with dup cursor.
120	error_check_good put_current_orig \
121	    [$dbcw put -current [chop_data $method [reverse $datastr]]] 0
122	set reversed [$dup_dbcw get -current]
123	error_check_good check_with_dup [lindex [lindex $reversed 0] 1] \
124	    [pad_data $method [reverse $datastr]]
125
126	# Write forward datastr with dup cursor and read with original.
127	error_check_good put_current_dup \
128	    [$dup_dbcw put -current [chop_data $method $datastr]] 0
129	set forward [$dbcw get -current]
130	error_check_good check_with_orig $forward $get_first
131
132	error_check_good dbcw_close [$dbcw close] 0
133	error_check_good dup_dbcw_close [$dup_dbcw close] 0
134
135	# This tests the failure found in #1923
136	puts "\tTest089.c: Test delete then get"
137
138	set dbc [$db1 cursor -update]
139	error_check_good dbcursor [is_valid_cursor $dbc $db1] TRUE
140
141	for {set kd [$dbc get -first] } { [llength $kd] != 0 } \
142	    {set kd [$dbc get -next] } {
143		error_check_good dbcdel [$dbc del] 0
144	}
145	error_check_good dbc_close [$dbc close] 0
146	error_check_good db_close [$db1 close] 0
147	error_check_good env_close [$env close] 0
148
149	if { [is_btree $method] != 1 } {
150		puts "Skipping rest of test089 for $method method."
151		return
152	}
153	set pgindex [lsearch -exact $args "-pagesize"]
154	if { $pgindex != -1 } {
155		puts "Skipping rest of test089 for specific pagesizes"
156		return
157	}
158
159	append oargs " -dup "
160	# Skip unsorted duplicates for btree with compression.
161	if { [is_compressed $args] == 0 } {
162		test089_dup $testdir $encargs $oargs $omethod $nentries
163	}
164
165	append oargs " -dupsort "
166	test089_dup $testdir $encargs $oargs $omethod $nentries
167}
168
169proc test089_dup { testdir encargs oargs method nentries } {
170	env_cleanup $testdir
171	set pageargs ""
172	split_pageargs $oargs pageargs
173	set env [eval \
174	     {berkdb_env -create -cdb} $encargs $pageargs -home $testdir]
175	error_check_good dbenv [is_valid_env $env] TRUE
176
177	#
178	# Set pagesize small to generate lots of off-page dups
179	#
180	set page 512
181	set nkeys 5
182	set data "data"
183	set key "test089_key"
184	set testfile test089.db
185	puts "\tTest089.d: CDB ($oargs) off-page dups"
186	set oflags "-env $env -create -mode 0644 $oargs $method"
187	set db [eval {berkdb_open} -pagesize $page $oflags $testfile]
188	error_check_good dbopen [is_valid_db $db] TRUE
189
190	puts "\tTest089.e: Fill page with $nkeys keys, with $nentries dups"
191	for { set k 0 } { $k < $nkeys } { incr k } {
192		for { set i 0 } { $i < $nentries } { incr i } {
193			set ret [$db put $key$k $i$data$k]
194			error_check_good dbput $ret 0
195		}
196	}
197
198	# Verify we have off-page duplicates
199	set stat [$db stat]
200	error_check_bad stat:offpage [is_substr $stat "{{Internal pages} 0}"] 1
201
202	# This tests the failure reported in #6950.  Skip for -dupsort.
203	puts "\tTest089.f: Clear locks for duped off-page dup cursors."
204	if { [is_substr $oargs dupsort] != 1 } {
205		# Create a read cursor, put it on an off-page dup.
206		set dbcr [$db cursor]
207		error_check_good dbcr [is_valid_cursor $dbcr $db] TRUE
208		set offpage [$dbcr get -get_both test089_key4 900data4]
209		error_check_bad offpage [llength $offpage] 0
210
211		# Create a write cursor, put it on an off-page dup.
212		set dbcw [$db cursor -update]
213		error_check_good dbcw [is_valid_cursor $dbcw $db] TRUE
214		set offpage [$dbcw get -get_both test089_key3 900data3]
215		error_check_bad offpage [llength $offpage] 0
216
217		# Add a new item using the write cursor, then close the cursor.
218		error_check_good add_dup [$dbcw put -after $data] 0
219		error_check_good close_dbcw [$dbcw close] 0
220
221		# Get next dup with read cursor, then close the cursor.
222		set nextdup [$dbcr get -nextdup]
223		error_check_good close_dbcr [$dbcr close] 0
224	}
225
226	puts "\tTest089.g: CDB duplicate write cursors with off-page dups"
227	# Create a write cursor and duplicate it.
228	set dbcw [$db cursor -update]
229	error_check_good dbcursor [is_valid_cursor $dbcw $db] TRUE
230	set dup_dbcw [$dbcw dup]
231	error_check_good dup_write_cursor [is_valid_cursor $dup_dbcw $db] TRUE
232
233	# Position both cursors at get -first.  They should find the same data.
234	set get_first [$dbcw get -first]
235	set get_first_dup [$dup_dbcw get -first]
236	error_check_good dup_read $get_first $get_first_dup
237
238	# Test with -after and -before.  Skip for -dupsort.
239	if { [is_substr $oargs dupsort] != 1 } {
240		# Original and duplicate cursors both point to first item.
241		# Do a put -before of new string with original cursor,
242		# and a put -after of new string with duplicate cursor.
243		set newdata "newdata"
244		error_check_good put_before [$dbcw put -before $newdata] 0
245		error_check_good put_after [$dup_dbcw put -after $newdata] 0
246
247		# Now walk forward with original cursor ...
248		set first [$dbcw get -first]
249		error_check_good check_first [lindex [lindex $first 0] 1] $newdata
250		set next1 [$dbcw get -next]
251		error_check_good check_next1 $next1 $get_first
252		set next2 [$dbcw get -next]
253		error_check_good check_next2 [lindex [lindex $next2 0] 1] $newdata
254
255		# ... and backward with duplicate cursor.
256		set current [$dup_dbcw get -current]
257		error_check_good check_current [lindex [lindex $current 0] 1] $newdata
258		set prev1 [$dup_dbcw get -prev]
259		error_check_good check_prev1 $prev1 $get_first
260		set prev2 [$dup_dbcw get -prev]
261		error_check_good check_prev2 [lindex [lindex $prev2 0] 1] $newdata
262	}
263
264	puts "\tTest089.h: test delete then get of off-page dups"
265	for {set kd [$dbcw get -first] } { [llength $kd] != 0 } \
266	    {set kd [$dbcw get -next] } {
267		error_check_good dbcdel [$dbcw del] 0
268	}
269
270	error_check_good dbcw_close [$dbcw close] 0
271	error_check_good dup_dbcw_close [$dup_dbcw close] 0
272
273	error_check_good db_close [$db close] 0
274	error_check_good env_close [$env close] 0
275}
276