blob: 51f25976c56efa33e19c5c71131189127a316028 (
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
160
161
162
163
164
165
166
|
# See the file LICENSE for redistribution information.
#
# Copyright (c) 2000-2002
# Sleepycat Software. All rights reserved.
#
# $Id: sdb010.tcl,v 11.14 2002/07/11 18:53:47 sandstro Exp $
#
# TEST subdb010
# TEST Test DB->remove() method and DB->truncate() for subdbs
proc subdb010 { method args } {
global errorCode
source ./include.tcl
set args [convert_args $method $args]
set omethod [convert_method $method]
puts "Subdb010: Test of DB->remove() and DB->truncate"
if { [is_queue $method] == 1 } {
puts "\tSubdb010: Skipping for method $method."
return
}
set txnenv 0
set envargs ""
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/subdb010.db
set tfpath $testfile
set env NULL
} else {
set testfile subdb010.db
incr eindex
set env [lindex $args $eindex]
set envargs " -env $env "
set txnenv [is_txnenv $env]
if { $txnenv == 1 } {
append args " -auto_commit "
append envargs " -auto_commit "
}
set testdir [get_home $env]
set tfpath $testdir/$testfile
}
cleanup $testdir $env
set txn ""
set testdb DATABASE
set testdb2 DATABASE2
set db [eval {berkdb_open -create -mode 0644} $omethod \
$args $testfile $testdb]
error_check_good db_open [is_valid_db $db] TRUE
error_check_good db_close [$db close] 0
puts "\tSubdb010.a: Test of DB->remove()"
error_check_good file_exists_before [file exists $tfpath] 1
error_check_good db_remove [eval {berkdb dbremove} $envargs \
$testfile $testdb] 0
# File should still exist.
error_check_good file_exists_after [file exists $tfpath] 1
# But database should not.
set ret [catch {eval berkdb_open $omethod $args $testfile $testdb} res]
error_check_bad open_failed ret 0
error_check_good open_failed_ret [is_substr $errorCode ENOENT] 1
puts "\tSubdb010.b: Setup for DB->truncate()"
# The nature of the key and data are unimportant; use numeric key
# so record-based methods don't need special treatment.
set key1 1
set key2 2
set data1 [pad_data $method data1]
set data2 [pad_data $method data2]
set db [eval {berkdb_open -create -mode 0644} $omethod \
$args {$testfile $testdb}]
error_check_good db_open [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"
}
error_check_good dbput [eval {$db put} $txn {$key1 $data1}] 0
if { $txnenv == 1 } {
error_check_good txn [$t commit] 0
}
set db2 [eval {berkdb_open -create -mode 0644} $omethod \
$args $testfile $testdb2]
error_check_good db_open [is_valid_db $db2] TRUE
if { $txnenv == 1 } {
set t [$env txn]
error_check_good txn [is_valid_txn $t $env] TRUE
set txn "-txn $t"
}
error_check_good dbput [eval {$db2 put} $txn {$key2 $data2}] 0
if { $txnenv == 1 } {
error_check_good txn [$t commit] 0
}
error_check_good db_close [$db close] 0
error_check_good db_close [$db2 close] 0
puts "\tSubdb010.c: truncate"
#
# Return value should be 1, the count of how many items were
# destroyed when we truncated.
set db [eval {berkdb_open -create -mode 0644} $omethod \
$args $testfile $testdb]
error_check_good db_open [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"
}
error_check_good trunc_subdb [eval {$db truncate} $txn] 1
if { $txnenv == 1 } {
error_check_good txn [$t commit] 0
}
error_check_good db_close [$db close] 0
puts "\tSubdb010.d: check"
set db [eval {berkdb_open} $args {$testfile $testdb}]
error_check_good db_open [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"
}
set dbc [eval {$db cursor} $txn]
error_check_good db_cursor [is_valid_cursor $dbc $db] TRUE
set kd [$dbc get -first]
error_check_good trunc_dbcget [llength $kd] 0
error_check_good dbcclose [$dbc close] 0
if { $txnenv == 1 } {
error_check_good txn [$t commit] 0
}
set db2 [eval {berkdb_open} $args {$testfile $testdb2}]
error_check_good db_open [is_valid_db $db2] TRUE
if { $txnenv == 1 } {
set t [$env txn]
error_check_good txn [is_valid_txn $t $env] TRUE
set txn "-txn $t"
}
set dbc [eval {$db2 cursor} $txn]
error_check_good db_cursor [is_valid_cursor $dbc $db2] TRUE
set kd [$dbc get -first]
error_check_bad notrunc_dbcget1 [llength $kd] 0
set db2kd [list [list $key2 $data2]]
error_check_good key2 $kd $db2kd
set kd [$dbc get -next]
error_check_good notrunc_dbget2 [llength $kd] 0
error_check_good dbcclose [$dbc close] 0
if { $txnenv == 1 } {
error_check_good txn [$t commit] 0
}
error_check_good db_close [$db close] 0
error_check_good db_close [$db2 close] 0
puts "\tSubdb010 succeeded."
}
|
