300 lines
6.9 KiB
Tcl
300 lines
6.9 KiB
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
|
|
S object_config rowid 1
|
|
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
|
|
S object_config rowid 1
|
|
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 patchset_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 patchset
|
|
} patchset]
|
|
catch { S delete }
|
|
|
|
if {$rc} {
|
|
error $patchset
|
|
}
|
|
return $patchset
|
|
}
|
|
|
|
# Usage: do_then_apply_sql ?-ignorenoop? SQL ?DBNAME?
|
|
#
|
|
proc do_then_apply_sql {args} {
|
|
|
|
set bIgnoreNoop 0
|
|
set a1 [lindex $args 0]
|
|
if {[string length $a1]>1 && [string first $a1 -ignorenoop]==0} {
|
|
set bIgnoreNoop 1
|
|
set args [lrange $args 1 end]
|
|
}
|
|
|
|
if {[llength $args]!=1 && [llength $args]!=2} {
|
|
error "usage: do_then_apply_sql ?-ignorenoop? SQL ?DBNAME?"
|
|
}
|
|
|
|
set sql [lindex $args 0]
|
|
if {[llength $args]==1} {
|
|
set dbname main
|
|
} else {
|
|
set dbname [lindex $args 1]
|
|
}
|
|
|
|
set ::n_conflict 0
|
|
proc xConflict args { incr ::n_conflict ; return "OMIT" }
|
|
set rc [catch {
|
|
sqlite3session S db $dbname
|
|
S object_config rowid 1
|
|
db eval "SELECT name FROM $dbname.sqlite_master WHERE type = 'table'" {
|
|
S attach $name
|
|
}
|
|
db eval $sql
|
|
set ::changeset [S changeset]
|
|
sqlite3changeset_apply db2 $::changeset xConflict
|
|
} msg]
|
|
|
|
catch { S delete }
|
|
if {$rc} {error $msg}
|
|
|
|
if {$bIgnoreNoop} {
|
|
set nSave $::n_conflict
|
|
set ::n_conflict 0
|
|
proc xConflict args { incr ::n_conflict ; return "OMIT" }
|
|
sqlite3changeset_apply_v2 -ignorenoop db2 $::changeset xConflict
|
|
if {$::n_conflict!=$nSave} {
|
|
error "-ignorenoop problem ($::n_conflict $nSave)..."
|
|
}
|
|
}
|
|
}
|
|
|
|
proc do_iterator_test {tn tbl_list sql res} {
|
|
sqlite3session S db main
|
|
S object_config rowid 1
|
|
|
|
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]
|
|
# set ::c [S changeset] ; execsql_pp { SELECT quote($::c) }
|
|
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 "$db1: $data1"
|
|
puts "$db2: $data2"
|
|
error "table $tbl data mismatch"
|
|
}
|
|
}
|
|
|
|
return ""
|
|
}
|
|
|
|
proc changeset_to_list {c} {
|
|
set list [list]
|
|
sqlite3session_foreach elem $c { lappend list $elem }
|
|
lsort $list
|
|
}
|
|
|
|
set ones {zero one two three four five six seven eight nine
|
|
ten eleven twelve thirteen fourteen fifteen sixteen seventeen
|
|
eighteen nineteen}
|
|
set tens {{} ten twenty thirty forty fifty sixty seventy eighty ninety}
|
|
proc number_name {n} {
|
|
if {$n>=1000} {
|
|
set txt "[number_name [expr {$n/1000}]] thousand"
|
|
set n [expr {$n%1000}]
|
|
} else {
|
|
set txt {}
|
|
}
|
|
if {$n>=100} {
|
|
append txt " [lindex $::ones [expr {$n/100}]] hundred"
|
|
set n [expr {$n%100}]
|
|
}
|
|
if {$n>=20} {
|
|
append txt " [lindex $::tens [expr {$n/10}]]"
|
|
set n [expr {$n%10}]
|
|
}
|
|
if {$n>0} {
|
|
append txt " [lindex $::ones $n]"
|
|
}
|
|
set txt [string trim $txt]
|
|
if {$txt==""} {set txt zero}
|
|
return $txt
|
|
}
|
|
|
|
proc scksum {db dbname} {
|
|
|
|
if {$dbname=="temp"} {
|
|
set master sqlite_temp_master
|
|
} else {
|
|
set master $dbname.sqlite_master
|
|
}
|
|
|
|
set alltab [$db eval "SELECT name FROM $master WHERE type='table'"]
|
|
set txt [$db eval "SELECT * FROM $master ORDER BY type,name,sql"]
|
|
foreach tab $alltab {
|
|
set cols [list]
|
|
db eval "PRAGMA $dbname.table_info = $tab" x {
|
|
lappend cols "quote($x(name))"
|
|
}
|
|
set cols [join $cols ,]
|
|
append txt [db eval "SELECT $cols FROM $dbname.$tab ORDER BY $cols"]
|
|
}
|
|
return [md5 $txt]
|
|
}
|
|
|
|
proc do_diff_test {tn setup} {
|
|
reset_db
|
|
forcedelete test.db2
|
|
execsql { ATTACH 'test.db2' AS aux }
|
|
execsql $setup
|
|
|
|
sqlite3session S db main
|
|
S object_config rowid 1
|
|
foreach tbl [db eval {SELECT name FROM sqlite_master WHERE type='table'}] {
|
|
S attach $tbl
|
|
S diff aux $tbl
|
|
}
|
|
|
|
set C [S changeset]
|
|
S delete
|
|
|
|
sqlite3 db2 test.db2
|
|
sqlite3changeset_apply db2 $C ""
|
|
uplevel do_test $tn.1 [list {execsql { PRAGMA integrity_check } db2}] ok
|
|
db2 close
|
|
|
|
set cksum [scksum db main]
|
|
uplevel do_test $tn.2 [list {scksum db aux}] [list $cksum]
|
|
}
|