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
|
# See the file LICENSE for redistribution information.
#
# Copyright (c) 1996, 1997, 1998, 1999, 2000
# Sleepycat Software. All rights reserved.
#
# $Id: ndbm.tcl,v 11.13 2000/08/25 14:21:51 sue Exp $
#
# Historic NDBM interface test.
# Use the first 1000 entries from the dictionary.
# Insert each with self as key and data; retrieve each.
# After all are entered, retrieve all; compare output to original.
# Then reopen the file, re-retrieve everything.
# Finally, delete everything.
proc ndbm { { nentries 1000 } } {
source ./include.tcl
puts "NDBM interfaces test: $nentries"
# Create the database and open the dictionary
set testfile $testdir/ndbmtest
set t1 $testdir/t1
set t2 $testdir/t2
set t3 $testdir/t3
cleanup $testdir NULL
set db [berkdb ndbm_open -create -truncate -mode 0644 $testfile]
error_check_good ndbm_open [is_substr $db ndbm] 1
set did [open $dict]
error_check_good rdonly_false [$db rdonly] 0
set flags 0
set txn 0
set count 0
set skippednullkey 0
puts "\tNDBM.a: put/get loop"
# Here is the loop where we put and get each key/data pair
while { [gets $did str] != -1 && $count < $nentries } {
# NDBM can't handle zero-length keys
if { [string length $str] == 0 } {
set skippednullkey 1
continue
}
set ret [$db store $str $str insert]
error_check_good ndbm_store $ret 0
set d [$db fetch $str]
error_check_good ndbm_fetch $d $str
incr count
}
close $did
# Now we will get each key from the DB and compare the results
# to the original.
puts "\tNDBM.b: dump file"
set oid [open $t1 w]
for { set key [$db firstkey] } { $key != -1 } {
set key [$db nextkey] } {
puts $oid $key
set d [$db fetch $key]
error_check_good ndbm_refetch $d $key
}
# If we had to skip a zero-length key, juggle things to cover up
# this fact in the dump.
if { $skippednullkey == 1 } {
puts $oid ""
incr nentries 1
}
close $oid
# Now compare the keys to see if they match the dictionary (or ints)
set q q
filehead $nentries $dict $t3
filesort $t3 $t2
filesort $t1 $t3
error_check_good NDBM:diff($t3,$t2) \
[filecmp $t3 $t2] 0
puts "\tNDBM.c: pagf/dirf test"
set fd [$db pagfno]
error_check_bad pagf $fd -1
set fd [$db dirfno]
error_check_bad dirf $fd -1
puts "\tNDBM.d: close, open, and dump file"
# Now, reopen the file and run the last test again.
error_check_good ndbm_close [$db close] 0
set db [berkdb ndbm_open -rdonly $testfile]
error_check_good ndbm_open2 [is_substr $db ndbm] 1
set oid [open $t1 w]
error_check_good rdonly_true [$db rdonly] "rdonly:not owner"
for { set key [$db firstkey] } { $key != -1 } {
set key [$db nextkey] } {
puts $oid $key
set d [$db fetch $key]
error_check_good ndbm_refetch2 $d $key
}
if { $skippednullkey == 1 } {
puts $oid ""
}
close $oid
# Now compare the keys to see if they match the dictionary (or ints)
filesort $t1 $t3
error_check_good NDBM:diff($t2,$t3) \
[filecmp $t2 $t3] 0
# Now, reopen the file and delete each entry
puts "\tNDBM.e: sequential scan and delete"
error_check_good ndbm_close [$db close] 0
set db [berkdb ndbm_open $testfile]
error_check_good ndbm_open3 [is_substr $db ndbm] 1
set oid [open $t1 w]
for { set key [$db firstkey] } { $key != -1 } {
set key [$db nextkey] } {
puts $oid $key
set ret [$db delete $key]
error_check_good ndbm_delete $ret 0
}
if { $skippednullkey == 1 } {
puts $oid ""
}
close $oid
# Now compare the keys to see if they match the dictionary (or ints)
filesort $t1 $t3
error_check_good NDBM:diff($t2,$t3) \
[filecmp $t2 $t3] 0
error_check_good ndbm_close [$db close] 0
}
|
