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
|
# See the file LICENSE for redistribution information.
#
# Copyright (c) 1999-2002
# Sleepycat Software. All rights reserved.
#
# $Id: test051.tcl,v 11.21 2002/05/24 13:43:24 sue Exp $
#
# TEST test051
# TEST Fixed-length record Recno test.
# TEST 0. Test various flags (legal and illegal) to open
# TEST 1. Test partial puts where dlen != size (should fail)
# TEST 2. Partial puts for existent record -- replaces at beg, mid, and
# TEST end of record, as well as full replace
proc test051 { method { args "" } } {
global fixed_len
global errorInfo
global errorCode
source ./include.tcl
set args [convert_args $method $args]
set omethod [convert_method $method]
puts "Test051: Test of the fixed length records."
if { [is_fixed_length $method] != 1 } {
puts "Test051: skipping for method $method"
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/test051.db
set testfile1 $testdir/test051a.db
set env NULL
} else {
set testfile test051.db
set testfile1 test051a.db
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
set oflags "-create -mode 0644 $args"
# Test various flags (legal and illegal) to open
puts "\tTest051.a: Test correct flag behavior on open."
set errorCode NONE
foreach f { "-dup" "-dup -dupsort" "-recnum" } {
puts "\t\tTest051.a: Test flag $f"
set stat [catch {eval {berkdb_open_noerr} $oflags $f $omethod \
$testfile} ret]
error_check_good dbopen:flagtest:catch $stat 1
error_check_good \
dbopen:flagtest:$f [is_substr $errorCode EINVAL] 1
set errorCode NONE
}
set f "-renumber"
puts "\t\tTest051.a: Test $f"
if { [is_frecno $method] == 1 } {
set db [eval {berkdb_open} $oflags $f $omethod $testfile]
error_check_good dbopen:flagtest:$f [is_valid_db $db] TRUE
$db close
} else {
error_check_good \
dbopen:flagtest:catch [catch {eval {berkdb_open_noerr}\
$oflags $f $omethod $testfile} ret] 1
error_check_good \
dbopen:flagtest:$f [is_substr $errorCode EINVAL] 1
}
# Test partial puts where dlen != size (should fail)
# it is an error to specify a partial put w/ different
# dlen and size in fixed length recno/queue
set key 1
set data ""
set txn ""
set test_char "a"
set db [eval {berkdb_open_noerr} $oflags $omethod $testfile1]
error_check_good dbopen [is_valid_db $db] TRUE
if { $txnenv == 1 } {
set t [$env txn]
error_check_good txn [is_valid_txn $t $env] TRUE
set txn "-txn $t"
}
puts "\tTest051.b: Partial puts with dlen != size."
foreach dlen { 1 16 20 32 } {
foreach doff { 0 10 20 32 } {
# dlen < size
puts "\t\tTest051.e: dlen: $dlen, doff: $doff, \
size: [expr $dlen+1]"
set data [repeat $test_char [expr $dlen + 1]]
error_check_good catch:put 1 [catch {eval {$db put -partial \
[list $doff $dlen]} $txn {$key $data}} ret]
#
# We don't get back the server error string just
# the result.
#
if { $eindex == -1 } {
error_check_good "dbput:partial: dlen < size" \
[is_substr $errorInfo "Length improper"] 1
} else {
error_check_good "dbput:partial: dlen < size" \
[is_substr $errorCode "EINVAL"] 1
}
# dlen > size
puts "\t\tTest051.e: dlen: $dlen, doff: $doff, \
size: [expr $dlen-1]"
set data [repeat $test_char [expr $dlen - 1]]
error_check_good catch:put 1 [catch {eval {$db put -partial \
[list $doff $dlen]} $txn {$key $data}} ret]
if { $eindex == -1 } {
error_check_good "dbput:partial: dlen > size" \
[is_substr $errorInfo "Length improper"] 1
} else {
error_check_good "dbput:partial: dlen < size" \
[is_substr $errorCode "EINVAL"] 1
}
}
}
if { $txnenv == 1 } {
error_check_good txn [$t commit] 0
}
$db close
# Partial puts for existent record -- replaces at beg, mid, and
# end of record, as well as full replace
puts "\tTest051.f: Partial puts within existent record."
set db [eval {berkdb_open} $oflags $omethod $testfile]
error_check_good dbopen [is_valid_db $db] TRUE
puts "\t\tTest051.f: First try a put and then a full replace."
set data [repeat "a" $fixed_len]
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 {1 $data}]
error_check_good dbput $ret 0
set ret [eval {$db get} $txn {-recno 1}]
error_check_good dbget $data [lindex [lindex $ret 0] 1]
set data [repeat "b" $fixed_len]
set ret [eval {$db put -partial [list 0 $fixed_len]} $txn {1 $data}]
error_check_good dbput $ret 0
set ret [eval {$db get} $txn {-recno 1}]
error_check_good dbget $data [lindex [lindex $ret 0] 1]
if { $txnenv == 1 } {
error_check_good txn [$t commit] 0
}
set data "InitialData"
set pdata "PUT"
set dlen [string length $pdata]
set ilen [string length $data]
set mid [expr $ilen/2]
# put initial data
set key 0
set offlist [list 0 $mid [expr $ilen -1] [expr $fixed_len - $dlen]]
puts "\t\tTest051.g: Now replace at different offsets ($offlist)."
foreach doff $offlist {
incr key
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 {$key $data}]
error_check_good dbput:init $ret 0
puts "\t\t Test051.g: Replace at offset $doff."
set ret [eval {$db put -partial [list $doff $dlen]} $txn \
{$key $pdata}]
error_check_good dbput:partial $ret 0
if { $txnenv == 1 } {
error_check_good txn [$t commit] 0
}
if { $doff == 0} {
set beg ""
set end [string range $data $dlen $ilen]
} else {
set beg [string range $data 0 [expr $doff - 1]]
set end [string range $data [expr $doff + $dlen] $ilen]
}
if { $doff > $ilen } {
# have to put padding between record and inserted
# string
set newdata [format %s%s $beg $end]
set diff [expr $doff - $ilen]
set nlen [string length $newdata]
set newdata [binary \
format a[set nlen]x[set diff]a$dlen $newdata $pdata]
} else {
set newdata [make_fixed_length \
frecno [format %s%s%s $beg $pdata $end]]
}
set ret [$db get -recno $key]
error_check_good compare($newdata,$ret) \
[binary_compare [lindex [lindex $ret 0] 1] $newdata] 0
}
$db close
}
|
