1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2 +++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TclScript/tclsqlite.test Fri Jun 15 03:10:57 2012 +0200
1.3 @@ -0,0 +1,509 @@
1.4 +# 2001 September 15
1.5 +#
1.6 +# Portions Copyright (c) 2007-2008 Nokia Corporation and/or its subsidiaries. All rights reserved.
1.7 +#
1.8 +# The author disclaims copyright to this source code. In place of
1.9 +# a legal notice, here is a blessing:
1.10 +#
1.11 +# May you do good and not evil.
1.12 +# May you find forgiveness for yourself and forgive others.
1.13 +# May you share freely, never taking more than you give.
1.14 +#
1.15 +#***********************************************************************
1.16 +# This file implements regression tests for TCL interface to the
1.17 +# SQLite library.
1.18 +#
1.19 +# Actually, all tests are based on the TCL interface, so the main
1.20 +# interface is pretty well tested. This file contains some addition
1.21 +# tests for fringe issues that the main test suite does not cover.
1.22 +#
1.23 +# $Id: tclsqlite.test,v 1.69 2008/09/09 12:31:34 drh Exp $
1.24 +
1.25 +set testdir [file dirname $argv0]
1.26 +source $testdir/tester.tcl
1.27 +
1.28 +# Check the error messages generated by tclsqlite
1.29 +#
1.30 +if {[sqlite3 -has-codec]} {
1.31 + set r "sqlite_orig HANDLE FILENAME ?-key CODEC-KEY?"
1.32 +} else {
1.33 + set r "sqlite3 HANDLE FILENAME ?-vfs VFSNAME? ?-readonly BOOLEAN? ?-create BOOLEAN? ?-nomutex BOOLEAN? ?-fullmutex BOOLEAN?"
1.34 +}
1.35 +do_test tcl-1.1 {
1.36 + set v [catch {sqlite3 bogus} msg]
1.37 + regsub {really_sqlite3} $msg {sqlite3} msg
1.38 + lappend v $msg
1.39 +} [list 1 "wrong # args: should be \"$r\""]
1.40 +do_test tcl-1.2 {
1.41 + set v [catch {db bogus} msg]
1.42 + lappend v $msg
1.43 +} {1 {bad option "bogus": must be authorizer, 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, rollback_hook, timeout, total_changes, trace, transaction, update_hook, or version}}
1.44 +do_test tcl-1.2.1 {
1.45 + set v [catch {db cache bogus} msg]
1.46 + lappend v $msg
1.47 +} {1 {bad option "bogus": must be flush or size}}
1.48 +do_test tcl-1.2.2 {
1.49 + set v [catch {db cache} msg]
1.50 + lappend v $msg
1.51 +} {1 {wrong # args: should be "db cache option ?arg?"}}
1.52 +do_test tcl-1.3 {
1.53 + execsql {CREATE TABLE t1(a int, b int)}
1.54 + execsql {INSERT INTO t1 VALUES(10,20)}
1.55 + set v [catch {
1.56 + db eval {SELECT * FROM t1} data {
1.57 + error "The error message"
1.58 + }
1.59 + } msg]
1.60 + lappend v $msg
1.61 +} {1 {The error message}}
1.62 +do_test tcl-1.4 {
1.63 + set v [catch {
1.64 + db eval {SELECT * FROM t2} data {
1.65 + error "The error message"
1.66 + }
1.67 + } msg]
1.68 + lappend v $msg
1.69 +} {1 {no such table: t2}}
1.70 +do_test tcl-1.5 {
1.71 + set v [catch {
1.72 + db eval {SELECT * FROM t1} data {
1.73 + break
1.74 + }
1.75 + } msg]
1.76 + lappend v $msg
1.77 +} {0 {}}
1.78 +catch {expr x*} msg
1.79 +do_test tcl-1.6 {
1.80 + set v [catch {
1.81 + db eval {SELECT * FROM t1} data {
1.82 + expr x*
1.83 + }
1.84 + } msg]
1.85 + lappend v $msg
1.86 +} [list 1 $msg]
1.87 +do_test tcl-1.7 {
1.88 + set v [catch {db} msg]
1.89 + lappend v $msg
1.90 +} {1 {wrong # args: should be "db SUBCOMMAND ..."}}
1.91 +if {[catch {db auth {}}]==0} {
1.92 + do_test tcl-1.8 {
1.93 + set v [catch {db authorizer 1 2 3} msg]
1.94 + lappend v $msg
1.95 + } {1 {wrong # args: should be "db authorizer ?CALLBACK?"}}
1.96 +}
1.97 +do_test tcl-1.9 {
1.98 + set v [catch {db busy 1 2 3} msg]
1.99 + lappend v $msg
1.100 +} {1 {wrong # args: should be "db busy CALLBACK"}}
1.101 +do_test tcl-1.10 {
1.102 + set v [catch {db progress 1} msg]
1.103 + lappend v $msg
1.104 +} {1 {wrong # args: should be "db progress N CALLBACK"}}
1.105 +do_test tcl-1.11 {
1.106 + set v [catch {db changes xyz} msg]
1.107 + lappend v $msg
1.108 +} {1 {wrong # args: should be "db changes "}}
1.109 +do_test tcl-1.12 {
1.110 + set v [catch {db commit_hook a b c} msg]
1.111 + lappend v $msg
1.112 +} {1 {wrong # args: should be "db commit_hook ?CALLBACK?"}}
1.113 +ifcapable {complete} {
1.114 + do_test tcl-1.13 {
1.115 + set v [catch {db complete} msg]
1.116 + lappend v $msg
1.117 + } {1 {wrong # args: should be "db complete SQL"}}
1.118 +}
1.119 +do_test tcl-1.14 {
1.120 + set v [catch {db eval} msg]
1.121 + lappend v $msg
1.122 +} {1 {wrong # args: should be "db eval SQL ?ARRAY-NAME? ?SCRIPT?"}}
1.123 +do_test tcl-1.15 {
1.124 + set v [catch {db function} msg]
1.125 + lappend v $msg
1.126 +} {1 {wrong # args: should be "db function NAME [-argcount N] SCRIPT"}}
1.127 +do_test tcl-1.16 {
1.128 + set v [catch {db last_insert_rowid xyz} msg]
1.129 + lappend v $msg
1.130 +} {1 {wrong # args: should be "db last_insert_rowid "}}
1.131 +do_test tcl-1.17 {
1.132 + set v [catch {db rekey} msg]
1.133 + lappend v $msg
1.134 +} {1 {wrong # args: should be "db rekey KEY"}}
1.135 +do_test tcl-1.18 {
1.136 + set v [catch {db timeout} msg]
1.137 + lappend v $msg
1.138 +} {1 {wrong # args: should be "db timeout MILLISECONDS"}}
1.139 +do_test tcl-1.19 {
1.140 + set v [catch {db collate} msg]
1.141 + lappend v $msg
1.142 +} {1 {wrong # args: should be "db collate NAME SCRIPT"}}
1.143 +do_test tcl-1.20 {
1.144 + set v [catch {db collation_needed} msg]
1.145 + lappend v $msg
1.146 +} {1 {wrong # args: should be "db collation_needed SCRIPT"}}
1.147 +do_test tcl-1.21 {
1.148 + set v [catch {db total_changes xyz} msg]
1.149 + lappend v $msg
1.150 +} {1 {wrong # args: should be "db total_changes "}}
1.151 +do_test tcl-1.20 {
1.152 + set v [catch {db copy} msg]
1.153 + lappend v $msg
1.154 +} {1 {wrong # args: should be "db copy CONFLICT-ALGORITHM TABLE FILENAME ?SEPARATOR? ?NULLINDICATOR?"}}
1.155 +do_test tcl-1.21 {
1.156 + set v [catch {sqlite3 db2 test.db -vfs nosuchvfs} msg]
1.157 + lappend v $msg
1.158 +} {1 {no such vfs: nosuchvfs}}
1.159 +
1.160 +catch {unset ::result}
1.161 +do_test tcl-2.1 {
1.162 + execsql "CREATE TABLE t\u0123x(a int, b\u1235 float)"
1.163 +} {}
1.164 +ifcapable schema_pragmas {
1.165 + do_test tcl-2.2 {
1.166 + execsql "PRAGMA table_info(t\u0123x)"
1.167 + } "0 a int 0 {} 0 1 b\u1235 float 0 {} 0"
1.168 +}
1.169 +do_test tcl-2.3 {
1.170 + execsql "INSERT INTO t\u0123x VALUES(1,2.3)"
1.171 + db eval "SELECT * FROM t\u0123x" result break
1.172 + set result(*)
1.173 +} "a b\u1235"
1.174 +
1.175 +
1.176 +# Test the onecolumn method
1.177 +#
1.178 +do_test tcl-3.1 {
1.179 + execsql {
1.180 + INSERT INTO t1 SELECT a*2, b*2 FROM t1;
1.181 + INSERT INTO t1 SELECT a*2+1, b*2+1 FROM t1;
1.182 + INSERT INTO t1 SELECT a*2+3, b*2+3 FROM t1;
1.183 + }
1.184 + set rc [catch {db onecolumn {SELECT * FROM t1 ORDER BY a}} msg]
1.185 + lappend rc $msg
1.186 +} {0 10}
1.187 +do_test tcl-3.2 {
1.188 + db onecolumn {SELECT * FROM t1 WHERE a<0}
1.189 +} {}
1.190 +do_test tcl-3.3 {
1.191 + set rc [catch {db onecolumn} errmsg]
1.192 + lappend rc $errmsg
1.193 +} {1 {wrong # args: should be "db onecolumn SQL"}}
1.194 +do_test tcl-3.4 {
1.195 + set rc [catch {db onecolumn {SELECT bogus}} errmsg]
1.196 + lappend rc $errmsg
1.197 +} {1 {no such column: bogus}}
1.198 +ifcapable {tclvar} {
1.199 + do_test tcl-3.5 {
1.200 + set b 50
1.201 + set rc [catch {db one {SELECT * FROM t1 WHERE b>$b}} msg]
1.202 + lappend rc $msg
1.203 + } {0 41}
1.204 + do_test tcl-3.6 {
1.205 + set b 500
1.206 + set rc [catch {db one {SELECT * FROM t1 WHERE b>$b}} msg]
1.207 + lappend rc $msg
1.208 + } {0 {}}
1.209 + do_test tcl-3.7 {
1.210 + set b 500
1.211 + set rc [catch {db one {
1.212 + INSERT INTO t1 VALUES(99,510);
1.213 + SELECT * FROM t1 WHERE b>$b
1.214 + }} msg]
1.215 + lappend rc $msg
1.216 + } {0 99}
1.217 +}
1.218 +ifcapable {!tclvar} {
1.219 + execsql {INSERT INTO t1 VALUES(99,510)}
1.220 +}
1.221 +
1.222 +# Turn the busy handler on and off
1.223 +#
1.224 +do_test tcl-4.1 {
1.225 + proc busy_callback {cnt} {
1.226 + break
1.227 + }
1.228 + db busy busy_callback
1.229 + db busy
1.230 +} {busy_callback}
1.231 +do_test tcl-4.2 {
1.232 + db busy {}
1.233 + db busy
1.234 +} {}
1.235 +
1.236 +ifcapable {tclvar} {
1.237 + # Parsing of TCL variable names within SQL into bound parameters.
1.238 + #
1.239 + do_test tcl-5.1 {
1.240 + execsql {CREATE TABLE t3(a,b,c)}
1.241 + catch {unset x}
1.242 + set x(1) A
1.243 + set x(2) B
1.244 + execsql {
1.245 + INSERT INTO t3 VALUES($::x(1),$::x(2),$::x(3));
1.246 + SELECT * FROM t3
1.247 + }
1.248 + } {A B {}}
1.249 + do_test tcl-5.2 {
1.250 + execsql {
1.251 + SELECT typeof(a), typeof(b), typeof(c) FROM t3
1.252 + }
1.253 + } {text text null}
1.254 + do_test tcl-5.3 {
1.255 + catch {unset x}
1.256 + set x [binary format h12 686900686f00]
1.257 + execsql {
1.258 + UPDATE t3 SET a=$::x;
1.259 + }
1.260 + db eval {
1.261 + SELECT a FROM t3
1.262 + } break
1.263 + binary scan $a h12 adata
1.264 + set adata
1.265 + } {686900686f00}
1.266 + do_test tcl-5.4 {
1.267 + execsql {
1.268 + SELECT typeof(a), typeof(b), typeof(c) FROM t3
1.269 + }
1.270 + } {blob text null}
1.271 +}
1.272 +
1.273 +# Operation of "break" and "continue" within row scripts
1.274 +#
1.275 +do_test tcl-6.1 {
1.276 + db eval {SELECT * FROM t1} {
1.277 + break
1.278 + }
1.279 + lappend a $b
1.280 +} {10 20}
1.281 +do_test tcl-6.2 {
1.282 + set cnt 0
1.283 + db eval {SELECT * FROM t1} {
1.284 + if {$a>40} continue
1.285 + incr cnt
1.286 + }
1.287 + set cnt
1.288 +} {4}
1.289 +do_test tcl-6.3 {
1.290 + set cnt 0
1.291 + db eval {SELECT * FROM t1} {
1.292 + if {$a<40} continue
1.293 + incr cnt
1.294 + }
1.295 + set cnt
1.296 +} {5}
1.297 +do_test tcl-6.4 {
1.298 + proc return_test {x} {
1.299 + db eval {SELECT * FROM t1} {
1.300 + if {$a==$x} {return $b}
1.301 + }
1.302 + }
1.303 + return_test 10
1.304 +} 20
1.305 +do_test tcl-6.5 {
1.306 + return_test 20
1.307 +} 40
1.308 +do_test tcl-6.6 {
1.309 + return_test 99
1.310 +} 510
1.311 +do_test tcl-6.7 {
1.312 + return_test 0
1.313 +} {}
1.314 +
1.315 +do_test tcl-7.1 {
1.316 + db version
1.317 + expr 0
1.318 +} {0}
1.319 +
1.320 +# modify and reset the NULL representation
1.321 +#
1.322 +do_test tcl-8.1 {
1.323 + db nullvalue NaN
1.324 + execsql {INSERT INTO t1 VALUES(30,NULL)}
1.325 + db eval {SELECT * FROM t1 WHERE b IS NULL}
1.326 +} {30 NaN}
1.327 +do_test tcl-8.2 {
1.328 + db nullvalue NULL
1.329 + db nullvalue
1.330 +} {NULL}
1.331 +do_test tcl-8.3 {
1.332 + db nullvalue {}
1.333 + db eval {SELECT * FROM t1 WHERE b IS NULL}
1.334 +} {30 {}}
1.335 +
1.336 +# Test the return type of user-defined functions
1.337 +#
1.338 +do_test tcl-9.1 {
1.339 + db function ret_str {return "hi"}
1.340 + execsql {SELECT typeof(ret_str())}
1.341 +} {text}
1.342 +do_test tcl-9.2 {
1.343 + db function ret_dbl {return [expr {rand()*0.5}]}
1.344 + execsql {SELECT typeof(ret_dbl())}
1.345 +} {real}
1.346 +do_test tcl-9.3 {
1.347 + db function ret_int {return [expr {int(rand()*200)}]}
1.348 + execsql {SELECT typeof(ret_int())}
1.349 +} {integer}
1.350 +
1.351 +# Recursive calls to the same user-defined function
1.352 +#
1.353 +ifcapable tclvar {
1.354 + do_test tcl-9.10 {
1.355 + proc userfunc_r1 {n} {
1.356 + if {$n<=0} {return 0}
1.357 + set nm1 [expr {$n-1}]
1.358 + return [expr {[db eval {SELECT r1($nm1)}]+$n}]
1.359 + }
1.360 + db function r1 userfunc_r1
1.361 + execsql {SELECT r1(10)}
1.362 + } {55}
1.363 + if {$::tcl_platform(platform)!="symbian"} {
1.364 + do_test tcl-9.11 {
1.365 + execsql {SELECT r1(100)}
1.366 + } {5050}
1.367 + }
1.368 +}
1.369 +
1.370 +# Tests for the new transaction method
1.371 +#
1.372 +do_test tcl-10.1 {
1.373 + db transaction {}
1.374 +} {}
1.375 +do_test tcl-10.2 {
1.376 + db transaction deferred {}
1.377 +} {}
1.378 +do_test tcl-10.3 {
1.379 + db transaction immediate {}
1.380 +} {}
1.381 +do_test tcl-10.4 {
1.382 + db transaction exclusive {}
1.383 +} {}
1.384 +do_test tcl-10.5 {
1.385 + set rc [catch {db transaction xyzzy {}} msg]
1.386 + lappend rc $msg
1.387 +} {1 {bad transaction type "xyzzy": must be deferred, exclusive, or immediate}}
1.388 +do_test tcl-10.6 {
1.389 + set rc [catch {db transaction {error test-error}} msg]
1.390 + lappend rc $msg
1.391 +} {1 test-error}
1.392 +do_test tcl-10.7 {
1.393 + db transaction {
1.394 + db eval {CREATE TABLE t4(x)}
1.395 + db transaction {
1.396 + db eval {INSERT INTO t4 VALUES(1)}
1.397 + }
1.398 + }
1.399 + db eval {SELECT * FROM t4}
1.400 +} 1
1.401 +do_test tcl-10.8 {
1.402 + catch {
1.403 + db transaction {
1.404 + db eval {INSERT INTO t4 VALUES(2)}
1.405 + db eval {INSERT INTO t4 VALUES(3)}
1.406 + db eval {INSERT INTO t4 VALUES(4)}
1.407 + error test-error
1.408 + }
1.409 + }
1.410 + db eval {SELECT * FROM t4}
1.411 +} 1
1.412 +do_test tcl-10.9 {
1.413 + db transaction {
1.414 + db eval {INSERT INTO t4 VALUES(2)}
1.415 + catch {
1.416 + db transaction {
1.417 + db eval {INSERT INTO t4 VALUES(3)}
1.418 + db eval {INSERT INTO t4 VALUES(4)}
1.419 + error test-error
1.420 + }
1.421 + }
1.422 + }
1.423 + db eval {SELECT * FROM t4}
1.424 +} {1 2 3 4}
1.425 +do_test tcl-10.10 {
1.426 + for {set i 0} {$i<1} {incr i} {
1.427 + db transaction {
1.428 + db eval {INSERT INTO t4 VALUES(5)}
1.429 + continue
1.430 + }
1.431 + }
1.432 + db eval {SELECT * FROM t4}
1.433 +} {1 2 3 4 5}
1.434 +do_test tcl-10.11 {
1.435 + for {set i 0} {$i<10} {incr i} {
1.436 + db transaction {
1.437 + db eval {INSERT INTO t4 VALUES(6)}
1.438 + break
1.439 + }
1.440 + }
1.441 + db eval {SELECT * FROM t4}
1.442 +} {1 2 3 4 5 6}
1.443 +do_test tcl-10.12 {
1.444 + set rc [catch {
1.445 + for {set i 0} {$i<10} {incr i} {
1.446 + db transaction {
1.447 + db eval {INSERT INTO t4 VALUES(7)}
1.448 + return
1.449 + }
1.450 + }
1.451 + }]
1.452 +} {2}
1.453 +do_test tcl-10.13 {
1.454 + db eval {SELECT * FROM t4}
1.455 +} {1 2 3 4 5 6 7}
1.456 +
1.457 +do_test tcl-11.1 {
1.458 + db exists {SELECT x,x*2,x+x FROM t4 WHERE x==4}
1.459 +} {1}
1.460 +do_test tcl-11.2 {
1.461 + db exists {SELECT 0 FROM t4 WHERE x==4}
1.462 +} {1}
1.463 +do_test tcl-11.3 {
1.464 + db exists {SELECT 1 FROM t4 WHERE x==8}
1.465 +} {0}
1.466 +
1.467 +do_test tcl-12.1 {
1.468 + unset -nocomplain a b c version
1.469 + set version [db version]
1.470 + scan $version "%d.%d.%d" a b c
1.471 + expr $a*1000000 + $b*1000 + $c
1.472 +} [sqlite3_libversion_number]
1.473 +
1.474 +
1.475 +# Check to see that when bindings of the form @aaa are used instead
1.476 +# of $aaa, that objects are treated as bytearray and are inserted
1.477 +# as BLOBs.
1.478 +#
1.479 +ifcapable tclvar {
1.480 + do_test tcl-13.1 {
1.481 + db eval {CREATE TABLE t5(x BLOB)}
1.482 + set x abc123
1.483 + db eval {INSERT INTO t5 VALUES($x)}
1.484 + db eval {SELECT typeof(x) FROM t5}
1.485 + } {text}
1.486 + do_test tcl-13.2 {
1.487 + binary scan $x H notUsed
1.488 + db eval {
1.489 + DELETE FROM t5;
1.490 + INSERT INTO t5 VALUES($x);
1.491 + SELECT typeof(x) FROM t5;
1.492 + }
1.493 + } {text}
1.494 + do_test tcl-13.3 {
1.495 + db eval {
1.496 + DELETE FROM t5;
1.497 + INSERT INTO t5 VALUES(@x);
1.498 + SELECT typeof(x) FROM t5;
1.499 + }
1.500 + } {blob}
1.501 + do_test tcl-13.4 {
1.502 + set y 1234
1.503 + db eval {
1.504 + DELETE FROM t5;
1.505 + INSERT INTO t5 VALUES(@y);
1.506 + SELECT hex(x), typeof(x) FROM t5
1.507 + }
1.508 + } {31323334 blob}
1.509 +}
1.510 +
1.511 +
1.512 +finish_test