blob: 36063bc46d03b5f1862fe13c319b58cb383693c8 [file] [log] [blame]
drhb19a2bc2001-09-16 00:13:26 +00001# 2001 September 15
drh960e8c62001-04-03 16:53:21 +00002#
drhb19a2bc2001-09-16 00:13:26 +00003# The author disclaims copyright to this source code. In place of
4# a legal notice, here is a blessing:
drh960e8c62001-04-03 16:53:21 +00005#
drhb19a2bc2001-09-16 00:13:26 +00006# May you do good and not evil.
7# May you find forgiveness for yourself and forgive others.
8# May you share freely, never taking more than you give.
drh960e8c62001-04-03 16:53:21 +00009#
10#***********************************************************************
11# This file implements regression tests for TCL interface to the
12# SQLite library.
13#
14# Actually, all tests are based on the TCL interface, so the main
15# interface is pretty well tested. This file contains some addition
16# tests for fringe issues that the main test suite does not cover.
17#
danielk1977404ca072009-03-16 13:19:36 +000018# $Id: tclsqlite.test,v 1.73 2009/03/16 13:19:36 danielk1977 Exp $
drh960e8c62001-04-03 16:53:21 +000019
drhc6727c82018-09-19 15:08:21 +000020catch {sqlite3}
21
drh960e8c62001-04-03 16:53:21 +000022set testdir [file dirname $argv0]
23source $testdir/tester.tcl
24
25# Check the error messages generated by tclsqlite
26#
drh4dcac402018-01-03 13:20:02 +000027set r "sqlite_orig HANDLE ?FILENAME? ?-vfs VFSNAME? ?-readonly BOOLEAN? ?-create BOOLEAN? ?-nomutex BOOLEAN? ?-fullmutex BOOLEAN? ?-uri BOOLEAN?"
drhef4ac8f2004-06-19 00:16:31 +000028if {[sqlite3 -has-codec]} {
drh7da56b42016-03-14 18:34:42 +000029 append r " ?-key CODECKEY?"
drh22fbcb82004-02-01 01:22:50 +000030}
drh960e8c62001-04-03 16:53:21 +000031do_test tcl-1.1 {
drh4dcac402018-01-03 13:20:02 +000032 set v [catch {sqlite3 -bogus} msg]
drhdf81a252008-08-25 19:09:01 +000033 regsub {really_sqlite3} $msg {sqlite3} msg
drh960e8c62001-04-03 16:53:21 +000034 lappend v $msg
drh22fbcb82004-02-01 01:22:50 +000035} [list 1 "wrong # args: should be \"$r\""]
drhc6727c82018-09-19 15:08:21 +000036do_test tcl-1.1.1 {
37 set v [catch {sqlite3} msg]
38 regsub {really_sqlite3} $msg {sqlite3} msg
39 lappend v $msg
40} [list 1 "wrong # args: should be \"$r\""]
drh960e8c62001-04-03 16:53:21 +000041do_test tcl-1.2 {
42 set v [catch {db bogus} msg]
43 lappend v $msg
drh3ec86652018-01-03 19:03:31 +000044} {1 {bad option "bogus": must be authorizer, backup, busy, cache, changes, close, collate, collation_needed, commit_hook, complete, copy, deserialize, enable_load_extension, errorcode, eval, exists, function, incrblob, interrupt, last_insert_rowid, nullvalue, onecolumn, preupdate, profile, progress, rekey, restore, rollback_hook, serialize, status, timeout, total_changes, trace, trace_v2, transaction, unlock_notify, update_hook, version, or wal_hook}}
danielk1977191fadc2007-10-23 08:17:48 +000045do_test tcl-1.2.1 {
46 set v [catch {db cache bogus} msg]
47 lappend v $msg
48} {1 {bad option "bogus": must be flush or size}}
49do_test tcl-1.2.2 {
50 set v [catch {db cache} msg]
51 lappend v $msg
52} {1 {wrong # args: should be "db cache option ?arg?"}}
drh960e8c62001-04-03 16:53:21 +000053do_test tcl-1.3 {
54 execsql {CREATE TABLE t1(a int, b int)}
55 execsql {INSERT INTO t1 VALUES(10,20)}
56 set v [catch {
57 db eval {SELECT * FROM t1} data {
58 error "The error message"
59 }
60 } msg]
61 lappend v $msg
62} {1 {The error message}}
63do_test tcl-1.4 {
64 set v [catch {
65 db eval {SELECT * FROM t2} data {
66 error "The error message"
67 }
68 } msg]
69 lappend v $msg
70} {1 {no such table: t2}}
71do_test tcl-1.5 {
72 set v [catch {
73 db eval {SELECT * FROM t1} data {
74 break
75 }
76 } msg]
77 lappend v $msg
78} {0 {}}
drhd65e5302008-04-28 13:02:57 +000079catch {expr x*} msg
drh960e8c62001-04-03 16:53:21 +000080do_test tcl-1.6 {
81 set v [catch {
82 db eval {SELECT * FROM t1} data {
83 expr x*
84 }
85 } msg]
86 lappend v $msg
drhd65e5302008-04-28 13:02:57 +000087} [list 1 $msg]
drh0f14e2e2004-06-29 12:39:08 +000088do_test tcl-1.7 {
89 set v [catch {db} msg]
90 lappend v $msg
91} {1 {wrong # args: should be "db SUBCOMMAND ..."}}
drh1211de32004-07-26 12:24:22 +000092if {[catch {db auth {}}]==0} {
93 do_test tcl-1.8 {
94 set v [catch {db authorizer 1 2 3} msg]
95 lappend v $msg
96 } {1 {wrong # args: should be "db authorizer ?CALLBACK?"}}
97}
drh0f14e2e2004-06-29 12:39:08 +000098do_test tcl-1.9 {
99 set v [catch {db busy 1 2 3} msg]
100 lappend v $msg
101} {1 {wrong # args: should be "db busy CALLBACK"}}
102do_test tcl-1.10 {
103 set v [catch {db progress 1} msg]
104 lappend v $msg
105} {1 {wrong # args: should be "db progress N CALLBACK"}}
106do_test tcl-1.11 {
107 set v [catch {db changes xyz} msg]
108 lappend v $msg
109} {1 {wrong # args: should be "db changes "}}
110do_test tcl-1.12 {
111 set v [catch {db commit_hook a b c} msg]
112 lappend v $msg
113} {1 {wrong # args: should be "db commit_hook ?CALLBACK?"}}
drhccae6022005-02-26 17:31:26 +0000114ifcapable {complete} {
115 do_test tcl-1.13 {
116 set v [catch {db complete} msg]
117 lappend v $msg
118 } {1 {wrong # args: should be "db complete SQL"}}
119}
drh0f14e2e2004-06-29 12:39:08 +0000120do_test tcl-1.14 {
121 set v [catch {db eval} msg]
122 lappend v $msg
drhaf38cdb2017-06-26 21:08:32 +0000123} {1 {wrong # args: should be "db eval ?OPTIONS? SQL ?ARRAY-NAME? ?SCRIPT?"}}
drh0f14e2e2004-06-29 12:39:08 +0000124do_test tcl-1.15 {
125 set v [catch {db function} msg]
126 lappend v $msg
dan3df30592015-03-13 08:31:54 +0000127} {1 {wrong # args: should be "db function NAME ?SWITCHES? SCRIPT"}}
danielk19777ddad962005-12-12 06:53:03 +0000128do_test tcl-1.16 {
drh0f14e2e2004-06-29 12:39:08 +0000129 set v [catch {db last_insert_rowid xyz} msg]
130 lappend v $msg
131} {1 {wrong # args: should be "db last_insert_rowid "}}
danielk19777ddad962005-12-12 06:53:03 +0000132do_test tcl-1.17 {
drh0f14e2e2004-06-29 12:39:08 +0000133 set v [catch {db rekey} msg]
134 lappend v $msg
135} {1 {wrong # args: should be "db rekey KEY"}}
danielk19777ddad962005-12-12 06:53:03 +0000136do_test tcl-1.18 {
drh0f14e2e2004-06-29 12:39:08 +0000137 set v [catch {db timeout} msg]
138 lappend v $msg
139} {1 {wrong # args: should be "db timeout MILLISECONDS"}}
danielk19777ddad962005-12-12 06:53:03 +0000140do_test tcl-1.19 {
drh0f14e2e2004-06-29 12:39:08 +0000141 set v [catch {db collate} msg]
142 lappend v $msg
143} {1 {wrong # args: should be "db collate NAME SCRIPT"}}
danielk19777ddad962005-12-12 06:53:03 +0000144do_test tcl-1.20 {
drh0f14e2e2004-06-29 12:39:08 +0000145 set v [catch {db collation_needed} msg]
146 lappend v $msg
147} {1 {wrong # args: should be "db collation_needed SCRIPT"}}
danielk19777ddad962005-12-12 06:53:03 +0000148do_test tcl-1.21 {
drh0f14e2e2004-06-29 12:39:08 +0000149 set v [catch {db total_changes xyz} msg]
150 lappend v $msg
151} {1 {wrong # args: should be "db total_changes "}}
mistachkin1c9ee262012-09-10 23:44:12 +0000152do_test tcl-1.22 {
tpoindex1067fe12004-12-17 15:41:11 +0000153 set v [catch {db copy} msg]
154 lappend v $msg
155} {1 {wrong # args: should be "db copy CONFLICT-ALGORITHM TABLE FILENAME ?SEPARATOR? ?NULLINDICATOR?"}}
mistachkin1c9ee262012-09-10 23:44:12 +0000156do_test tcl-1.23 {
danielk197795c8a542007-09-01 06:51:27 +0000157 set v [catch {sqlite3 db2 test.db -vfs nosuchvfs} msg]
158 lappend v $msg
159} {1 {no such vfs: nosuchvfs}}
drh960e8c62001-04-03 16:53:21 +0000160
drh3570ad92007-08-31 14:31:44 +0000161catch {unset ::result}
162do_test tcl-2.1 {
163 execsql "CREATE TABLE t\u0123x(a int, b\u1235 float)"
164} {}
165ifcapable schema_pragmas {
166 do_test tcl-2.2 {
167 execsql "PRAGMA table_info(t\u0123x)"
168 } "0 a int 0 {} 0 1 b\u1235 float 0 {} 0"
drh6d4abfb2001-10-22 02:58:08 +0000169}
drh3570ad92007-08-31 14:31:44 +0000170do_test tcl-2.3 {
171 execsql "INSERT INTO t\u0123x VALUES(1,2.3)"
172 db eval "SELECT * FROM t\u0123x" result break
173 set result(*)
174} "a b\u1235"
drh6d4abfb2001-10-22 02:58:08 +0000175
drh6d4abfb2001-10-22 02:58:08 +0000176
drh5d9d7572003-08-19 14:31:01 +0000177# Test the onecolumn method
178#
179do_test tcl-3.1 {
180 execsql {
181 INSERT INTO t1 SELECT a*2, b*2 FROM t1;
182 INSERT INTO t1 SELECT a*2+1, b*2+1 FROM t1;
183 INSERT INTO t1 SELECT a*2+3, b*2+3 FROM t1;
184 }
drh22fbcb82004-02-01 01:22:50 +0000185 set rc [catch {db onecolumn {SELECT * FROM t1 ORDER BY a}} msg]
186 lappend rc $msg
187} {0 10}
drh5d9d7572003-08-19 14:31:01 +0000188do_test tcl-3.2 {
189 db onecolumn {SELECT * FROM t1 WHERE a<0}
190} {}
191do_test tcl-3.3 {
192 set rc [catch {db onecolumn} errmsg]
193 lappend rc $errmsg
194} {1 {wrong # args: should be "db onecolumn SQL"}}
drh0f14e2e2004-06-29 12:39:08 +0000195do_test tcl-3.4 {
196 set rc [catch {db onecolumn {SELECT bogus}} errmsg]
197 lappend rc $errmsg
198} {1 {no such column: bogus}}
drh6bf89572004-11-03 16:27:01 +0000199ifcapable {tclvar} {
200 do_test tcl-3.5 {
201 set b 50
202 set rc [catch {db one {SELECT * FROM t1 WHERE b>$b}} msg]
203 lappend rc $msg
204 } {0 41}
205 do_test tcl-3.6 {
206 set b 500
207 set rc [catch {db one {SELECT * FROM t1 WHERE b>$b}} msg]
208 lappend rc $msg
209 } {0 {}}
210 do_test tcl-3.7 {
211 set b 500
212 set rc [catch {db one {
213 INSERT INTO t1 VALUES(99,510);
214 SELECT * FROM t1 WHERE b>$b
215 }} msg]
216 lappend rc $msg
217 } {0 99}
218}
219ifcapable {!tclvar} {
220 execsql {INSERT INTO t1 VALUES(99,510)}
221}
drh5d9d7572003-08-19 14:31:01 +0000222
drh0f14e2e2004-06-29 12:39:08 +0000223# Turn the busy handler on and off
224#
225do_test tcl-4.1 {
226 proc busy_callback {cnt} {
227 break
228 }
229 db busy busy_callback
230 db busy
231} {busy_callback}
232do_test tcl-4.2 {
233 db busy {}
234 db busy
235} {}
drh6d4abfb2001-10-22 02:58:08 +0000236
drh6bf89572004-11-03 16:27:01 +0000237ifcapable {tclvar} {
238 # Parsing of TCL variable names within SQL into bound parameters.
239 #
240 do_test tcl-5.1 {
241 execsql {CREATE TABLE t3(a,b,c)}
242 catch {unset x}
danielk19777a1d17f2008-08-29 15:54:56 +0000243 set x(1) A
244 set x(2) B
drh6bf89572004-11-03 16:27:01 +0000245 execsql {
246 INSERT INTO t3 VALUES($::x(1),$::x(2),$::x(3));
247 SELECT * FROM t3
248 }
danielk19777a1d17f2008-08-29 15:54:56 +0000249 } {A B {}}
drh6bf89572004-11-03 16:27:01 +0000250 do_test tcl-5.2 {
251 execsql {
252 SELECT typeof(a), typeof(b), typeof(c) FROM t3
253 }
254 } {text text null}
255 do_test tcl-5.3 {
256 catch {unset x}
257 set x [binary format h12 686900686f00]
258 execsql {
259 UPDATE t3 SET a=$::x;
260 }
261 db eval {
262 SELECT a FROM t3
263 } break
264 binary scan $a h12 adata
265 set adata
266 } {686900686f00}
267 do_test tcl-5.4 {
268 execsql {
269 SELECT typeof(a), typeof(b), typeof(c) FROM t3
270 }
271 } {blob text null}
272}
drh92febd92004-08-20 18:34:20 +0000273
drhfd241b02004-09-13 13:46:01 +0000274# Operation of "break" and "continue" within row scripts
275#
276do_test tcl-6.1 {
277 db eval {SELECT * FROM t1} {
278 break
279 }
280 lappend a $b
281} {10 20}
282do_test tcl-6.2 {
283 set cnt 0
284 db eval {SELECT * FROM t1} {
285 if {$a>40} continue
286 incr cnt
287 }
288 set cnt
289} {4}
290do_test tcl-6.3 {
291 set cnt 0
292 db eval {SELECT * FROM t1} {
293 if {$a<40} continue
294 incr cnt
295 }
296 set cnt
297} {5}
298do_test tcl-6.4 {
299 proc return_test {x} {
300 db eval {SELECT * FROM t1} {
301 if {$a==$x} {return $b}
302 }
303 }
304 return_test 10
305} 20
306do_test tcl-6.5 {
307 return_test 20
308} 40
309do_test tcl-6.6 {
310 return_test 99
311} 510
312do_test tcl-6.7 {
313 return_test 0
314} {}
315
danielk19774397de52005-01-12 12:44:03 +0000316do_test tcl-7.1 {
317 db version
318 expr 0
319} {0}
320
danielk197755c45f22005-04-03 23:54:43 +0000321# modify and reset the NULL representation
322#
323do_test tcl-8.1 {
324 db nullvalue NaN
325 execsql {INSERT INTO t1 VALUES(30,NULL)}
326 db eval {SELECT * FROM t1 WHERE b IS NULL}
327} {30 NaN}
drhc45e6712012-10-03 11:02:33 +0000328proc concatFunc args {return [join $args {}]}
danielk197755c45f22005-04-03 23:54:43 +0000329do_test tcl-8.2 {
drhc45e6712012-10-03 11:02:33 +0000330 db function concat concatFunc
331 db eval {SELECT concat('a', b, 'z') FROM t1 WHERE b is NULL}
332} {aNaNz}
333do_test tcl-8.3 {
danielk197755c45f22005-04-03 23:54:43 +0000334 db nullvalue NULL
335 db nullvalue
336} {NULL}
drhc45e6712012-10-03 11:02:33 +0000337do_test tcl-8.4 {
danielk197755c45f22005-04-03 23:54:43 +0000338 db nullvalue {}
339 db eval {SELECT * FROM t1 WHERE b IS NULL}
340} {30 {}}
drhc45e6712012-10-03 11:02:33 +0000341do_test tcl-8.5 {
342 db function concat concatFunc
343 db eval {SELECT concat('a', b, 'z') FROM t1 WHERE b is NULL}
344} {az}
danielk197755c45f22005-04-03 23:54:43 +0000345
drhc7f269d2005-05-05 10:30:29 +0000346# Test the return type of user-defined functions
347#
348do_test tcl-9.1 {
349 db function ret_str {return "hi"}
350 execsql {SELECT typeof(ret_str())}
351} {text}
352do_test tcl-9.2 {
drh9645d8d2006-09-01 15:49:05 +0000353 db function ret_dbl {return [expr {rand()*0.5}]}
drhc7f269d2005-05-05 10:30:29 +0000354 execsql {SELECT typeof(ret_dbl())}
355} {real}
356do_test tcl-9.3 {
drh9645d8d2006-09-01 15:49:05 +0000357 db function ret_int {return [expr {int(rand()*200)}]}
drhc7f269d2005-05-05 10:30:29 +0000358 execsql {SELECT typeof(ret_int())}
359} {integer}
360
drhd1e47332005-06-26 17:55:33 +0000361# Recursive calls to the same user-defined function
362#
danielk19773bdca9c2006-01-17 09:35:01 +0000363ifcapable tclvar {
364 do_test tcl-9.10 {
365 proc userfunc_r1 {n} {
366 if {$n<=0} {return 0}
367 set nm1 [expr {$n-1}]
368 return [expr {[db eval {SELECT r1($nm1)}]+$n}]
369 }
370 db function r1 userfunc_r1
371 execsql {SELECT r1(10)}
372 } {55}
373 do_test tcl-9.11 {
374 execsql {SELECT r1(100)}
375 } {5050}
376}
drhd1e47332005-06-26 17:55:33 +0000377
drhb5555e72005-08-02 17:15:14 +0000378# Tests for the new transaction method
379#
380do_test tcl-10.1 {
381 db transaction {}
382} {}
383do_test tcl-10.2 {
384 db transaction deferred {}
385} {}
386do_test tcl-10.3 {
387 db transaction immediate {}
388} {}
389do_test tcl-10.4 {
390 db transaction exclusive {}
391} {}
392do_test tcl-10.5 {
393 set rc [catch {db transaction xyzzy {}} msg]
394 lappend rc $msg
395} {1 {bad transaction type "xyzzy": must be deferred, exclusive, or immediate}}
396do_test tcl-10.6 {
397 set rc [catch {db transaction {error test-error}} msg]
398 lappend rc $msg
399} {1 test-error}
400do_test tcl-10.7 {
401 db transaction {
402 db eval {CREATE TABLE t4(x)}
403 db transaction {
404 db eval {INSERT INTO t4 VALUES(1)}
405 }
406 }
407 db eval {SELECT * FROM t4}
408} 1
409do_test tcl-10.8 {
410 catch {
411 db transaction {
412 db eval {INSERT INTO t4 VALUES(2)}
413 db eval {INSERT INTO t4 VALUES(3)}
414 db eval {INSERT INTO t4 VALUES(4)}
415 error test-error
416 }
417 }
418 db eval {SELECT * FROM t4}
419} 1
420do_test tcl-10.9 {
421 db transaction {
422 db eval {INSERT INTO t4 VALUES(2)}
423 catch {
424 db transaction {
425 db eval {INSERT INTO t4 VALUES(3)}
426 db eval {INSERT INTO t4 VALUES(4)}
427 error test-error
428 }
429 }
430 }
431 db eval {SELECT * FROM t4}
danielk1977cd38d522009-01-02 17:33:46 +0000432} {1 2}
drhb5555e72005-08-02 17:15:14 +0000433do_test tcl-10.10 {
434 for {set i 0} {$i<1} {incr i} {
435 db transaction {
436 db eval {INSERT INTO t4 VALUES(5)}
437 continue
438 }
danielk1977cd38d522009-01-02 17:33:46 +0000439 error "This line should not be run"
drhb5555e72005-08-02 17:15:14 +0000440 }
441 db eval {SELECT * FROM t4}
danielk1977cd38d522009-01-02 17:33:46 +0000442} {1 2 5}
drhb5555e72005-08-02 17:15:14 +0000443do_test tcl-10.11 {
444 for {set i 0} {$i<10} {incr i} {
445 db transaction {
446 db eval {INSERT INTO t4 VALUES(6)}
447 break
448 }
449 }
450 db eval {SELECT * FROM t4}
danielk1977cd38d522009-01-02 17:33:46 +0000451} {1 2 5 6}
drhb5555e72005-08-02 17:15:14 +0000452do_test tcl-10.12 {
453 set rc [catch {
454 for {set i 0} {$i<10} {incr i} {
455 db transaction {
456 db eval {INSERT INTO t4 VALUES(7)}
457 return
458 }
459 }
460 }]
461} {2}
462do_test tcl-10.13 {
463 db eval {SELECT * FROM t4}
danielk1977cd38d522009-01-02 17:33:46 +0000464} {1 2 5 6 7}
465
466# Now test that [db transaction] commands may be nested with
467# the expected results.
468#
469do_test tcl-10.14 {
470 db transaction {
471 db eval {
472 DELETE FROM t4;
473 INSERT INTO t4 VALUES('one');
474 }
475
476 catch {
477 db transaction {
478 db eval { INSERT INTO t4 VALUES('two') }
479 db transaction {
480 db eval { INSERT INTO t4 VALUES('three') }
481 error "throw an error!"
482 }
483 }
484 }
485 }
486
487 db eval {SELECT * FROM t4}
488} {one}
489do_test tcl-10.15 {
490 # Make sure a transaction has not been left open.
491 db eval {BEGIN ; COMMIT}
492} {}
493do_test tcl-10.16 {
494 db transaction {
495 db eval { INSERT INTO t4 VALUES('two'); }
496 db transaction {
497 db eval { INSERT INTO t4 VALUES('three') }
498 db transaction {
499 db eval { INSERT INTO t4 VALUES('four') }
500 }
501 }
502 }
503 db eval {SELECT * FROM t4}
504} {one two three four}
505do_test tcl-10.17 {
506 catch {
507 db transaction {
508 db eval { INSERT INTO t4 VALUES('A'); }
509 db transaction {
510 db eval { INSERT INTO t4 VALUES('B') }
511 db transaction {
512 db eval { INSERT INTO t4 VALUES('C') }
513 error "throw an error!"
514 }
515 }
516 }
517 }
518 db eval {SELECT * FROM t4}
519} {one two three four}
520do_test tcl-10.18 {
521 # Make sure a transaction has not been left open.
522 db eval {BEGIN ; COMMIT}
523} {}
524
525# Mess up a [db transaction] command by locking the database using a
526# second connection when it tries to commit. Make sure the transaction
527# is not still open after the "database is locked" exception is thrown.
528#
529do_test tcl-10.18 {
530 sqlite3 db2 test.db
531 db2 eval {
532 BEGIN;
533 SELECT * FROM sqlite_master;
534 }
535
536 set rc [catch {
537 db transaction {
538 db eval {INSERT INTO t4 VALUES('five')}
539 }
540 } msg]
541 list $rc $msg
542} {1 {database is locked}}
543do_test tcl-10.19 {
544 db eval {BEGIN ; COMMIT}
545} {}
546
547# Thwart a [db transaction] command by locking the database using a
548# second connection with "BEGIN EXCLUSIVE". Make sure no transaction is
549# open after the "database is locked" exception is thrown.
550#
551do_test tcl-10.20 {
552 db2 eval {
553 COMMIT;
554 BEGIN EXCLUSIVE;
555 }
556 set rc [catch {
557 db transaction {
558 db eval {INSERT INTO t4 VALUES('five')}
559 }
560 } msg]
561 list $rc $msg
562} {1 {database is locked}}
563do_test tcl-10.21 {
564 db2 close
565 db eval {BEGIN ; COMMIT}
566} {}
567do_test tcl-10.22 {
568 sqlite3 db2 test.db
569 db transaction exclusive {
570 catch { db2 eval {SELECT * FROM sqlite_master} } msg
571 set msg "db2: $msg"
572 }
573 set msg
574} {db2: database is locked}
575db2 close
drhc7f269d2005-05-05 10:30:29 +0000576
drh97f2ebc2005-12-10 21:19:04 +0000577do_test tcl-11.1 {
danielk1977cd38d522009-01-02 17:33:46 +0000578 db eval {INSERT INTO t4 VALUES(6)}
579 db exists {SELECT x,x*2,x+x FROM t4 WHERE x==6}
drh97f2ebc2005-12-10 21:19:04 +0000580} {1}
581do_test tcl-11.2 {
danielk1977cd38d522009-01-02 17:33:46 +0000582 db exists {SELECT 0 FROM t4 WHERE x==6}
drh97f2ebc2005-12-10 21:19:04 +0000583} {1}
584do_test tcl-11.3 {
585 db exists {SELECT 1 FROM t4 WHERE x==8}
586} {0}
drha2c8a952009-10-13 18:38:34 +0000587do_test tcl-11.3.1 {
588 tcl_objproc db exists {SELECT 1 FROM t4 WHERE x==8}
589} {0}
drh97f2ebc2005-12-10 21:19:04 +0000590
danielk1977161fb792006-01-24 10:58:21 +0000591do_test tcl-12.1 {
592 unset -nocomplain a b c version
593 set version [db version]
594 scan $version "%d.%d.%d" a b c
595 expr $a*1000000 + $b*1000 + $c
596} [sqlite3_libversion_number]
597
drh4f5e80f2007-06-19 17:15:46 +0000598
599# Check to see that when bindings of the form @aaa are used instead
drh1c747812007-06-19 23:01:41 +0000600# of $aaa, that objects are treated as bytearray and are inserted
601# as BLOBs.
drh4f5e80f2007-06-19 17:15:46 +0000602#
danielk19774152e672007-09-12 17:01:45 +0000603ifcapable tclvar {
604 do_test tcl-13.1 {
605 db eval {CREATE TABLE t5(x BLOB)}
606 set x abc123
607 db eval {INSERT INTO t5 VALUES($x)}
608 db eval {SELECT typeof(x) FROM t5}
609 } {text}
610 do_test tcl-13.2 {
611 binary scan $x H notUsed
612 db eval {
613 DELETE FROM t5;
614 INSERT INTO t5 VALUES($x);
615 SELECT typeof(x) FROM t5;
616 }
617 } {text}
618 do_test tcl-13.3 {
619 db eval {
620 DELETE FROM t5;
621 INSERT INTO t5 VALUES(@x);
622 SELECT typeof(x) FROM t5;
623 }
624 } {blob}
625 do_test tcl-13.4 {
626 set y 1234
627 db eval {
628 DELETE FROM t5;
629 INSERT INTO t5 VALUES(@y);
630 SELECT hex(x), typeof(x) FROM t5
631 }
632 } {31323334 blob}
633}
drh1c747812007-06-19 23:01:41 +0000634
dand5f12cd2011-08-18 17:47:57 +0000635db func xCall xCall
636proc xCall {} { return "value" }
637do_execsql_test tcl-14.1 {
638 CREATE TABLE t6(x);
639 INSERT INTO t6 VALUES(1);
640}
641do_test tcl-14.2 {
642 db one {SELECT x FROM t6 WHERE xCall()!='value'}
643} {}
644
drhedc40242016-06-13 12:34:38 +0000645# Verify that the "exists" and "onecolumn" methods work when
646# a "profile" is registered.
647#
648catch {db close}
649sqlite3 db :memory:
650proc noop-profile {args} {
651 return
652}
653do_test tcl-15.0 {
654 db eval {CREATE TABLE t1(a); INSERT INTO t1 VALUES(1),(2),(3);}
655 db onecolumn {SELECT a FROM t1 WHERE a>2}
656} {3}
657do_test tcl-15.1 {
658 db exists {SELECT a FROM t1 WHERE a>2}
659} {1}
660do_test tcl-15.2 {
661 db exists {SELECT a FROM t1 WHERE a>3}
662} {0}
663db profile noop-profile
664do_test tcl-15.3 {
665 db onecolumn {SELECT a FROM t1 WHERE a>2}
666} {3}
667do_test tcl-15.4 {
668 db exists {SELECT a FROM t1 WHERE a>2}
669} {1}
670do_test tcl-15.5 {
671 db exists {SELECT a FROM t1 WHERE a>3}
672} {0}
673
674
drhaf38cdb2017-06-26 21:08:32 +0000675# 2017-06-26: The --withoutnulls flag to "db eval".
676#
677# In the "db eval --withoutnulls SQL ARRAY" form, NULL results cause the
678# corresponding array entry to be unset. The default behavior (without
679# the -withoutnulls flags) is for the corresponding array value to get
680# the [db nullvalue] string.
681#
682catch {db close}
683forcedelete test.db
684sqlite3 db test.db
685do_execsql_test tcl-16.100 {
686 CREATE TABLE t1(a,b);
687 INSERT INTO t1 VALUES(1,2),(2,NULL),(3,'xyz');
688}
689do_test tcl-16.101 {
690 set res {}
691 unset -nocomplain x
692 db eval {SELECT * FROM t1} x {
693 lappend res $x(a) [array names x]
694 }
695 set res
696} {1 {a b *} 2 {a b *} 3 {a b *}}
697do_test tcl-16.102 {
698 set res [catch {
699 db eval -unknown {SELECT * FROM t1} x {
700 lappend res $x(a) [array names x]
701 }
702 } rc]
703 lappend res $rc
704} {1 {unknown option: "-unknown"}}
705do_test tcl-16.103 {
706 set res {}
707 unset -nocomplain x
708 db eval -withoutnulls {SELECT * FROM t1} x {
709 lappend res $x(a) [array names x]
710 }
711 set res
712} {1 {a b *} 2 {a *} 3 {a b *}}
drhedc40242016-06-13 12:34:38 +0000713
714
715
dand5f12cd2011-08-18 17:47:57 +0000716
drh4f5e80f2007-06-19 17:15:46 +0000717
drh960e8c62001-04-03 16:53:21 +0000718finish_test