ext/session/session_common.tcl

   1
   2 proc 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
  12 proc 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
  23 proc 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
  35 proc 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   S object_config rowid 1
  56   foreach t $O(-tables) { S attach $t }
  57   execsql $O(-sql)
  58
  59   set ::xConflict [list]
  60   sqlite3changeset_apply db2 [S changeset] xConflict
  61
  62   set conflicts [list]
  63   foreach c $O(-conflicts) {
  64     lappend conflicts $c
  65   }
  66
  67   after 1 {set go 1}
  68   vwait go
  69
  70   uplevel do_test $tn [list { set ::xConflict }] [list $conflicts]
  71   S delete
  72 }
  73
  74 proc do_common_sql {sql} {
  75   execsql $sql db
  76   execsql $sql db2
  77 }
  78
  79 proc changeset_from_sql {sql {dbname main}} {
  80   if {$dbname == "main"} {
  81     return [sql_exec_changeset db $sql]
  82   }
  83   set rc [catch {
  84     sqlite3session S db $dbname
  85     S object_config rowid 1
  86     db eval "SELECT name FROM $dbname.sqlite_master WHERE type = 'table'" {
  87       S attach $name
  88     }
  89     db eval $sql
  90     S changeset
  91   } changeset]
  92   catch { S delete }
  93
  94   if {$rc} {
  95     error $changeset
  96   }
  97   return $changeset
  98 }
  99
 100 proc patchset_from_sql {sql {dbname main}} {
 101   set rc [catch {
 102     sqlite3session S db $dbname
 103     db eval "SELECT name FROM $dbname.sqlite_master WHERE type = 'table'" {
 104       S attach $name
 105     }
 106     db eval $sql
 107     S patchset
 108   } patchset]
 109   catch { S delete }
 110
 111   if {$rc} {
 112     error $patchset
 113   }
 114   return $patchset
 115 }
 116
 117 # Usage: do_then_apply_sql ?-ignorenoop? SQL ?DBNAME?
 118 #
 119 proc do_then_apply_sql {args} {
 120
 121   set bIgnoreNoop 0
 122   set a1 [lindex $args 0]
 123   if {[string length $a1]>1 && [string first $a1 -ignorenoop]==0} {
 124     set bIgnoreNoop 1
 125     set args [lrange $args 1 end]
 126   }
 127
 128   if {[llength $args]!=1 && [llength $args]!=2} {
 129     error "usage: do_then_apply_sql ?-ignorenoop? SQL ?DBNAME?"
 130   }
 131
 132   set sql [lindex $args 0]
 133   if {[llength $args]==1} {
 134     set dbname main
 135   } else {
 136     set dbname [lindex $args 1]
 137   }
 138
 139   set ::n_conflict 0
 140   proc xConflict args { incr ::n_conflict ; return "OMIT" }
 141   set rc [catch {
 142     sqlite3session S db $dbname
 143     S object_config rowid 1
 144     db eval "SELECT name FROM $dbname.sqlite_master WHERE type = 'table'" {
 145       S attach $name
 146     }
 147     db eval $sql
 148     set ::changeset [S changeset]
 149     sqlite3changeset_apply db2 $::changeset xConflict
 150   } msg]
 151
 152   catch { S delete }
 153   if {$rc} {error $msg}
 154
 155   if {$bIgnoreNoop} {
 156     set nSave $::n_conflict
 157     set ::n_conflict 0
 158     proc xConflict args { incr ::n_conflict ; return "OMIT" }
 159     sqlite3changeset_apply_v2 -ignorenoop db2 $::changeset xConflict
 160     if {$::n_conflict!=$nSave} {
 161       error "-ignorenoop problem ($::n_conflict $nSave)..."
 162     }
 163   }
 164 }
 165
 166 proc do_iterator_test {tn tbl_list sql res} {
 167   sqlite3session S db main
 168   S object_config rowid 1
 169
 170   if {[llength $tbl_list]==0} { S attach * }
 171   foreach t $tbl_list {S attach $t}
 172
 173   execsql $sql
 174
 175   set r [list]
 176   foreach v $res { lappend r $v }
 177
 178   set x [list]
 179 # set ::c [S changeset] ; execsql_pp { SELECT quote($::c) }
 180   sqlite3session_foreach c [S changeset] { lappend x $c }
 181   uplevel do_test $tn [list [list set {} $x]] [list $r]
 182
 183   S delete
 184 }
 185
 186 # Compare the contents of all tables in [db1] and [db2]. Throw an error if
 187 # they are not identical, or return an empty string if they are.
 188 #
 189 proc compare_db {db1 db2} {
 190
 191   set sql {SELECT name FROM sqlite_master WHERE type = 'table' ORDER BY name}
 192   set lot1 [$db1 eval $sql]
 193   set lot2 [$db2 eval $sql]
 194
 195   if {$lot1 != $lot2} {
 196     puts $lot1
 197     puts $lot2
 198     error "databases contain different tables"
 199   }
 200
 201   foreach tbl $lot1 {
 202     set col1 [list]
 203     set col2 [list]
 204
 205     $db1 eval "PRAGMA table_info = $tbl" { lappend col1 $name }
 206     $db2 eval "PRAGMA table_info = $tbl" { lappend col2 $name }
 207     if {$col1 != $col2} { error "table $tbl schema mismatch" }
 208
 209     set sql "SELECT * FROM $tbl ORDER BY [join $col1 ,]"
 210     set data1 [$db1 eval $sql]
 211     set data2 [$db2 eval $sql]
 212     if {$data1 != $data2} {
 213       puts "$db1: $data1"
 214       puts "$db2: $data2"
 215       error "table $tbl data mismatch"
 216     }
 217   }
 218
 219   return ""
 220 }
 221
 222 proc changeset_to_list {c} {
 223   set list [list]
 224   sqlite3session_foreach elem $c { lappend list $elem }
 225   lsort $list
 226 }
 227
 228 set ones {zero one two three four five six seven eight nine
 229           ten eleven twelve thirteen fourteen fifteen sixteen seventeen
 230           eighteen nineteen}
 231 set tens {{} ten twenty thirty forty fifty sixty seventy eighty ninety}
 232 proc number_name {n} {
 233   if {$n>=1000} {
 234     set txt "[number_name [expr {$n/1000}]] thousand"
 235     set n [expr {$n%1000}]
 236   } else {
 237     set txt {}
 238   }
 239   if {$n>=100} {
 240     append txt " [lindex $::ones [expr {$n/100}]] hundred"
 241     set n [expr {$n%100}]
 242   }
 243   if {$n>=20} {
 244     append txt " [lindex $::tens [expr {$n/10}]]"
 245     set n [expr {$n%10}]
 246   }
 247   if {$n>0} {
 248     append txt " [lindex $::ones $n]"
 249   }
 250   set txt [string trim $txt]
 251   if {$txt==""} {set txt zero}
 252   return $txt
 253 }
 254
 255 proc scksum {db dbname} {
 256
 257   if {$dbname=="temp"} {
 258     set master sqlite_temp_master
 259   } else {
 260     set master $dbname.sqlite_master
 261   }
 262
 263   set alltab [$db eval "SELECT name FROM $master WHERE type='table'"]
 264   set txt [$db eval "SELECT * FROM $master ORDER BY type,name,sql"]
 265   foreach tab $alltab {
 266     set cols [list]
 267     db eval "PRAGMA $dbname.table_info = $tab" x {
 268       lappend cols "quote($x(name))"
 269     }
 270     set cols [join $cols ,]
 271     append txt [db eval "SELECT $cols FROM $dbname.$tab ORDER BY $cols"]
 272   }
 273   return [md5 $txt]
 274 }
 275
 276 proc do_diff_test {tn setup} {
 277   reset_db
 278   forcedelete test.db2
 279   execsql { ATTACH 'test.db2' AS aux }
 280   execsql $setup
 281
 282   sqlite3session S db main
 283   S object_config rowid 1
 284   foreach tbl [db eval {SELECT name FROM sqlite_master WHERE type='table'}] {
 285     S attach $tbl
 286     S diff aux $tbl
 287   }
 288
 289   set C [S changeset]
 290   S delete
 291
 292   sqlite3 db2 test.db2
 293   sqlite3changeset_apply db2 $C ""
 294   uplevel do_test $tn.1 [list {execsql { PRAGMA integrity_check } db2}] ok
 295   db2 close
 296
 297   set cksum [scksum db main]
 298   uplevel do_test $tn.2 [list {scksum db aux}] [list $cksum]
 299 }