# 2001 September 15## The author disclaims copyright to this source code.  In place of# a legal notice, here is a blessing:##    May you do good and not evil.#    May you find forgiveness for yourself and forgive others.#    May you share freely, never taking more than you give.##***********************************************************************# This file implements regression tests for TCL interface to the# SQLite library. ## Actually, all tests are based on the TCL interface, so the main# interface is pretty well tested.  This file contains some addition# tests for fringe issues that the main test suite does not cover.## $Id: tclsqlite.test,v 1.53 2006/02/09 16:52:24 drh Exp $set testdir [file dirname $argv0]source $testdir/tester.tcl# Check the error messages generated by tclsqlite#if {[sqlite3 -has-codec]} {  set r "sqlite_orig HANDLE FILENAME ?-key CODEC-KEY?"} else {  set r "sqlite3 HANDLE FILENAME ?MODE?"}do_test tcl-1.1 {  set v [catch {sqlite3 bogus} msg]  lappend v $msg} [list 1 "wrong # args: should be \"$r\""]do_test tcl-1.2 {  set v [catch {db bogus} msg]  lappend v $msg} {1 {bad option "bogus": must be authorizer, busy, cache, changes, close, collate, collation_needed, commit_hook, complete, copy, errorcode, eval, exists, function, last_insert_rowid, nullvalue, onecolumn, profile, progress, rekey, rollback_hook, timeout, total_changes, trace, transaction, update_hook, or version}}do_test tcl-1.3 {  execsql {CREATE TABLE t1(a int, b int)}  execsql {INSERT INTO t1 VALUES(10,20)}  set v [catch {    db eval {SELECT * FROM t1} data {      error "The error message"    }  } msg]  lappend v $msg} {1 {The error message}}do_test tcl-1.4 {  set v [catch {    db eval {SELECT * FROM t2} data {      error "The error message"    }  } msg]  lappend v $msg} {1 {no such table: t2}}do_test tcl-1.5 {  set v [catch {    db eval {SELECT * FROM t1} data {      break    }  } msg]  lappend v $msg} {0 {}}do_test tcl-1.6 {  set v [catch {    db eval {SELECT * FROM t1} data {      expr x*    }  } msg]  regsub {:.*$} $msg {} msg  lappend v $msg} {1 {syntax error in expression "x*"}}do_test tcl-1.7 {  set v [catch {db} msg]  lappend v $msg} {1 {wrong # args: should be "db SUBCOMMAND ..."}}if {[catch {db auth {}}]==0} {  do_test tcl-1.8 {    set v [catch {db authorizer 1 2 3} msg]    lappend v $msg  } {1 {wrong # args: should be "db authorizer ?CALLBACK?"}}}do_test tcl-1.9 {  set v [catch {db busy 1 2 3} msg]  lappend v $msg} {1 {wrong # args: should be "db busy CALLBACK"}}do_test tcl-1.10 {  set v [catch {db progress 1} msg]  lappend v $msg} {1 {wrong # args: should be "db progress N CALLBACK"}}do_test tcl-1.11 {  set v [catch {db changes xyz} msg]  lappend v $msg} {1 {wrong # args: should be "db changes "}}do_test tcl-1.12 {  set v [catch {db commit_hook a b c} msg]  lappend v $msg} {1 {wrong # args: should be "db commit_hook ?CALLBACK?"}}ifcapable {complete} {  do_test tcl-1.13 {    set v [catch {db complete} msg]    lappend v $msg  } {1 {wrong # args: should be "db complete SQL"}}}do_test tcl-1.14 {  set v [catch {db eval} msg]  lappend v $msg} {1 {wrong # args: should be "db eval SQL ?ARRAY-NAME? ?SCRIPT?"}}do_test tcl-1.15 {  set v [catch {db function} msg]  lappend v $msg} {1 {wrong # args: should be "db function NAME SCRIPT"}}do_test tcl-1.16 {  set v [catch {db last_insert_rowid xyz} msg]  lappend v $msg} {1 {wrong # args: should be "db last_insert_rowid "}}do_test tcl-1.17 {  set v [catch {db rekey} msg]  lappend v $msg} {1 {wrong # args: should be "db rekey KEY"}}do_test tcl-1.18 {  set v [catch {db timeout} msg]  lappend v $msg} {1 {wrong # args: should be "db timeout MILLISECONDS"}}do_test tcl-1.19 {  set v [catch {db collate} msg]  lappend v $msg} {1 {wrong # args: should be "db collate NAME SCRIPT"}}do_test tcl-1.20 {  set v [catch {db collation_needed} msg]  lappend v $msg} {1 {wrong # args: should be "db collation_needed SCRIPT"}}do_test tcl-1.21 {  set v [catch {db total_changes xyz} msg]  lappend v $msg} {1 {wrong # args: should be "db total_changes "}}do_test tcl-1.20 {  set v [catch {db copy} msg]  lappend v $msg} {1 {wrong # args: should be "db copy CONFLICT-ALGORITHM TABLE FILENAME ?SEPARATOR? ?NULLINDICATOR?"}}if {[sqlite3 -tcl-uses-utf]} {  catch {unset ::result}  do_test tcl-2.1 {    execsql "CREATE TABLE t\u0123x(a int, b\u1235 float)"  } {}  ifcapable schema_pragmas {    do_test tcl-2.2 {      execsql "PRAGMA table_info(t\u0123x)"    } "0 a int 0 {} 0 1 b\u1235 float 0 {} 0"  }  do_test tcl-2.3 {    execsql "INSERT INTO t\u0123x VALUES(1,2.3)"    db eval "SELECT * FROM t\u0123x" result break    set result(*)  } "a b\u1235"}# Test the onecolumn method#do_test tcl-3.1 {  execsql {    INSERT INTO t1 SELECT a*2, b*2 FROM t1;    INSERT INTO t1 SELECT a*2+1, b*2+1 FROM t1;    INSERT INTO t1 SELECT a*2+3, b*2+3 FROM t1;  }  set rc [catch {db onecolumn {SELECT * FROM t1 ORDER BY a}} msg]  lappend rc $msg} {0 10}do_test tcl-3.2 {  db onecolumn {SELECT * FROM t1 WHERE a<0}} {}do_test tcl-3.3 {  set rc [catch {db onecolumn} errmsg]  lappend rc $errmsg} {1 {wrong # args: should be "db onecolumn SQL"}}do_test tcl-3.4 {  set rc [catch {db onecolumn {SELECT bogus}} errmsg]  lappend rc $errmsg} {1 {no such column: bogus}}ifcapable {tclvar} {  do_test tcl-3.5 {    set b 50    set rc [catch {db one {SELECT * FROM t1 WHERE b>$b}} msg]    lappend rc $msg  } {0 41}  do_test tcl-3.6 {    set b 500    set rc [catch {db one {SELECT * FROM t1 WHERE b>$b}} msg]    lappend rc $msg  } {0 {}}  do_test tcl-3.7 {    set b 500    set rc [catch {db one {      INSERT INTO t1 VALUES(99,510);      SELECT * FROM t1 WHERE b>$b    }} msg]    lappend rc $msg  } {0 99}}ifcapable {!tclvar} {   execsql {INSERT INTO t1 VALUES(99,510)}}# Turn the busy handler on and off#do_test tcl-4.1 {  proc busy_callback {cnt} {    break  }  db busy busy_callback  db busy} {busy_callback}do_test tcl-4.2 {  db busy {}  db busy} {}ifcapable {tclvar} {  # Parsing of TCL variable names within SQL into bound parameters.  #  do_test tcl-5.1 {    execsql {CREATE TABLE t3(a,b,c)}    catch {unset x}    set x(1) 5    set x(2) 7    execsql {      INSERT INTO t3 VALUES($::x(1),$::x(2),$::x(3));      SELECT * FROM t3    }  } {5 7 {}}  do_test tcl-5.2 {    execsql {      SELECT typeof(a), typeof(b), typeof(c) FROM t3    }  } {text text null}  do_test tcl-5.3 {    catch {unset x}    set x [binary format h12 686900686f00]    execsql {      UPDATE t3 SET a=$::x;    }    db eval {      SELECT a FROM t3    } break    binary scan $a h12 adata    set adata  } {686900686f00}  do_test tcl-5.4 {    execsql {      SELECT typeof(a), typeof(b), typeof(c) FROM t3    }  } {blob text null}}# Operation of "break" and "continue" within row scripts#do_test tcl-6.1 {  db eval {SELECT * FROM t1} {    break  }  lappend a $b} {10 20}do_test tcl-6.2 {  set cnt 0  db eval {SELECT * FROM t1} {    if {$a>40} continue    incr cnt  }  set cnt} {4}do_test tcl-6.3 {  set cnt 0  db eval {SELECT * FROM t1} {    if {$a<40} continue    incr cnt  }  set cnt} {5}do_test tcl-6.4 {  proc return_test {x} {    db eval {SELECT * FROM t1} {      if {$a==$x} {return $b}    }  }  return_test 10} 20do_test tcl-6.5 {  return_test 20} 40do_test tcl-6.6 {  return_test 99} 510do_test tcl-6.7 {  return_test 0} {}do_test tcl-7.1 {  db version  expr 0} {0}# modify and reset the NULL representation#do_test tcl-8.1 {  db nullvalue NaN  execsql {INSERT INTO t1 VALUES(30,NULL)}  db eval {SELECT * FROM t1 WHERE b IS NULL}} {30 NaN}do_test tcl-8.2 {  db nullvalue NULL  db nullvalue} {NULL}do_test tcl-8.3 {  db nullvalue {}  db eval {SELECT * FROM t1 WHERE b IS NULL}} {30 {}}# Test the return type of user-defined functions#do_test tcl-9.1 {  db function ret_str {return "hi"}  execsql {SELECT typeof(ret_str())}} {text}do_test tcl-9.2 {  db function ret_dbl {return [expr {[clock seconds]*0.5}]}  execsql {SELECT typeof(ret_dbl())}} {real}do_test tcl-9.3 {  db function ret_int {clock seconds}  execsql {SELECT typeof(ret_int())}} {integer}# Recursive calls to the same user-defined function#ifcapable tclvar {  do_test tcl-9.10 {    proc userfunc_r1 {n} {      if {$n<=0} {return 0}      set nm1 [expr {$n-1}]      return [expr {[db eval {SELECT r1($nm1)}]+$n}]    }    db function r1 userfunc_r1    execsql {SELECT r1(10)}  } {55}  do_test tcl-9.11 {    execsql {SELECT r1(100)}  } {5050}}# Tests for the new transaction method#do_test tcl-10.1 {  db transaction {}} {}do_test tcl-10.2 {  db transaction deferred {}} {}do_test tcl-10.3 {  db transaction immediate {}} {}do_test tcl-10.4 {  db transaction exclusive {}} {}do_test tcl-10.5 {  set rc [catch {db transaction xyzzy {}} msg]  lappend rc $msg} {1 {bad transaction type "xyzzy": must be deferred, exclusive, or immediate}}do_test tcl-10.6 {  set rc [catch {db transaction {error test-error}} msg]  lappend rc $msg} {1 test-error}do_test tcl-10.7 {  db transaction {    db eval {CREATE TABLE t4(x)}    db transaction {      db eval {INSERT INTO t4 VALUES(1)}    }  }  db eval {SELECT * FROM t4}} 1do_test tcl-10.8 {  catch {    db transaction {      db eval {INSERT INTO t4 VALUES(2)}      db eval {INSERT INTO t4 VALUES(3)}      db eval {INSERT INTO t4 VALUES(4)}      error test-error    }  }  db eval {SELECT * FROM t4}} 1do_test tcl-10.9 {  db transaction {    db eval {INSERT INTO t4 VALUES(2)}    catch {      db transaction {        db eval {INSERT INTO t4 VALUES(3)}        db eval {INSERT INTO t4 VALUES(4)}        error test-error      }    }  }  db eval {SELECT * FROM t4}} {1 2 3 4}do_test tcl-10.10 {  for {set i 0} {$i<1} {incr i} {    db transaction {      db eval {INSERT INTO t4 VALUES(5)}      continue    }  }  db eval {SELECT * FROM t4}} {1 2 3 4 5}do_test tcl-10.11 {  for {set i 0} {$i<10} {incr i} {    db transaction {      db eval {INSERT INTO t4 VALUES(6)}      break    }  }  db eval {SELECT * FROM t4}} {1 2 3 4 5 6}do_test tcl-10.12 {  set rc [catch {    for {set i 0} {$i<10} {incr i} {      db transaction {        db eval {INSERT INTO t4 VALUES(7)}        return      }    }  }]} {2}do_test tcl-10.13 {  db eval {SELECT * FROM t4}} {1 2 3 4 5 6 7}do_test tcl-11.1 {  db exists {SELECT x,x*2,x+x FROM t4 WHERE x==4}} {1}do_test tcl-11.2 {  db exists {SELECT 0 FROM t4 WHERE x==4}} {1}do_test tcl-11.3 {  db exists {SELECT 1 FROM t4 WHERE x==8}} {0}do_test tcl-12.1 {  unset -nocomplain a b c version  set version [db version]  scan $version "%d.%d.%d" a b c  expr $a*1000000 + $b*1000 + $c} [sqlite3_libversion_number]finish_test