Repository navigation
Expand file tree
/
Copy pathsession_common.tcl
More file actions
215 lines (179 loc) · 4.83 KB
/
Copy pathsession_common.tcl
File metadata and controls
215 lines (179 loc) · 4.83 KB
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
212
213
214
215
proc do_changeset_test {tn session res} {
set r [list]
foreach x $res {lappend r $x}
uplevel do_test $tn [list [subst -nocommands {
set x [list]
sqlite3session_foreach c [$session changeset] { lappend x [set c] }
set x
}]] [list $r]
}
proc do_patchset_test {tn session res} {
set r [list]
foreach x $res {lappend r $x}
uplevel do_test $tn [list [subst -nocommands {
set x [list]
sqlite3session_foreach c [$session patchset] { lappend x [set c] }
set x
}]] [list $r]
}
proc do_changeset_invert_test {tn session res} {
set r [list]
foreach x $res {lappend r $x}
uplevel do_test $tn [list [subst -nocommands {
set x [list]
set changeset [sqlite3changeset_invert [$session changeset]]
sqlite3session_foreach c [set changeset] { lappend x [set c] }
set x
}]] [list $r]
}
proc do_conflict_test {tn args} {
set O(-tables) [list]
set O(-sql) [list]
set O(-conflicts) [list]
set O(-policy) "OMIT"
array set V $args
foreach key [array names V] {
if {![info exists O($key)]} {error "no such option: $key"}
}
array set O $args
proc xConflict {args} [subst -nocommands {
lappend ::xConflict [set args]
return $O(-policy)
}]
proc bgerror {args} { set ::background_error $args }
sqlite3session S db main
foreach t $O(-tables) { S attach $t }
execsql $O(-sql)
set ::xConflict [list]
sqlite3changeset_apply db2 [S changeset] xConflict
set conflicts [list]
foreach c $O(-conflicts) {
lappend conflicts $c
}
after 1 {set go 1}
vwait go
uplevel do_test $tn [list { set ::xConflict }] [list $conflicts]
S delete
}
proc do_common_sql {sql} {
execsql $sql db
execsql $sql db2
}
proc changeset_from_sql {sql {dbname main}} {
if {$dbname == "main"} {
return [sql_exec_changeset db $sql]
}
set rc [catch {
sqlite3session S db $dbname
db eval "SELECT name FROM $dbname.sqlite_master WHERE type = 'table'" {
S attach $name
}
db eval $sql
S changeset
} changeset]
catch { S delete }
if {$rc} {
error $changeset
}
return $changeset
}
proc patchset_from_sql {sql {dbname main}} {
set rc [catch {
sqlite3session S db $dbname
db eval "SELECT name FROM $dbname.sqlite_master WHERE type = 'table'" {
S attach $name
}
db eval $sql
S patchset
} patchset]
catch { S delete }
if {$rc} {
error $patchset
}
return $patchset
}
proc do_then_apply_sql {sql {dbname main}} {
proc xConflict args { return "OMIT" }
set rc [catch {
sqlite3session S db $dbname
db eval "SELECT name FROM $dbname.sqlite_master WHERE type = 'table'" {
S attach $name
}
db eval $sql
sqlite3changeset_apply db2 [S changeset] xConflict
} msg]
catch { S delete }
if {$rc} {error $msg}
}
proc do_iterator_test {tn tbl_list sql res} {
sqlite3session S db main
if {[llength $tbl_list]==0} { S attach * }
foreach t $tbl_list {S attach $t}
execsql $sql
set r [list]
foreach v $res { lappend r $v }
set x [list]
sqlite3session_foreach c [S changeset] { lappend x $c }
uplevel do_test $tn [list [list set {} $x]] [list $r]
S delete
}
# Compare the contents of all tables in [db1] and [db2]. Throw an error if
# they are not identical, or return an empty string if they are.
#
proc compare_db {db1 db2} {
set sql {SELECT name FROM sqlite_master WHERE type = 'table' ORDER BY name}
set lot1 [$db1 eval $sql]
set lot2 [$db2 eval $sql]
if {$lot1 != $lot2} {
puts $lot1
puts $lot2
error "databases contain different tables"
}
foreach tbl $lot1 {
set col1 [list]
set col2 [list]
$db1 eval "PRAGMA table_info = $tbl" { lappend col1 $name }
$db2 eval "PRAGMA table_info = $tbl" { lappend col2 $name }
if {$col1 != $col2} { error "table $tbl schema mismatch" }
set sql "SELECT * FROM $tbl ORDER BY [join $col1 ,]"
set data1 [$db1 eval $sql]
set data2 [$db2 eval $sql]
if {$data1 != $data2} {
puts "$db1: $data1"
puts "$db2: $data2"
error "table $tbl data mismatch"
}
}
return ""
}
proc changeset_to_list {c} {
set list [list]
sqlite3session_foreach elem $c { lappend list $elem }
lsort $list
}
set ones {zero one two three four five six seven eight nine
ten eleven twelve thirteen fourteen fifteen sixteen seventeen
eighteen nineteen}
set tens {{} ten twenty thirty forty fifty sixty seventy eighty ninety}
proc number_name {n} {
if {$n>=1000} {
set txt "[number_name [expr {$n/1000}]] thousand"
set n [expr {$n%1000}]
} else {
set txt {}
}
if {$n>=100} {
append txt " [lindex $::ones [expr {$n/100}]] hundred"
set n [expr {$n%100}]
}
if {$n>=20} {
append txt " [lindex $::tens [expr {$n/10}]]"
set n [expr {$n%10}]
}
if {$n>0} {
append txt " [lindex $::ones $n]"
}
set txt [string trim $txt]
if {$txt==""} {set txt zero}
return $txt
}