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
|
# 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."
}
test1
test2
test3
exit 0
|
