modernc.org/cc@v1.0.1/v2/testdata/_sqlite/ext/session/session_common.tcl (about)

     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  }