summaryrefslogtreecommitdiffstats
path: root/ext/session/session_common.tcl
blob: 3ff84f1c5eb403c7b69dc0e461f1a02cedb195e5 (plain)
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
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
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
  S object_config rowid 1
  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
    S object_config rowid 1
    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
}

# Usage: do_then_apply_sql ?-ignorenoop? SQL ?DBNAME? 
#
proc do_then_apply_sql {args} {
  
  set bIgnoreNoop 0
  set a1 [lindex $args 0]
  if {[string length $a1]>1 && [string first $a1 -ignorenoop]==0} {
    set bIgnoreNoop 1
    set args [lrange $args 1 end]
  }

  if {[llength $args]!=1 && [llength $args]!=2} {
    error "usage: do_then_apply_sql ?-ignorenoop? SQL ?DBNAME?"
  }

  set sql [lindex $args 0]
  if {[llength $args]==1} {
    set dbname main
  } else {
    set dbname [lindex $args 1]
  }

  set ::n_conflict 0
  proc xConflict args { incr ::n_conflict ; return "OMIT" }
  set rc [catch {
    sqlite3session S db $dbname
    S object_config rowid 1
    db eval "SELECT name FROM $dbname.sqlite_master WHERE type = 'table'" {
      S attach $name
    }
    db eval $sql
    set ::changeset [S changeset]
    sqlite3changeset_apply db2 $::changeset xConflict
  } msg]

  catch { S delete }
  if {$rc} {error $msg}

  if {$bIgnoreNoop} {
    set nSave $::n_conflict
    set ::n_conflict 0
    proc xConflict args { incr ::n_conflict ; return "OMIT" }
    sqlite3changeset_apply_v2 -ignorenoop db2 $::changeset xConflict
    if {$::n_conflict!=$nSave} {
      error "-ignorenoop problem ($::n_conflict $nSave)..."
    }
  }
}

proc do_iterator_test {tn tbl_list sql res} {
  sqlite3session S db main
  S object_config rowid 1

  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]
# set ::c [S changeset] ; execsql_pp { SELECT quote($::c) }
  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
}

proc scksum {db dbname} {

  if {$dbname=="temp"} {
    set master sqlite_temp_master
  } else {
    set master $dbname.sqlite_master
  }

  set alltab [$db eval "SELECT name FROM $master WHERE type='table'"]
  set txt [$db eval "SELECT * FROM $master ORDER BY type,name,sql"]
  foreach tab $alltab {
    set cols [list]
    db eval "PRAGMA $dbname.table_info = $tab" x { 
      lappend cols "quote($x(name))" 
    }
    set cols [join $cols ,]
    append txt [db eval "SELECT $cols FROM $dbname.$tab ORDER BY $cols"]
  }
  return [md5 $txt]
}

proc do_diff_test {tn setup} {
  reset_db
  forcedelete test.db2
  execsql { ATTACH 'test.db2' AS aux }
  execsql $setup

  sqlite3session S db main
  S object_config rowid 1
  foreach tbl [db eval {SELECT name FROM sqlite_master WHERE type='table'}] {
    S attach $tbl
    S diff aux $tbl
  }

  set C [S changeset]
  S delete

  sqlite3 db2 test.db2
  sqlite3changeset_apply db2 $C ""
  uplevel do_test $tn.1 [list {execsql { PRAGMA integrity_check } db2}] ok
  db2 close

  set cksum [scksum db main]
  uplevel do_test $tn.2 [list {scksum db aux}] [list $cksum]
}