1# 2# 2001 September 15 3# 4# The author disclaims copyright to this source code. In place of 5# a legal notice, here is a blessing: 6# 7# May you do good and not evil. 8# May you find forgiveness for yourself and forgive others. 9# May you share freely, never taking more than you give. 10# 11#*********************************************************************** 12# This file implements regression tests for TCL interface to the 13# SQLite library. 14# 15# Actually, all tests are based on the TCL interface, so the main 16# interface is pretty well tested. This file contains some addition 17# tests for fringe issues that the main test suite does not cover. 18# 19# $Id: tclsqlite.test,v 1.20.2.1 2004/07/19 19:30:50 drh Exp $ 20 21set testdir [file dirname $argv0] 22source $testdir/tester.tcl 23 24# Check the error messages generated by tclsqlite 25# 26if {[sqlite -has-codec]} { 27 set r "sqlite_orig HANDLE FILENAME ?-key CODEC-KEY?" 28} else { 29 set r "sqlite HANDLE FILENAME ?MODE?" 30} 31do_test tcl-1.1 { 32 set v [catch {sqlite bogus} msg] 33 lappend v $msg 34} [list 1 "wrong # args: should be \"$r\""] 35do_test tcl-1.2 { 36 set v [catch {db bogus} msg] 37 lappend v $msg 38} {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}} 39do_test tcl-1.3 { 40 execsql {CREATE TABLE t1(a int, b int)} 41 execsql {INSERT INTO t1 VALUES(10,20)} 42 set v [catch { 43 db eval {SELECT * FROM t1} data { 44 error "The error message" 45 } 46 } msg] 47 lappend v $msg 48} {1 {The error message}} 49do_test tcl-1.4 { 50 set v [catch { 51 db eval {SELECT * FROM t2} data { 52 error "The error message" 53 } 54 } msg] 55 lappend v $msg 56} {1 {no such table: t2}} 57do_test tcl-1.5 { 58 set v [catch { 59 db eval {SELECT * FROM t1} data { 60 break 61 } 62 } msg] 63 lappend v $msg 64} {0 {}} 65do_test tcl-1.6 { 66 set v [catch { 67 db eval {SELECT * FROM t1} data { 68 expr x* 69 } 70 } msg] 71 regsub {:.*$} $msg {} msg 72 lappend v $msg 73} {1 {syntax error in expression "x*"}} 74 75if {[sqlite -encoding]=="UTF-8" && [sqlite -tcl-uses-utf]} { 76 catch {unset ::result} 77 do_test tcl-2.1 { 78 execsql "CREATE TABLE t\u0123x(a int, b\u1235 float)" 79 execsql "PRAGMA table_info(t\u0123x)" 80 } "0 a int 0 {} 0 1 b\u1235 float 0 {} 0" 81 do_test tcl-2.2 { 82 execsql "INSERT INTO t\u0123x VALUES(1,2.3)" 83 db eval "SELECT * FROM t\u0123x" result break 84 set result(*) 85 } "a b\u1235" 86} 87 88if {[sqlite -encoding]=="iso8859" && [sqlite -tcl-uses-utf]} { 89 do_test tcl-2.1 { 90 execsql "CREATE TABLE t\251x(a int, b\306 float)" 91 execsql "PRAGMA table_info(t\251x)" 92 } "0 a int 0 {} 0 1 b\306 float 0 {} 0" 93 do_test tcl-2.2 { 94 execsql "INSERT INTO t\251x VALUES(1,2.3)" 95 db eval "SELECT * FROM t\251x" result break 96 set result(*) 97 } "a b\306" 98} 99 100# Test the onecolumn method 101# 102do_test tcl-3.1 { 103 execsql { 104 INSERT INTO t1 SELECT a*2, b*2 FROM t1; 105 INSERT INTO t1 SELECT a*2+1, b*2+1 FROM t1; 106 INSERT INTO t1 SELECT a*2+3, b*2+3 FROM t1; 107 } 108 set rc [catch {db onecolumn {SELECT * FROM t1 ORDER BY a}} msg] 109 lappend rc $msg 110} {0 10} 111do_test tcl-3.2 { 112 db onecolumn {SELECT * FROM t1 WHERE a<0} 113} {} 114do_test tcl-3.3 { 115 set rc [catch {db onecolumn} errmsg] 116 lappend rc $errmsg 117} {1 {wrong # args: should be "db onecolumn SQL"}} 118 119 120finish_test 121