1
2
3proc do_conflict_test {tn args} {
4  proc xConflict {args} {
5    lappend ::xConflict $args
6    return ""
7  }
8  proc bgerror {args} { set ::background_error $args }
9
10
11  set O(-tables)    [list]
12  set O(-sql)       [list]
13  set O(-conflicts) [list]
14
15  array set V $args
16  foreach key [array names V] {
17    if {![info exists O($key)]} {error "no such option: $key"}
18  }
19  array set O $args
20
21  sqlite3session S db main
22  foreach t $O(-tables) { S attach $t }
23  execsql $O(-sql)
24
25  set ::xConflict [list]
26  sqlite3changeset_apply db2 [S changeset] xConflict
27
28  set conflicts [list]
29  foreach c $O(-conflicts) {
30    lappend conflicts $c
31  }
32
33  after 1 {set go 1}
34  vwait go
35
36  uplevel do_test $tn [list { set ::xConflict }] [list $conflicts]
37  S delete
38}
39
40proc do_common_sql {sql} {
41  execsql $sql db
42  execsql $sql db2
43}
44
45proc do_then_apply_sql {sql {dbname main}} {
46  proc xConflict args { return "OMIT" }
47
48  set rc [catch {
49    sqlite3session S db $dbname
50    db eval "SELECT name FROM $dbname.sqlite_master WHERE type = 'table'" {
51      S attach $name
52    }
53    db eval $sql
54    sqlite3changeset_apply db2 [S changeset] xConflict
55  } msg]
56
57  catch { S delete }
58
59  if {$rc} {error $msg}
60}
61
62proc do_iterator_test {tn tbl_list sql res} {
63  sqlite3session S db main
64  foreach t $tbl_list {S attach $t}
65  execsql $sql
66
67  set r [list]
68  foreach v $res { lappend r $v }
69
70  set x [list]
71  sqlite3session_foreach c [S changeset] { lappend x $c }
72  uplevel do_test $tn [list [list set {} $x]] [list $r]
73
74  S delete
75}
76
77# Compare the contents of all tables in [db1] and [db2]. Throw an error if
78# they are not identical, or return an empty string if they are.
79#
80proc compare_db {db1 db2} {
81
82  set sql {SELECT name FROM sqlite_master WHERE type = 'table' ORDER BY name}
83  set lot1 [$db1 eval $sql]
84  set lot2 [$db2 eval $sql]
85
86  if {$lot1 != $lot2} {
87    puts $lot1
88    puts $lot2
89    error "databases contain different tables"
90  }
91
92  foreach tbl $lot1 {
93    set col1 [list]
94    set col2 [list]
95
96    $db1 eval "PRAGMA table_info = $tbl" { lappend col1 $name }
97    $db2 eval "PRAGMA table_info = $tbl" { lappend col2 $name }
98    if {$col1 != $col2} { error "table $tbl schema mismatch" }
99
100    set sql "SELECT * FROM $tbl ORDER BY [join $col1 ,]"
101    set data1 [$db1 eval $sql]
102    set data2 [$db2 eval $sql]
103    if {$data1 != $data2} { error "table $tbl data mismatch" }
104  }
105
106  return ""
107}
108
109
110
111