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