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
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
|
# To do: Should run all tests and return a useful exit status, not
# punt on the first failure.
set wd [pwd]
set verbose 0
proc test1 {} {
global wd verbose
set p [profile_init_path $wd/test2.ini]
set sect {{test section 1} child_section child}
set iter [profile_iterator_create $p $sect 0]
set done 0
if $verbose { puts "Iterating over {$sect} entries:" }
while {!$done} {
set pair [profile_iterator $iter]
if [string match $pair {{} {}}] {
set done 1
} else {
set val [lindex $pair 1]
if $verbose { puts -nonewline "\t$val" }
}
}
if $verbose { puts "" }
#profile_iterator_free $iter
set iter [profile_iterator_create $p $sect 0]
set done 0
if $verbose { puts "Iterating again, deleting:" }
while {!$done} {
set pair [profile_iterator $iter]
if [string match $pair {{} {}}] {
set done 1
} else {
set val [lindex $pair 1]
if $verbose { puts -nonewline "\t$val" }
profile_update_relation $p $sect $val
}
}
if $verbose { puts "" }
#profile_iterator_free $iter
catch {file delete $wd/test3.ini}
profile_flush_to_file $p $wd/test3.ini
profile_release $p
if $verbose { puts "Reloading new profile" }
set p [profile_init_path $wd/test3.ini]
set iter [profile_iterator_create $p $sect 0]
set done 0
if $verbose { puts "Iterating again:" }
set found_some 0
while {!$done} {
set pair [profile_iterator $iter]
if [string match $pair {{} {}}] {
set done 1
} else {
set found_some 1
set val [lindex $pair 1]
if $verbose { puts -nonewline "\t$val" }
}
}
#profile_iterator_free $iter
profile_abandon $p
if {$found_some} {
if $verbose { puts "" }
puts stderr "Error: Deleting in iterator didn't get them all."
exit 1
} else {
puts "OK: test1: Deleting in iteration got rid of all entries."
}
}
proc test2 {} {
global wd verbose
# lxs said: create A, read A, flush A, read A, create B, read B, crash
# (where "create" refers to the object, not the file)
if $verbose { puts "Running test2" }
set c [profile_init_path $wd/test2.ini]
# create A
set a [profile_init_path $wd/test2.ini]
if $verbose { puts "Opened profile $wd/test2.ini" }
# read A
set x [profile_get_values $a {{test section 1} foo}]
if $verbose { puts "Read $x from profile" }
if $verbose { puts "updating" }
exec sleep 2
profile_update_relation $a {{test section 1} foo} [lindex $x 0] [lindex $x 0]
set x [profile_get_values $a {{test section 1} foo}]
if $verbose { puts "Read $x from profile" }
# flush A
profile_flush $a
# read A again
set x [profile_get_values $a {{test section 1} foo}]
if $verbose { puts "Read $x from profile" }
profile_release $a
# create B
set b [profile_init_path $wd/test2.ini]
if $verbose { puts "Opened profile again" }
# read B
set x [profile_get_values $b {{test section 1} foo}]
if $verbose { puts "Read $x from profile" }
# read B
set x [profile_get_values $b {{test section 1} foo}]
if $verbose { puts "Read $x from profile" }
# If we got this far, now what?
profile_release $b
profile_release $c
puts "OK: test2: Modifications don't corrupt existing open handles"
}
proc test3 {} {
# lxs said: Start with a relation in the file. Open, delete
# relation, add relation back, list relations. In 1.4 release
# code, got two back.
global wd verbose
exec cp $wd/test2.ini $wd/test1c.ini
set p [profile_init_path $wd/test1c.ini]
set sect {{test section 1} quux}
set v [profile_get_values $p $sect]
set v1 [lindex $v 0]
if $verbose { puts "Old values: $v" }
profile_clear_relation $p $sect
if $verbose { puts "Cleared." }
# profile_get_values raises an exception if no data is there; so if
# it succeeds, the test fails.
catch {
set v [profile_get_values $p $sect]
if $verbose { puts "New values: $v" }
puts stderr "Error: test3: Clearing relation didn't get rid of all values."
exit 1
}
if $verbose { puts "Adding back $v1 ..." }
profile_add_relation $p $sect $v1
set v [profile_get_values $p $sect]
if $verbose { puts "New values: $v" }
if [llength $v]!=1 {
puts stderr "Error: test3: Adding one entry after clearing relation leaves [llength $v] entries."
exit 1
}
profile_abandon $p
file delete $wd/test1c.ini
puts "OK: test3: Clearing relation and adding one entry yields correct count."
}
# Exercise the include and includedir directives.
proc test4 {} {
global wd verbose
# Test expected error message when including nonexistent file.
catch [file delete $wd/testinc.ini]
exec echo "include does-not-exist" >$wd/testinc.ini
catch { profile_init_path $wd/testinc.ini } err
if $verbose { puts "Got error message $err" }
if { $err ne "Included profile file could not be read" } {
puts stderr "Error: test4: Did not get expected error when including nonexistent file."
exit 1
}
# Test expected error message when including nonexistent directory.
catch [file delete $wd/testinc.ini]
exec echo "includedir does-not-exist" >$wd/testinc.ini
catch { profile_init_path $wd/testinc.ini } err
if $verbose { puts "Got error message $err" }
if { $err ne "Included profile directory could not be read" } {
puts stderr "Error: test4: Did not get expected error when including nonexistent directory."
exit 1
}
# Test including a file.
catch [file delete $wd/testinc.ini]
exec echo "include $wd/test2.ini" >$wd/testinc.ini
set p [profile_init_path $wd/testinc.ini]
set x [profile_get_values $p {{test section 1} bar}]
if $verbose { puts "Read $x from included profile" }
if { [lindex $x 0] ne "foo" } {
puts stderr "Error: test4: Did not get expected result from included profile."
exit 1
}
profile_release $p
# Test including a directory. (Put two copies of test2.ini inside
# it and check that we get two values for one of the variables.)
catch [file delete -force $wd/test_include_dir]
exec mkdir $wd/test_include_dir
exec cp $wd/test2.ini $wd/test_include_dir/a
exec cp $wd/test2.ini $wd/test_include_dir/b
catch [file delete $wd/testinc.ini]
exec echo "includedir $wd/test_include_dir" >$wd/testinc.ini
set p [profile_init_path $wd/testinc.ini]
set x [profile_get_values $p {{test section 1} bar}]
if $verbose { puts "Read $x from included directory" }
if { $x ne "foo foo" } {
puts stderr, "Error: test4: Did not get expected result from included directory."
exit 1
}
profile_release $p
puts "OK: test4: include and includedir directives"
}
test1
test2
test3
test4
exit 0
|
