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