blob: 2e8726c8f96215f7212007f90f77a392ff1ba5f5 (
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
167
168
169
170
171
172
173
174
|
# See the file LICENSE for redistribution information.
#
# Copyright (c) 1999-2002
# Sleepycat Software. All rights reserved.
#
# $Id: test063.tcl,v 11.17 2002/05/24 15:24:55 sue Exp $
#
# TEST test063
# TEST Test of the DB_RDONLY flag to DB->open
# TEST Attempt to both DB->put and DBC->c_put into a database
# TEST that has been opened DB_RDONLY, and check for failure.
proc test063 { method args } {
global errorCode
source ./include.tcl
set args [convert_args $method $args]
set omethod [convert_method $method]
set tnum 63
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/test0$tnum.db
set env NULL
} else {
set testfile test0$tnum.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 key "key"
set data "data"
set key2 "another_key"
set data2 "more_data"
set gflags ""
set txn ""
if { [is_record_based $method] == 1 } {
set key "1"
set key2 "2"
append gflags " -recno"
}
puts "Test0$tnum: $method ($args) DB_RDONLY test."
# Create a test database.
puts "\tTest0$tnum.a: Creating test database."
set db [eval {berkdb_open_noerr -create -mode 0644} \
$omethod $args $testfile]
error_check_good db_create [is_valid_db $db] TRUE
# Put and get an item so it's nonempty.
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 [chop_data $method $data]}]
error_check_good initial_put $ret 0
set dbt [eval {$db get} $txn $gflags {$key}]
error_check_good initial_get $dbt \
[list [list $key [pad_data $method $data]]]
if { $txnenv == 1 } {
error_check_good txn [$t commit] 0
}
error_check_good db_close [$db close] 0
if { $eindex == -1 } {
# Confirm that database is writable. If we are
# using an env (that may be remote on a server)
# we cannot do this check.
error_check_good writable [file writable $testfile] 1
}
puts "\tTest0$tnum.b: Re-opening DB_RDONLY and attempting to put."
# Now open it read-only and make sure we can get but not put.
set db [eval {berkdb_open_noerr -rdonly} $args {$testfile}]
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 dbt [eval {$db get} $txn $gflags {$key}]
error_check_good db_get $dbt \
[list [list $key [pad_data $method $data]]]
set ret [catch {eval {$db put} $txn \
{$key2 [chop_data $method $data]}} res]
error_check_good put_failed $ret 1
error_check_good db_put_rdonly [is_substr $errorCode "EACCES"] 1
if { $txnenv == 1 } {
error_check_good txn [$t commit] 0
}
set errorCode "NONE"
puts "\tTest0$tnum.c: Attempting cursor put."
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_create [is_valid_cursor $dbc $db] TRUE
error_check_good cursor_set [$dbc get -first] $dbt
set ret [catch {eval {$dbc put} -current $data} res]
error_check_good c_put_failed $ret 1
error_check_good dbc_put_rdonly [is_substr $errorCode "EACCES"] 1
set dbt [eval {$db get} $gflags {$key2}]
error_check_good db_get_key2 $dbt ""
puts "\tTest0$tnum.d: Attempting ordinary delete."
set errorCode "NONE"
set ret [catch {eval {$db del} $txn {$key}} 1]
error_check_good del_failed $ret 1
error_check_good db_del_rdonly [is_substr $errorCode "EACCES"] 1
set dbt [eval {$db get} $txn $gflags {$key}]
error_check_good db_get_key $dbt \
[list [list $key [pad_data $method $data]]]
puts "\tTest0$tnum.e: Attempting cursor delete."
# Just set the cursor to the beginning; we don't care what's there...
# yet.
set dbt2 [$dbc get -first]
error_check_good db_get_first_key $dbt2 $dbt
set errorCode "NONE"
set ret [catch {$dbc del} res]
error_check_good c_del_failed $ret 1
error_check_good dbc_del_rdonly [is_substr $errorCode "EACCES"] 1
set dbt2 [$dbc get -current]
error_check_good db_get_key $dbt2 $dbt
puts "\tTest0$tnum.f: Close, reopen db; verify unchanged."
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
set db [eval {berkdb_open} $omethod $args $testfile]
error_check_good db_reopen [is_valid_db $db] TRUE
set dbc [$db cursor]
error_check_good cursor_create [is_valid_cursor $dbc $db] TRUE
error_check_good first_there [$dbc get -first] \
[list [list $key [pad_data $method $data]]]
error_check_good nomore_there [$dbc get -next] ""
error_check_good dbc_close [$dbc close] 0
error_check_good db_close [$db close] 0
}
|
