1: # 2001 September 15
2: #
3: # The author disclaims copyright to this source code. In place of
4: # a legal notice, here is a blessing:
5: #
6: # 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.
9: #
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: #
18: # $Id: tclsqlite.test,v 1.1.1.1 2012/02/21 17:04:16 misho Exp $
19:
20: set testdir [file dirname $argv0]
21: source $testdir/tester.tcl
22:
23: # Check the error messages generated by tclsqlite
24: #
25: if {[sqlite3 -has-codec]} {
26: set r "sqlite_orig HANDLE FILENAME ?-key CODEC-KEY?"
27: } else {
28: set r "sqlite_orig HANDLE FILENAME ?-vfs VFSNAME? ?-readonly BOOLEAN? ?-create BOOLEAN? ?-nomutex BOOLEAN? ?-fullmutex BOOLEAN? ?-uri BOOLEAN?"
29: }
30: do_test tcl-1.1 {
31: set v [catch {sqlite3 bogus} msg]
32: regsub {really_sqlite3} $msg {sqlite3} msg
33: lappend v $msg
34: } [list 1 "wrong # args: should be \"$r\""]
35: do_test tcl-1.2 {
36: set v [catch {db bogus} msg]
37: lappend v $msg
38: } {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}}
39: do_test tcl-1.2.1 {
40: set v [catch {db cache bogus} msg]
41: lappend v $msg
42: } {1 {bad option "bogus": must be flush or size}}
43: do_test tcl-1.2.2 {
44: set v [catch {db cache} msg]
45: lappend v $msg
46: } {1 {wrong # args: should be "db cache option ?arg?"}}
47: do_test tcl-1.3 {
48: execsql {CREATE TABLE t1(a int, b int)}
49: execsql {INSERT INTO t1 VALUES(10,20)}
50: set v [catch {
51: db eval {SELECT * FROM t1} data {
52: error "The error message"
53: }
54: } msg]
55: lappend v $msg
56: } {1 {The error message}}
57: do_test tcl-1.4 {
58: set v [catch {
59: db eval {SELECT * FROM t2} data {
60: error "The error message"
61: }
62: } msg]
63: lappend v $msg
64: } {1 {no such table: t2}}
65: do_test tcl-1.5 {
66: set v [catch {
67: db eval {SELECT * FROM t1} data {
68: break
69: }
70: } msg]
71: lappend v $msg
72: } {0 {}}
73: catch {expr x*} msg
74: do_test tcl-1.6 {
75: set v [catch {
76: db eval {SELECT * FROM t1} data {
77: expr x*
78: }
79: } msg]
80: lappend v $msg
81: } [list 1 $msg]
82: do_test tcl-1.7 {
83: set v [catch {db} msg]
84: lappend v $msg
85: } {1 {wrong # args: should be "db SUBCOMMAND ..."}}
86: if {[catch {db auth {}}]==0} {
87: do_test tcl-1.8 {
88: set v [catch {db authorizer 1 2 3} msg]
89: lappend v $msg
90: } {1 {wrong # args: should be "db authorizer ?CALLBACK?"}}
91: }
92: do_test tcl-1.9 {
93: set v [catch {db busy 1 2 3} msg]
94: lappend v $msg
95: } {1 {wrong # args: should be "db busy CALLBACK"}}
96: do_test tcl-1.10 {
97: set v [catch {db progress 1} msg]
98: lappend v $msg
99: } {1 {wrong # args: should be "db progress N CALLBACK"}}
100: do_test tcl-1.11 {
101: set v [catch {db changes xyz} msg]
102: lappend v $msg
103: } {1 {wrong # args: should be "db changes "}}
104: do_test tcl-1.12 {
105: set v [catch {db commit_hook a b c} msg]
106: lappend v $msg
107: } {1 {wrong # args: should be "db commit_hook ?CALLBACK?"}}
108: ifcapable {complete} {
109: do_test tcl-1.13 {
110: set v [catch {db complete} msg]
111: lappend v $msg
112: } {1 {wrong # args: should be "db complete SQL"}}
113: }
114: do_test tcl-1.14 {
115: set v [catch {db eval} msg]
116: lappend v $msg
117: } {1 {wrong # args: should be "db eval SQL ?ARRAY-NAME? ?SCRIPT?"}}
118: do_test tcl-1.15 {
119: set v [catch {db function} msg]
120: lappend v $msg
121: } {1 {wrong # args: should be "db function NAME [-argcount N] SCRIPT"}}
122: do_test tcl-1.16 {
123: set v [catch {db last_insert_rowid xyz} msg]
124: lappend v $msg
125: } {1 {wrong # args: should be "db last_insert_rowid "}}
126: do_test tcl-1.17 {
127: set v [catch {db rekey} msg]
128: lappend v $msg
129: } {1 {wrong # args: should be "db rekey KEY"}}
130: do_test tcl-1.18 {
131: set v [catch {db timeout} msg]
132: lappend v $msg
133: } {1 {wrong # args: should be "db timeout MILLISECONDS"}}
134: do_test tcl-1.19 {
135: set v [catch {db collate} msg]
136: lappend v $msg
137: } {1 {wrong # args: should be "db collate NAME SCRIPT"}}
138: do_test tcl-1.20 {
139: set v [catch {db collation_needed} msg]
140: lappend v $msg
141: } {1 {wrong # args: should be "db collation_needed SCRIPT"}}
142: do_test tcl-1.21 {
143: set v [catch {db total_changes xyz} msg]
144: lappend v $msg
145: } {1 {wrong # args: should be "db total_changes "}}
146: do_test tcl-1.20 {
147: set v [catch {db copy} msg]
148: lappend v $msg
149: } {1 {wrong # args: should be "db copy CONFLICT-ALGORITHM TABLE FILENAME ?SEPARATOR? ?NULLINDICATOR?"}}
150: do_test tcl-1.21 {
151: set v [catch {sqlite3 db2 test.db -vfs nosuchvfs} msg]
152: lappend v $msg
153: } {1 {no such vfs: nosuchvfs}}
154:
155: catch {unset ::result}
156: do_test tcl-2.1 {
157: execsql "CREATE TABLE t\u0123x(a int, b\u1235 float)"
158: } {}
159: ifcapable schema_pragmas {
160: do_test tcl-2.2 {
161: execsql "PRAGMA table_info(t\u0123x)"
162: } "0 a int 0 {} 0 1 b\u1235 float 0 {} 0"
163: }
164: do_test tcl-2.3 {
165: execsql "INSERT INTO t\u0123x VALUES(1,2.3)"
166: db eval "SELECT * FROM t\u0123x" result break
167: set result(*)
168: } "a b\u1235"
169:
170:
171: # Test the onecolumn method
172: #
173: do_test tcl-3.1 {
174: execsql {
175: INSERT INTO t1 SELECT a*2, b*2 FROM t1;
176: INSERT INTO t1 SELECT a*2+1, b*2+1 FROM t1;
177: INSERT INTO t1 SELECT a*2+3, b*2+3 FROM t1;
178: }
179: set rc [catch {db onecolumn {SELECT * FROM t1 ORDER BY a}} msg]
180: lappend rc $msg
181: } {0 10}
182: do_test tcl-3.2 {
183: db onecolumn {SELECT * FROM t1 WHERE a<0}
184: } {}
185: do_test tcl-3.3 {
186: set rc [catch {db onecolumn} errmsg]
187: lappend rc $errmsg
188: } {1 {wrong # args: should be "db onecolumn SQL"}}
189: do_test tcl-3.4 {
190: set rc [catch {db onecolumn {SELECT bogus}} errmsg]
191: lappend rc $errmsg
192: } {1 {no such column: bogus}}
193: ifcapable {tclvar} {
194: do_test tcl-3.5 {
195: set b 50
196: set rc [catch {db one {SELECT * FROM t1 WHERE b>$b}} msg]
197: lappend rc $msg
198: } {0 41}
199: do_test tcl-3.6 {
200: set b 500
201: set rc [catch {db one {SELECT * FROM t1 WHERE b>$b}} msg]
202: lappend rc $msg
203: } {0 {}}
204: do_test tcl-3.7 {
205: set b 500
206: set rc [catch {db one {
207: INSERT INTO t1 VALUES(99,510);
208: SELECT * FROM t1 WHERE b>$b
209: }} msg]
210: lappend rc $msg
211: } {0 99}
212: }
213: ifcapable {!tclvar} {
214: execsql {INSERT INTO t1 VALUES(99,510)}
215: }
216:
217: # Turn the busy handler on and off
218: #
219: do_test tcl-4.1 {
220: proc busy_callback {cnt} {
221: break
222: }
223: db busy busy_callback
224: db busy
225: } {busy_callback}
226: do_test tcl-4.2 {
227: db busy {}
228: db busy
229: } {}
230:
231: ifcapable {tclvar} {
232: # Parsing of TCL variable names within SQL into bound parameters.
233: #
234: do_test tcl-5.1 {
235: execsql {CREATE TABLE t3(a,b,c)}
236: catch {unset x}
237: set x(1) A
238: set x(2) B
239: execsql {
240: INSERT INTO t3 VALUES($::x(1),$::x(2),$::x(3));
241: SELECT * FROM t3
242: }
243: } {A B {}}
244: do_test tcl-5.2 {
245: execsql {
246: SELECT typeof(a), typeof(b), typeof(c) FROM t3
247: }
248: } {text text null}
249: do_test tcl-5.3 {
250: catch {unset x}
251: set x [binary format h12 686900686f00]
252: execsql {
253: UPDATE t3 SET a=$::x;
254: }
255: db eval {
256: SELECT a FROM t3
257: } break
258: binary scan $a h12 adata
259: set adata
260: } {686900686f00}
261: do_test tcl-5.4 {
262: execsql {
263: SELECT typeof(a), typeof(b), typeof(c) FROM t3
264: }
265: } {blob text null}
266: }
267:
268: # Operation of "break" and "continue" within row scripts
269: #
270: do_test tcl-6.1 {
271: db eval {SELECT * FROM t1} {
272: break
273: }
274: lappend a $b
275: } {10 20}
276: do_test tcl-6.2 {
277: set cnt 0
278: db eval {SELECT * FROM t1} {
279: if {$a>40} continue
280: incr cnt
281: }
282: set cnt
283: } {4}
284: do_test tcl-6.3 {
285: set cnt 0
286: db eval {SELECT * FROM t1} {
287: if {$a<40} continue
288: incr cnt
289: }
290: set cnt
291: } {5}
292: do_test tcl-6.4 {
293: proc return_test {x} {
294: db eval {SELECT * FROM t1} {
295: if {$a==$x} {return $b}
296: }
297: }
298: return_test 10
299: } 20
300: do_test tcl-6.5 {
301: return_test 20
302: } 40
303: do_test tcl-6.6 {
304: return_test 99
305: } 510
306: do_test tcl-6.7 {
307: return_test 0
308: } {}
309:
310: do_test tcl-7.1 {
311: db version
312: expr 0
313: } {0}
314:
315: # modify and reset the NULL representation
316: #
317: do_test tcl-8.1 {
318: db nullvalue NaN
319: execsql {INSERT INTO t1 VALUES(30,NULL)}
320: db eval {SELECT * FROM t1 WHERE b IS NULL}
321: } {30 NaN}
322: do_test tcl-8.2 {
323: db nullvalue NULL
324: db nullvalue
325: } {NULL}
326: do_test tcl-8.3 {
327: db nullvalue {}
328: db eval {SELECT * FROM t1 WHERE b IS NULL}
329: } {30 {}}
330:
331: # Test the return type of user-defined functions
332: #
333: do_test tcl-9.1 {
334: db function ret_str {return "hi"}
335: execsql {SELECT typeof(ret_str())}
336: } {text}
337: do_test tcl-9.2 {
338: db function ret_dbl {return [expr {rand()*0.5}]}
339: execsql {SELECT typeof(ret_dbl())}
340: } {real}
341: do_test tcl-9.3 {
342: db function ret_int {return [expr {int(rand()*200)}]}
343: execsql {SELECT typeof(ret_int())}
344: } {integer}
345:
346: # Recursive calls to the same user-defined function
347: #
348: ifcapable tclvar {
349: do_test tcl-9.10 {
350: proc userfunc_r1 {n} {
351: if {$n<=0} {return 0}
352: set nm1 [expr {$n-1}]
353: return [expr {[db eval {SELECT r1($nm1)}]+$n}]
354: }
355: db function r1 userfunc_r1
356: execsql {SELECT r1(10)}
357: } {55}
358: do_test tcl-9.11 {
359: execsql {SELECT r1(100)}
360: } {5050}
361: }
362:
363: # Tests for the new transaction method
364: #
365: do_test tcl-10.1 {
366: db transaction {}
367: } {}
368: do_test tcl-10.2 {
369: db transaction deferred {}
370: } {}
371: do_test tcl-10.3 {
372: db transaction immediate {}
373: } {}
374: do_test tcl-10.4 {
375: db transaction exclusive {}
376: } {}
377: do_test tcl-10.5 {
378: set rc [catch {db transaction xyzzy {}} msg]
379: lappend rc $msg
380: } {1 {bad transaction type "xyzzy": must be deferred, exclusive, or immediate}}
381: do_test tcl-10.6 {
382: set rc [catch {db transaction {error test-error}} msg]
383: lappend rc $msg
384: } {1 test-error}
385: do_test tcl-10.7 {
386: db transaction {
387: db eval {CREATE TABLE t4(x)}
388: db transaction {
389: db eval {INSERT INTO t4 VALUES(1)}
390: }
391: }
392: db eval {SELECT * FROM t4}
393: } 1
394: do_test tcl-10.8 {
395: catch {
396: db transaction {
397: db eval {INSERT INTO t4 VALUES(2)}
398: db eval {INSERT INTO t4 VALUES(3)}
399: db eval {INSERT INTO t4 VALUES(4)}
400: error test-error
401: }
402: }
403: db eval {SELECT * FROM t4}
404: } 1
405: do_test tcl-10.9 {
406: db transaction {
407: db eval {INSERT INTO t4 VALUES(2)}
408: catch {
409: db transaction {
410: db eval {INSERT INTO t4 VALUES(3)}
411: db eval {INSERT INTO t4 VALUES(4)}
412: error test-error
413: }
414: }
415: }
416: db eval {SELECT * FROM t4}
417: } {1 2}
418: do_test tcl-10.10 {
419: for {set i 0} {$i<1} {incr i} {
420: db transaction {
421: db eval {INSERT INTO t4 VALUES(5)}
422: continue
423: }
424: error "This line should not be run"
425: }
426: db eval {SELECT * FROM t4}
427: } {1 2 5}
428: do_test tcl-10.11 {
429: for {set i 0} {$i<10} {incr i} {
430: db transaction {
431: db eval {INSERT INTO t4 VALUES(6)}
432: break
433: }
434: }
435: db eval {SELECT * FROM t4}
436: } {1 2 5 6}
437: do_test tcl-10.12 {
438: set rc [catch {
439: for {set i 0} {$i<10} {incr i} {
440: db transaction {
441: db eval {INSERT INTO t4 VALUES(7)}
442: return
443: }
444: }
445: }]
446: } {2}
447: do_test tcl-10.13 {
448: db eval {SELECT * FROM t4}
449: } {1 2 5 6 7}
450:
451: # Now test that [db transaction] commands may be nested with
452: # the expected results.
453: #
454: do_test tcl-10.14 {
455: db transaction {
456: db eval {
457: DELETE FROM t4;
458: INSERT INTO t4 VALUES('one');
459: }
460:
461: catch {
462: db transaction {
463: db eval { INSERT INTO t4 VALUES('two') }
464: db transaction {
465: db eval { INSERT INTO t4 VALUES('three') }
466: error "throw an error!"
467: }
468: }
469: }
470: }
471:
472: db eval {SELECT * FROM t4}
473: } {one}
474: do_test tcl-10.15 {
475: # Make sure a transaction has not been left open.
476: db eval {BEGIN ; COMMIT}
477: } {}
478: do_test tcl-10.16 {
479: db transaction {
480: db eval { INSERT INTO t4 VALUES('two'); }
481: db transaction {
482: db eval { INSERT INTO t4 VALUES('three') }
483: db transaction {
484: db eval { INSERT INTO t4 VALUES('four') }
485: }
486: }
487: }
488: db eval {SELECT * FROM t4}
489: } {one two three four}
490: do_test tcl-10.17 {
491: catch {
492: db transaction {
493: db eval { INSERT INTO t4 VALUES('A'); }
494: db transaction {
495: db eval { INSERT INTO t4 VALUES('B') }
496: db transaction {
497: db eval { INSERT INTO t4 VALUES('C') }
498: error "throw an error!"
499: }
500: }
501: }
502: }
503: db eval {SELECT * FROM t4}
504: } {one two three four}
505: do_test tcl-10.18 {
506: # Make sure a transaction has not been left open.
507: db eval {BEGIN ; COMMIT}
508: } {}
509:
510: # Mess up a [db transaction] command by locking the database using a
511: # second connection when it tries to commit. Make sure the transaction
512: # is not still open after the "database is locked" exception is thrown.
513: #
514: do_test tcl-10.18 {
515: sqlite3 db2 test.db
516: db2 eval {
517: BEGIN;
518: SELECT * FROM sqlite_master;
519: }
520:
521: set rc [catch {
522: db transaction {
523: db eval {INSERT INTO t4 VALUES('five')}
524: }
525: } msg]
526: list $rc $msg
527: } {1 {database is locked}}
528: do_test tcl-10.19 {
529: db eval {BEGIN ; COMMIT}
530: } {}
531:
532: # Thwart a [db transaction] command by locking the database using a
533: # second connection with "BEGIN EXCLUSIVE". Make sure no transaction is
534: # open after the "database is locked" exception is thrown.
535: #
536: do_test tcl-10.20 {
537: db2 eval {
538: COMMIT;
539: BEGIN EXCLUSIVE;
540: }
541: set rc [catch {
542: db transaction {
543: db eval {INSERT INTO t4 VALUES('five')}
544: }
545: } msg]
546: list $rc $msg
547: } {1 {database is locked}}
548: do_test tcl-10.21 {
549: db2 close
550: db eval {BEGIN ; COMMIT}
551: } {}
552: do_test tcl-10.22 {
553: sqlite3 db2 test.db
554: db transaction exclusive {
555: catch { db2 eval {SELECT * FROM sqlite_master} } msg
556: set msg "db2: $msg"
557: }
558: set msg
559: } {db2: database is locked}
560: db2 close
561:
562: do_test tcl-11.1 {
563: db eval {INSERT INTO t4 VALUES(6)}
564: db exists {SELECT x,x*2,x+x FROM t4 WHERE x==6}
565: } {1}
566: do_test tcl-11.2 {
567: db exists {SELECT 0 FROM t4 WHERE x==6}
568: } {1}
569: do_test tcl-11.3 {
570: db exists {SELECT 1 FROM t4 WHERE x==8}
571: } {0}
572: do_test tcl-11.3.1 {
573: tcl_objproc db exists {SELECT 1 FROM t4 WHERE x==8}
574: } {0}
575:
576: do_test tcl-12.1 {
577: unset -nocomplain a b c version
578: set version [db version]
579: scan $version "%d.%d.%d" a b c
580: expr $a*1000000 + $b*1000 + $c
581: } [sqlite3_libversion_number]
582:
583:
584: # Check to see that when bindings of the form @aaa are used instead
585: # of $aaa, that objects are treated as bytearray and are inserted
586: # as BLOBs.
587: #
588: ifcapable tclvar {
589: do_test tcl-13.1 {
590: db eval {CREATE TABLE t5(x BLOB)}
591: set x abc123
592: db eval {INSERT INTO t5 VALUES($x)}
593: db eval {SELECT typeof(x) FROM t5}
594: } {text}
595: do_test tcl-13.2 {
596: binary scan $x H notUsed
597: db eval {
598: DELETE FROM t5;
599: INSERT INTO t5 VALUES($x);
600: SELECT typeof(x) FROM t5;
601: }
602: } {text}
603: do_test tcl-13.3 {
604: db eval {
605: DELETE FROM t5;
606: INSERT INTO t5 VALUES(@x);
607: SELECT typeof(x) FROM t5;
608: }
609: } {blob}
610: do_test tcl-13.4 {
611: set y 1234
612: db eval {
613: DELETE FROM t5;
614: INSERT INTO t5 VALUES(@y);
615: SELECT hex(x), typeof(x) FROM t5
616: }
617: } {31323334 blob}
618: }
619:
620: db func xCall xCall
621: proc xCall {} { return "value" }
622: do_execsql_test tcl-14.1 {
623: CREATE TABLE t6(x);
624: INSERT INTO t6 VALUES(1);
625: }
626: do_test tcl-14.2 {
627: db one {SELECT x FROM t6 WHERE xCall()!='value'}
628: } {}
629:
630:
631:
632: finish_test
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to tclsqlite.test CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [ELWIX - Embedded LightWeight unIX -] / embedaddon / sqlite3 / test