1
2proc do_changeset_test {tn session res} {
3  set r [list]
4  foreach x $res {lappend r $x}
5  uplevel do_test $tn [list [subst -nocommands {
6    set x [list]
7    sqlite3session_foreach c [$session changeset] { lappend x [set c] }
8    set x
9  }]] [list $r]
10}
11
12proc do_patchset_test {tn session res} {
13  set r [list]
14  foreach x $res {lappend r $x}
15  uplevel do_test $tn [list [subst -nocommands {
16    set x [list]
17    sqlite3session_foreach c [$session patchset] { lappend x [set c] }
18    set x
19  }]] [list $r]
20}
21
22
23proc do_changeset_invert_test {tn session res} {
24  set r [list]
25  foreach x $res {lappend r $x}
26  uplevel do_test $tn [list [subst -nocommands {
27    set x [list]
28    set changeset [sqlite3changeset_invert [$session changeset]]
29    sqlite3session_foreach c [set changeset] { lappend x [set c] }
30    set x
31  }]] [list $r]
32}
33
34
35proc do_conflict_test {tn args} {
36
37  set O(-tables)    [list]
38  set O(-sql)       [list]
39  set O(-conflicts) [list]
40  set O(-policy)    "OMIT"
41
42  array set V $args
43  foreach key [array names V] {
44    if {![info exists O($key)]} {error "no such option: $key"}
45  }
46  array set O $args
47
48  proc xConflict {args} [subst -nocommands {
49    lappend ::xConflict [set args]
50    return $O(-policy)
51  }]
52  proc bgerror {args} { set ::background_error $args }
53
54  sqlite3session S db main
55  foreach t $O(-tables) { S attach $t }
56  execsql $O(-sql)
57
58  set ::xConflict [list]
59  sqlite3changeset_apply db2 [S changeset] xConflict
60
61  set conflicts [list]
62  foreach c $O(-conflicts) {
63    lappend conflicts $c
64  }
65
66  after 1 {set go 1}
67  vwait go
68
69  uplevel do_test $tn [list { set ::xConflict }] [list $conflicts]
70  S delete
71}
72
73proc do_common_sql {sql} {
74  execsql $sql db
75  execsql $sql db2
76}
77
78proc changeset_from_sql {sql {dbname main}} {
79  if {$dbname == "main"} {
80    return [sql_exec_changeset db $sql]
81  }
82  set rc [catch {
83    sqlite3session S db $dbname
84    db eval "SELECT name FROM $dbname.sqlite_master WHERE type = 'table'" {
85      S attach $name
86    }
87    db eval $sql
88    S changeset
89  } changeset]
90  catch { S delete }
91
92  if {$rc} {
93    error $changeset
94  }
95  return $changeset
96}
97
98proc patchset_from_sql {sql {dbname main}} {
99  set rc [catch {
100    sqlite3session S db $dbname
101    db eval "SELECT name FROM $dbname.sqlite_master WHERE type = 'table'" {
102      S attach $name
103    }
104    db eval $sql
105    S patchset
106  } patchset]
107  catch { S delete }
108
109  if {$rc} {
110    error $patchset
111  }
112  return $patchset
113}
114
115proc do_then_apply_sql {sql {dbname main}} {
116  proc xConflict args { return "OMIT" }
117  set rc [catch {
118    sqlite3session S db $dbname
119    db eval "SELECT name FROM $dbname.sqlite_master WHERE type = 'table'" {
120      S attach $name
121    }
122    db eval $sql
123    sqlite3changeset_apply db2 [S changeset] xConflict
124  } msg]
125
126  catch { S delete }
127
128  if {$rc} {error $msg}
129}
130
131proc do_iterator_test {tn tbl_list sql res} {
132  sqlite3session S db main
133  if {[llength $tbl_list]==0} { S attach * }
134  foreach t $tbl_list {S attach $t}
135
136  execsql $sql
137
138  set r [list]
139  foreach v $res { lappend r $v }
140
141  set x [list]
142  sqlite3session_foreach c [S changeset] { lappend x $c }
143  uplevel do_test $tn [list [list set {} $x]] [list $r]
144
145  S delete
146}
147
148# Compare the contents of all tables in [db1] and [db2]. Throw an error if
149# they are not identical, or return an empty string if they are.
150#
151proc compare_db {db1 db2} {
152
153  set sql {SELECT name FROM sqlite_master WHERE type = 'table' ORDER BY name}
154  set lot1 [$db1 eval $sql]
155  set lot2 [$db2 eval $sql]
156
157  if {$lot1 != $lot2} {
158    puts $lot1
159    puts $lot2
160    error "databases contain different tables"
161  }
162
163  foreach tbl $lot1 {
164    set col1 [list]
165    set col2 [list]
166
167    $db1 eval "PRAGMA table_info = $tbl" { lappend col1 $name }
168    $db2 eval "PRAGMA table_info = $tbl" { lappend col2 $name }
169    if {$col1 != $col2} { error "table $tbl schema mismatch" }
170
171    set sql "SELECT * FROM $tbl ORDER BY [join $col1 ,]"
172    set data1 [$db1 eval $sql]
173    set data2 [$db2 eval $sql]
174    if {$data1 != $data2} {
175      puts "$db1: $data1"
176      puts "$db2: $data2"
177      error "table $tbl data mismatch"
178    }
179  }
180
181  return ""
182}
183
184proc changeset_to_list {c} {
185  set list [list]
186  sqlite3session_foreach elem $c { lappend list $elem }
187  lsort $list
188}
189
190set ones {zero one two three four five six seven eight nine
191          ten eleven twelve thirteen fourteen fifteen sixteen seventeen
192          eighteen nineteen}
193set tens {{} ten twenty thirty forty fifty sixty seventy eighty ninety}
194proc number_name {n} {
195  if {$n>=1000} {
196    set txt "[number_name [expr {$n/1000}]] thousand"
197    set n [expr {$n%1000}]
198  } else {
199    set txt {}
200  }
201  if {$n>=100} {
202    append txt " [lindex $::ones [expr {$n/100}]] hundred"
203    set n [expr {$n%100}]
204  }
205  if {$n>=20} {
206    append txt " [lindex $::tens [expr {$n/10}]]"
207    set n [expr {$n%10}]
208  }
209  if {$n>0} {
210    append txt " [lindex $::ones $n]"
211  }
212  set txt [string trim $txt]
213  if {$txt==""} {set txt zero}
214  return $txt
215}
216