| # 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.20.2.2 2006/10/24 11:26:44 drh Exp $ |
| |
| set testdir [file dirname $argv0] |
| source $testdir/tester.tcl |
| |
| # Check the error messages generated by tclsqlite |
| # |
| if {[sqlite -has-codec]} { |
| set r "sqlite_orig HANDLE FILENAME ?-key CODEC-KEY?" |
| } else { |
| set r "sqlite HANDLE FILENAME ?MODE?" |
| } |
| do_test tcl-1.1 { |
| set v [catch {sqlite 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, changes, close, commit_hook, complete, errorcode, eval, function, last_insert_rowid, last_statement_changes, onecolumn, progress, rekey, timeout, or trace}} |
| 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*"}} |
| |
| if {[sqlite -encoding]=="UTF-8" && [sqlite -tcl-uses-utf]} { |
| catch {unset ::result} |
| do_test tcl-2.1 { |
| execsql "CREATE TABLE t\u0123x(a int, b\u1235 float)" |
| execsql "PRAGMA table_info(t\u0123x)" |
| } "0 a int 0 {} 0 1 b\u1235 float 0 {} 0" |
| do_test tcl-2.2 { |
| execsql "INSERT INTO t\u0123x VALUES(1,2.3)" |
| db eval "SELECT * FROM t\u0123x" result break |
| set result(*) |
| } "a b\u1235" |
| } |
| |
| if {[sqlite -encoding]=="iso8859" && [sqlite -tcl-uses-utf]} { |
| do_test tcl-2.1 { |
| execsql "CREATE TABLE t\251x(a int, b\306 float)" |
| execsql "PRAGMA table_info(t\251x)" |
| } "0 a int 0 {} 0 1 b\306 float 0 {} 0" |
| unset -nocomplain result |
| do_test tcl-2.2 { |
| execsql "INSERT INTO t\251x VALUES(1,2.3)" |
| db eval "SELECT * FROM t\251x" result break |
| set result(*) |
| } "a b\306" |
| } |
| |
| # 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"}} |
| |
| |
| finish_test |