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