Index: third_party/sqlite/sqlite-src-3070603/test/tclsqlite.test |
diff --git a/third_party/sqlite/sqlite-src-3070603/test/tclsqlite.test b/third_party/sqlite/sqlite-src-3070603/test/tclsqlite.test |
new file mode 100644 |
index 0000000000000000000000000000000000000000..8db04ebfa42f01ca4a06ae34865386221c27c4c1 |
--- /dev/null |
+++ b/third_party/sqlite/sqlite-src-3070603/test/tclsqlite.test |
@@ -0,0 +1,621 @@ |
+# 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.73 2009/03/16 13:19:36 danielk1977 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 "sqlite_orig HANDLE FILENAME ?-vfs VFSNAME? ?-readonly BOOLEAN? ?-create BOOLEAN? ?-nomutex BOOLEAN? ?-fullmutex BOOLEAN?" |
+} |
+do_test tcl-1.1 { |
+ set v [catch {sqlite3 bogus} msg] |
+ regsub {really_sqlite3} $msg {sqlite3} 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, backup, busy, cache, changes, close, collate, collation_needed, commit_hook, complete, copy, enable_load_extension, errorcode, eval, exists, function, incrblob, interrupt, last_insert_rowid, nullvalue, onecolumn, profile, progress, rekey, restore, rollback_hook, status, timeout, total_changes, trace, transaction, unlock_notify, update_hook, version, or wal_hook}} |
+do_test tcl-1.2.1 { |
+ set v [catch {db cache bogus} msg] |
+ lappend v $msg |
+} {1 {bad option "bogus": must be flush or size}} |
+do_test tcl-1.2.2 { |
+ set v [catch {db cache} msg] |
+ lappend v $msg |
+} {1 {wrong # args: should be "db cache option ?arg?"}} |
+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 {}} |
+catch {expr x*} msg |
+do_test tcl-1.6 { |
+ set v [catch { |
+ db eval {SELECT * FROM t1} data { |
+ expr x* |
+ } |
+ } msg] |
+ lappend v $msg |
+} [list 1 $msg] |
+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 [-argcount N] 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?"}} |
+do_test tcl-1.21 { |
+ set v [catch {sqlite3 db2 test.db -vfs nosuchvfs} msg] |
+ lappend v $msg |
+} {1 {no such vfs: nosuchvfs}} |
+ |
+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) A |
+ set x(2) B |
+ execsql { |
+ INSERT INTO t3 VALUES($::x(1),$::x(2),$::x(3)); |
+ SELECT * FROM t3 |
+ } |
+ } {A B {}} |
+ 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 |
+} 20 |
+do_test tcl-6.5 { |
+ return_test 20 |
+} 40 |
+do_test tcl-6.6 { |
+ return_test 99 |
+} 510 |
+do_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 {rand()*0.5}]} |
+ execsql {SELECT typeof(ret_dbl())} |
+} {real} |
+do_test tcl-9.3 { |
+ db function ret_int {return [expr {int(rand()*200)}]} |
+ 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} |
+} 1 |
+do_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} |
+} 1 |
+do_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} |
+do_test tcl-10.10 { |
+ for {set i 0} {$i<1} {incr i} { |
+ db transaction { |
+ db eval {INSERT INTO t4 VALUES(5)} |
+ continue |
+ } |
+ error "This line should not be run" |
+ } |
+ db eval {SELECT * FROM t4} |
+} {1 2 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 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 5 6 7} |
+ |
+# Now test that [db transaction] commands may be nested with |
+# the expected results. |
+# |
+do_test tcl-10.14 { |
+ db transaction { |
+ db eval { |
+ DELETE FROM t4; |
+ INSERT INTO t4 VALUES('one'); |
+ } |
+ |
+ catch { |
+ db transaction { |
+ db eval { INSERT INTO t4 VALUES('two') } |
+ db transaction { |
+ db eval { INSERT INTO t4 VALUES('three') } |
+ error "throw an error!" |
+ } |
+ } |
+ } |
+ } |
+ |
+ db eval {SELECT * FROM t4} |
+} {one} |
+do_test tcl-10.15 { |
+ # Make sure a transaction has not been left open. |
+ db eval {BEGIN ; COMMIT} |
+} {} |
+do_test tcl-10.16 { |
+ db transaction { |
+ db eval { INSERT INTO t4 VALUES('two'); } |
+ db transaction { |
+ db eval { INSERT INTO t4 VALUES('three') } |
+ db transaction { |
+ db eval { INSERT INTO t4 VALUES('four') } |
+ } |
+ } |
+ } |
+ db eval {SELECT * FROM t4} |
+} {one two three four} |
+do_test tcl-10.17 { |
+ catch { |
+ db transaction { |
+ db eval { INSERT INTO t4 VALUES('A'); } |
+ db transaction { |
+ db eval { INSERT INTO t4 VALUES('B') } |
+ db transaction { |
+ db eval { INSERT INTO t4 VALUES('C') } |
+ error "throw an error!" |
+ } |
+ } |
+ } |
+ } |
+ db eval {SELECT * FROM t4} |
+} {one two three four} |
+do_test tcl-10.18 { |
+ # Make sure a transaction has not been left open. |
+ db eval {BEGIN ; COMMIT} |
+} {} |
+ |
+# Mess up a [db transaction] command by locking the database using a |
+# second connection when it tries to commit. Make sure the transaction |
+# is not still open after the "database is locked" exception is thrown. |
+# |
+do_test tcl-10.18 { |
+ sqlite3 db2 test.db |
+ db2 eval { |
+ BEGIN; |
+ SELECT * FROM sqlite_master; |
+ } |
+ |
+ set rc [catch { |
+ db transaction { |
+ db eval {INSERT INTO t4 VALUES('five')} |
+ } |
+ } msg] |
+ list $rc $msg |
+} {1 {database is locked}} |
+do_test tcl-10.19 { |
+ db eval {BEGIN ; COMMIT} |
+} {} |
+ |
+# Thwart a [db transaction] command by locking the database using a |
+# second connection with "BEGIN EXCLUSIVE". Make sure no transaction is |
+# open after the "database is locked" exception is thrown. |
+# |
+do_test tcl-10.20 { |
+ db2 eval { |
+ COMMIT; |
+ BEGIN EXCLUSIVE; |
+ } |
+ set rc [catch { |
+ db transaction { |
+ db eval {INSERT INTO t4 VALUES('five')} |
+ } |
+ } msg] |
+ list $rc $msg |
+} {1 {database is locked}} |
+do_test tcl-10.21 { |
+ db2 close |
+ db eval {BEGIN ; COMMIT} |
+} {} |
+do_test tcl-10.22 { |
+ sqlite3 db2 test.db |
+ db transaction exclusive { |
+ catch { db2 eval {SELECT * FROM sqlite_master} } msg |
+ set msg "db2: $msg" |
+ } |
+ set msg |
+} {db2: database is locked} |
+db2 close |
+ |
+do_test tcl-11.1 { |
+ db eval {INSERT INTO t4 VALUES(6)} |
+ db exists {SELECT x,x*2,x+x FROM t4 WHERE x==6} |
+} {1} |
+do_test tcl-11.2 { |
+ db exists {SELECT 0 FROM t4 WHERE x==6} |
+} {1} |
+do_test tcl-11.3 { |
+ db exists {SELECT 1 FROM t4 WHERE x==8} |
+} {0} |
+do_test tcl-11.3.1 { |
+ tcl_objproc 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] |
+ |
+ |
+# Check to see that when bindings of the form @aaa are used instead |
+# of $aaa, that objects are treated as bytearray and are inserted |
+# as BLOBs. |
+# |
+ifcapable tclvar { |
+ do_test tcl-13.1 { |
+ db eval {CREATE TABLE t5(x BLOB)} |
+ set x abc123 |
+ db eval {INSERT INTO t5 VALUES($x)} |
+ db eval {SELECT typeof(x) FROM t5} |
+ } {text} |
+ do_test tcl-13.2 { |
+ binary scan $x H notUsed |
+ db eval { |
+ DELETE FROM t5; |
+ INSERT INTO t5 VALUES($x); |
+ SELECT typeof(x) FROM t5; |
+ } |
+ } {text} |
+ do_test tcl-13.3 { |
+ db eval { |
+ DELETE FROM t5; |
+ INSERT INTO t5 VALUES(@x); |
+ SELECT typeof(x) FROM t5; |
+ } |
+ } {blob} |
+ do_test tcl-13.4 { |
+ set y 1234 |
+ db eval { |
+ DELETE FROM t5; |
+ INSERT INTO t5 VALUES(@y); |
+ SELECT hex(x), typeof(x) FROM t5 |
+ } |
+ } {31323334 blob} |
+} |
+ |
+ |
+finish_test |