1#!/usr/local/bin/tclsh8.2 2 3# 4# this test script is the torture.tcl 5# from the Tclgdbm0.6 distribution 6# 7lappend auto_path . 8if {[catch {package require Gdbm}]} return 9 10# 11# open 12# 13 14proc open {name} { 15 return [gdbm open $name rwc] 16} 17 18 19# 20# create 1000 entries 21# 22 23proc create {db} { 24 25 for {set i 0} {$i < 1000} {incr i} { 26 gdbm store $db $i "This data for $i" 27 } 28} 29 30 31# 32# read all entries 33# 34 35proc read1 {db} { 36 37 set key [gdbm firstkey $db] 38 set i 0 39 40 while {$key != ""} { 41 set data [gdbm fetch $db $key] 42 incr i 43 set key [gdbm nextkey $db $key] 44 45 } 46} 47 48 49# 50# read all entries using gdbm list 51# 52 53proc read2 {db} { 54 55 set keys [gdbm list $db] 56 set i 0 57 58 foreach key $keys { 59 set data [gdbm fetch $db $key] 60 # puts stdout "$i $key - $data" 61 incr i 62 } 63} 64 65# 66# delete 10 percent of all entries 67# 68 69proc delete {db} { 70 for {set i 0} {$i < 1000} {incr i 3} { 71 gdbm delete $db $i 72 } 73} 74 75# 76# lookup all keys 77# 78 79proc lookup {db} { 80 81 for {set i 0} {$i < 1000} {incr i} { 82 set exists [gdbm exists $db $i] 83 } 84} 85 86 87# 88# close 89# 90 91proc close {db} { 92 gdbm close $db 93} 94 95## 96## main 97## 98 99puts "open: \t\t[time {set db [open torture.gdbm]}]" 100puts "create: \t[time {create $db}]" 101puts "read1: \t\t[time {read1 $db}]" 102puts "read2: \t\t[time {read2 $db}]" 103puts "delete: \t[time {delete $db}]" 104puts "lookup: \t[time {lookup $db}]" 105puts "close: \t\t[time {close $db}]" 106file delete torture.gdbm 107