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