1# See the file LICENSE for redistribution information.
2#
3# Copyright (c) 1996,2008 Oracle.  All rights reserved.
4#
5# $Id: ndbm.tcl,v 12.6 2008/01/08 20:58:53 bostic Exp $
6#
7# Historic NDBM interface test.
8# Use the first 1000 entries from the dictionary.
9# Insert each with self as key and data; retrieve each.
10# After all are entered, retrieve all; compare output to original.
11# Then reopen the file, re-retrieve everything.
12# Finally, delete everything.
13proc ndbm { { nentries 1000 } } {
14	source ./include.tcl
15
16	puts "NDBM interfaces test: $nentries"
17
18	# Create the database and open the dictionary
19	set testfile $testdir/ndbmtest
20	set t1 $testdir/t1
21	set t2 $testdir/t2
22	set t3 $testdir/t3
23	cleanup $testdir NULL
24
25	set db [berkdb ndbm_open -create -truncate -mode 0644 $testfile]
26	error_check_good ndbm_open [is_substr $db ndbm] 1
27	set did [open $dict]
28
29	error_check_good rdonly_false [$db rdonly] 0
30
31	set flags 0
32	set txn 0
33	set count 0
34	set skippednullkey 0
35
36	puts "\tNDBM.a: put/get loop"
37	# Here is the loop where we put and get each key/data pair
38	while { [gets $did str] != -1 && $count < $nentries } {
39		# NDBM can't handle zero-length keys
40		if { [string length $str] == 0 } {
41			set skippednullkey 1
42			continue
43		}
44
45		set ret [$db store $str $str insert]
46		error_check_good ndbm_store $ret 0
47
48		set d [$db fetch $str]
49		error_check_good ndbm_fetch $d $str
50		incr count
51	}
52	close $did
53
54	# Now we will get each key from the DB and compare the results
55	# to the original.
56	puts "\tNDBM.b: dump file"
57	set oid [open $t1 w]
58	for { set key [$db firstkey] } { $key != -1 } {
59	    set key [$db nextkey] } {
60		puts $oid $key
61		set d [$db fetch $key]
62		error_check_good ndbm_refetch $d $key
63	}
64
65	# If we had to skip a zero-length key, juggle things to cover up
66	# this fact in the dump.
67	if { $skippednullkey == 1 } {
68		puts $oid ""
69		incr nentries 1
70	}
71	close $oid
72
73	# Now compare the keys to see if they match the dictionary (or ints)
74	set q q
75	filehead $nentries $dict $t3
76	filesort $t3 $t2
77	filesort $t1 $t3
78
79	error_check_good NDBM:diff($t3,$t2) \
80	    [filecmp $t3 $t2] 0
81
82	# File descriptors tests won't work under Windows.
83	if { $is_windows_test != 1 } {
84		puts "\tNDBM.c: pagf/dirf test"
85		set fd [$db pagfno]
86		error_check_bad pagf $fd -1
87		set fd [$db dirfno]
88		error_check_bad dirf $fd -1
89	}
90
91	puts "\tNDBM.d: close, open, and dump file"
92
93	# Now, reopen the file and run the last test again.
94	error_check_good ndbm_close [$db close] 0
95	set db [berkdb ndbm_open -rdonly $testfile]
96	error_check_good ndbm_open2 [is_substr $db ndbm] 1
97	set oid [open $t1 w]
98
99	error_check_good rdonly_true [$db rdonly] "rdonly:not owner"
100
101	for { set key [$db firstkey] } { $key != -1 } {
102	    set key [$db nextkey] } {
103		puts $oid $key
104		set d [$db fetch $key]
105		error_check_good ndbm_refetch2 $d $key
106	}
107	if { $skippednullkey == 1 } {
108		puts $oid ""
109	}
110	close $oid
111
112	# Now compare the keys to see if they match the dictionary (or ints)
113	filesort $t1 $t3
114
115	error_check_good NDBM:diff($t2,$t3) \
116	    [filecmp $t2 $t3] 0
117
118	# Now, reopen the file and delete each entry
119	puts "\tNDBM.e: sequential scan and delete"
120
121	error_check_good ndbm_close [$db close] 0
122	set db [berkdb ndbm_open $testfile]
123	error_check_good ndbm_open3 [is_substr $db ndbm] 1
124	set oid [open $t1 w]
125
126	for { set key [$db firstkey] } { $key != -1 } {
127	    set key [$db nextkey] } {
128		puts $oid $key
129		set ret [$db delete $key]
130		error_check_good ndbm_delete $ret 0
131	}
132	if { $skippednullkey == 1 } {
133		puts $oid ""
134	}
135	close $oid
136
137	# Now compare the keys to see if they match the dictionary (or ints)
138	filesort $t1 $t3
139
140	error_check_good NDBM:diff($t2,$t3) \
141	    [filecmp $t2 $t3] 0
142	error_check_good ndbm_close [$db close] 0
143}
144