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   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
  73 proc do_common_sql {sql} {
  74   execsql $sql db
  75   execsql $sql db2
  76 }
  77
  78 proc 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
  98 proc do_then_apply_sql {sql {dbname main}} {
  99   proc xConflict args { return "OMIT" }
 100   set rc [catch {
 101     sqlite3session S db $dbname
 102     db eval "SELECT name FROM $dbname.sqlite_master WHERE type = 'table'" {
 103       S attach $name
 104     }
 105     db eval $sql
 106     sqlite3changeset_apply db2 [S changeset] xConflict
 107   } msg]
 108
 109   catch { S delete }
 110
 111   if {$rc} {error $msg}
 112 }
 113
 114 proc do_iterator_test {tn tbl_list sql res} {
 115   sqlite3session S db main
 116   if {[llength $tbl_list]==0} { S attach * }
 117   foreach t $tbl_list {S attach $t}
 118
 119   execsql $sql
 120
 121   set r [list]
 122   foreach v $res { lappend r $v }
 123
 124   set x [list]
 125   sqlite3session_foreach c [S changeset] { lappend x $c }
 126   uplevel do_test $tn [list [list set {} $x]] [list $r]
 127
 128   S delete
 129 }
 130
 131 # Compare the contents of all tables in [db1] and [db2]. Throw an error if
 132 # they are not identical, or return an empty string if they are.
 133 #
 134 proc compare_db {db1 db2} {
 135
 136   set sql {SELECT name FROM sqlite_master WHERE type = 'table' ORDER BY name}
 137   set lot1 [$db1 eval $sql]
 138   set lot2 [$db2 eval $sql]
 139
 140   if {$lot1 != $lot2} {
 141     puts $lot1
 142     puts $lot2
 143     error "databases contain different tables"
 144   }
 145
 146   foreach tbl $lot1 {
 147     set col1 [list]
 148     set col2 [list]
 149
 150     $db1 eval "PRAGMA table_info = $tbl" { lappend col1 $name }
 151     $db2 eval "PRAGMA table_info = $tbl" { lappend col2 $name }
 152     if {$col1 != $col2} { error "table $tbl schema mismatch" }
 153
 154     set sql "SELECT * FROM $tbl ORDER BY [join $col1 ,]"
 155     set data1 [$db1 eval $sql]
 156     set data2 [$db2 eval $sql]
 157     if {$data1 != $data2} {
 158       puts "$data1"
 159       puts "$data2"
 160       error "table $tbl data mismatch"
 161     }
 162   }
 163
 164   return ""
 165 }
 166
 167 proc changeset_to_list {c} {
 168   set list [list]
 169   sqlite3session_foreach elem $c { lappend list $elem }
 170   lsort $list
 171 }