OLD | NEW |
(Empty) | |
| 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 } |
OLD | NEW |