ext/session/session_common.tcl - master - niceSOFT/sqlite

ext/session/session_common.tcl
302 строки7 KB
dan
Fix sessions module handling of tables with generated columns.
28 янв 2025, 22:03
28 янв 2025, 22:039dcf3d0

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]
    set quoted [list]

    $db1 eval "PRAGMA table_info = $tbl" { lappend col1 $name }
    $db2 eval "PRAGMA table_info = $tbl" { 
      lappend col2 $name 
      lappend quoted "\"[string map {\" \"\"} $name]\""
    }
    if {$col1 != $col2} { error "table $tbl schema mismatch" }

    set sql "SELECT * FROM $tbl ORDER BY [join $quoted ,]"
    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]
}