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