blob: 3878ffd8b8859761e8116b7d072a4bc7795460ba (
plain)
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
|
# See the file LICENSE for redistribution information.
#
# Copyright (c) 1999-2009 Oracle. All rights reserved.
#
# $Id$
#
# TEST test062
# TEST Test of partial puts (using DB_CURRENT) onto duplicate pages.
# TEST Insert the first 200 words into the dictionary 200 times each with
# TEST self as key and <random letter>:self as data. Use partial puts to
# TEST append self again to data; verify correctness.
proc test062 { method {nentries 200} {ndups 200} {tnum "062"} args } {
global alphabet
global rand_init
source ./include.tcl
berkdb srand $rand_init
set args [convert_args $method $args]
set omethod [convert_method $method]
if { [is_record_based $method] == 1 || [is_rbtree $method] == 1 } {
puts "Test$tnum skipping for method $omethod"
return
}
# Btree with compression does not support unsorted duplicates.
if { [is_compressed $args] == 1 } {
puts "Test$tnum skipping for btree with compression."
return
}
# Create the database and open the dictionary
set txnenv 0
set eindex [lsearch -exact $args "-env"]
#
# If we are using an env, then testfile should just be the db name.
# Otherwise it is the test directory and the name.
if { $eindex == -1 } {
set testfile $testdir/test$tnum.db
set env NULL
} 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 "
#
# If we are using txns and running with the
# default, set the default down a bit.
#
if { $nentries == 200 } {
set nentries 100
}
reduce_dups nentries ndups
}
set testdir [get_home $env]
}
cleanup $testdir $env
puts "Test$tnum:\
$method ($args) $nentries Partial puts and $ndups duplicates."
set db [eval {berkdb_open -create -mode 0644 \
$omethod -dup} $args {$testfile} ]
error_check_good dbopen [is_valid_db $db] TRUE
set did [open $dict]
set pflags ""
set gflags ""
set txn ""
set count 0
# Here is the loop where we put each key/data pair
puts "\tTest$tnum.a: Put loop (initialize database)"
while { [gets $did str] != -1 && $count < $nentries } {
for { set i 1 } { $i <= $ndups } { incr i } {
set pref \
[string index $alphabet [berkdb random_int 0 25]]
set datastr $pref:$str
if { $txnenv == 1 } {
set t [$env txn]
error_check_good txn [is_valid_txn $t $env] TRUE
set txn "-txn $t"
}
set ret [eval {$db put} \
$txn $pflags {$str [chop_data $method $datastr]}]
error_check_good put $ret 0
if { $txnenv == 1 } {
error_check_good txn [$t commit] 0
}
}
set keys($count) $str
incr count
}
close $did
puts "\tTest$tnum.b: Partial puts."
if { $txnenv == 1 } {
set t [$env txn]
error_check_good txn [is_valid_txn $t $env] TRUE
set txn "-txn $t"
}
set dbc [eval {$db cursor} $txn]
error_check_good cursor_open [is_substr $dbc $db] 1
# Do a partial write to extend each datum in
# the regular db by the corresponding dictionary word.
# We have to go through each key's dup set using -set
# because cursors are not stable in the hash AM and we
# want to make sure we hit all the keys.
for { set i 0 } { $i < $count } { incr i } {
set key $keys($i)
for {set ret [$dbc get -set $key]} \
{[llength $ret] != 0} \
{set ret [$dbc get -nextdup]} {
set k [lindex [lindex $ret 0] 0]
set orig_d [lindex [lindex $ret 0] 1]
set d [string range $orig_d 2 end]
set doff [expr [string length $d] + 2]
set dlen 0
error_check_good data_and_key_sanity $d $k
set ret [$dbc get -current]
error_check_good before_sanity \
[lindex [lindex $ret 0] 0] \
[string range [lindex [lindex $ret 0] 1] 2 end]
error_check_good partial_put [eval {$dbc put -current \
-partial [list $doff $dlen] $d}] 0
set ret [$dbc get -current]
error_check_good partial_put_correct \
[lindex [lindex $ret 0] 1] $orig_d$d
}
}
puts "\tTest$tnum.c: Double-checking get loop."
# Double-check that each datum in the regular db has
# been appropriately modified.
for {set ret [$dbc get -first]} \
{[llength $ret] != 0} \
{set ret [$dbc get -next]} {
set k [lindex [lindex $ret 0] 0]
set d [lindex [lindex $ret 0] 1]
error_check_good modification_correct \
[string range $d 2 end] [repeat $k 2]
}
error_check_good dbc_close [$dbc close] 0
if { $txnenv == 1 } {
error_check_good txn [$t commit] 0
}
error_check_good db_close [$db close] 0
}
|
