131 lines
2.7 KiB
Tcl
131 lines
2.7 KiB
Tcl
|
|
|
|
proc do_conflict_test {tn args} {
|
|
proc xConflict {args} {
|
|
lappend ::xConflict $args
|
|
return ""
|
|
}
|
|
proc bgerror {args} { set ::background_error $args }
|
|
|
|
|
|
set O(-tables) [list]
|
|
set O(-sql) [list]
|
|
set O(-conflicts) [list]
|
|
|
|
array set V $args
|
|
foreach key [array names V] {
|
|
if {![info exists O($key)]} {error "no such option: $key"}
|
|
}
|
|
array set O $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}} {
|
|
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
|
|
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 ""
|
|
}
|
|
|
|
|
|
|