ext/intck/intck_common.tcl

   1 # 2024 Feb 18
   2 #
   3 # The author disclaims copyright to this source code.  In place of
   4 # a legal notice, here is a blessing:
   5 #
   6 #    May you do good and not evil.
   7 #    May you find forgiveness for yourself and forgive others.
   8 #    May you share freely, never taking more than you give.
   9 #
  10 #***********************************************************************
  11 #
  12
  13 if {![info exists testdir]} {
  14   set testdir [file join [file dirname [info script]] .. .. test]
  15 }
  16 source $testdir/tester.tcl
  17
  18 proc do_intck {db {bSuspend 0}} {
  19   set ic [sqlite3_intck $db main]
  20
  21   set ret [list]
  22   while {"SQLITE_OK"==[$ic step]} {
  23     set msg [$ic message]
  24     if {$msg!=""} {
  25       lappend ret $msg
  26     }
  27     if {$bSuspend} { $ic suspend }
  28   }
  29
  30   set err [$ic error]
  31   if {[lindex $err 0]!="SQLITE_OK"} {
  32     error $err
  33   }
  34   $ic close
  35
  36   return $ret
  37 }
  38
  39 proc intck_sql {db tbl} {
  40   set ic [sqlite3_intck $db main]
  41   set sql [$ic test_sql $tbl]
  42   $ic close
  43   return $sql
  44 }
  45
  46 proc do_intck_test {tn expect} {
  47   uplevel [list do_test $tn.a [list do_intck db] [list {*}$expect]]
  48   uplevel [list do_test $tn.b [list do_intck db 1] [list {*}$expect]]
  49 }
  50
  51