[sql] Import SQLite 3.17.0.

third_party/sqlite/src/ext/session/session_common.tcl

+
+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 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 "$data1"
+      puts "$data2"
+      error "table $tbl data mismatch" 
+    }
+  }
+
+  return ""
+}
+
+proc changeset_to_list {c} {
+  set list [list]
+  sqlite3session_foreach elem $c { lappend list $elem }
+  lsort $list
+}