Index: third_party/sqlite/src/ext/session/session_common.tcl |
diff --git a/third_party/sqlite/src/ext/session/session_common.tcl b/third_party/sqlite/src/ext/session/session_common.tcl |
new file mode 100644 |
index 0000000000000000000000000000000000000000..d4804d924fdd3cd67562216b84f2da3697e655fd |
--- /dev/null |
+++ b/third_party/sqlite/src/ext/session/session_common.tcl |
@@ -0,0 +1,171 @@ |
+ |
+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 |
+} |