1 # 2001 September 15

     2 #

     3 # Portions Copyright (c) 2007-2008 Nokia Corporation and/or its subsidiaries. All rights reserved.

     4 #

     5 # The author disclaims copyright to this source code.  In place of

     6 # a legal notice, here is a blessing:

     7 #

     8 #    May you do good and not evil.

     9 #    May you find forgiveness for yourself and forgive others.

    10 #    May you share freely, never taking more than you give.

    11 #

    12 #***********************************************************************

    13 # This file implements regression tests for TCL interface to the

    14 # SQLite library. 

    15 #

    16 # Actually, all tests are based on the TCL interface, so the main

    17 # interface is pretty well tested.  This file contains some addition

    18 # tests for fringe issues that the main test suite does not cover.

    19 #

    20 # $Id: tclsqlite.test,v 1.69 2008/09/09 12:31:34 drh Exp $

    21 

    22 set testdir [file dirname $argv0]

    23 source $testdir/tester.tcl

    24 

    25 # Check the error messages generated by tclsqlite

    26 #

    27 if {[sqlite3 -has-codec]} {

    28   set r "sqlite_orig HANDLE FILENAME ?-key CODEC-KEY?"

    29 } else {

    30   set r "sqlite3 HANDLE FILENAME ?-vfs VFSNAME? ?-readonly BOOLEAN? ?-create BOOLEAN? ?-nomutex BOOLEAN? ?-fullmutex BOOLEAN?"

    31 }

    32 do_test tcl-1.1 {

    33   set v [catch {sqlite3 bogus} msg]

    34   regsub {really_sqlite3} $msg {sqlite3} msg

    35   lappend v $msg

    36 } [list 1 "wrong # args: should be \"$r\""]

    37 do_test tcl-1.2 {

    38   set v [catch {db bogus} msg]

    39   lappend v $msg

    40 } {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}}

    41 do_test tcl-1.2.1 {

    42   set v [catch {db cache bogus} msg]

    43   lappend v $msg

    44 } {1 {bad option "bogus": must be flush or size}}

    45 do_test tcl-1.2.2 {

    46   set v [catch {db cache} msg]

    47   lappend v $msg

    48 } {1 {wrong # args: should be "db cache option ?arg?"}}

    49 do_test tcl-1.3 {

    50   execsql {CREATE TABLE t1(a int, b int)}

    51   execsql {INSERT INTO t1 VALUES(10,20)}

    52   set v [catch {

    53     db eval {SELECT * FROM t1} data {

    54       error "The error message"

    55     }

    56   } msg]

    57   lappend v $msg

    58 } {1 {The error message}}

    59 do_test tcl-1.4 {

    60   set v [catch {

    61     db eval {SELECT * FROM t2} data {

    62       error "The error message"

    63     }

    64   } msg]

    65   lappend v $msg

    66 } {1 {no such table: t2}}

    67 do_test tcl-1.5 {

    68   set v [catch {

    69     db eval {SELECT * FROM t1} data {

    70       break

    71     }

    72   } msg]

    73   lappend v $msg

    74 } {0 {}}

    75 catch {expr x*} msg

    76 do_test tcl-1.6 {

    77   set v [catch {

    78     db eval {SELECT * FROM t1} data {

    79       expr x*

    80     }

    81   } msg]

    82   lappend v $msg

    83 } [list 1 $msg]

    84 do_test tcl-1.7 {

    85   set v [catch {db} msg]

    86   lappend v $msg

    87 } {1 {wrong # args: should be "db SUBCOMMAND ..."}}

    88 if {[catch {db auth {}}]==0} {

    89   do_test tcl-1.8 {

    90     set v [catch {db authorizer 1 2 3} msg]

    91     lappend v $msg

    92   } {1 {wrong # args: should be "db authorizer ?CALLBACK?"}}

    93 }

    94 do_test tcl-1.9 {

    95   set v [catch {db busy 1 2 3} msg]

    96   lappend v $msg

    97 } {1 {wrong # args: should be "db busy CALLBACK"}}

    98 do_test tcl-1.10 {

    99   set v [catch {db progress 1} msg]

   100   lappend v $msg

   101 } {1 {wrong # args: should be "db progress N CALLBACK"}}

   102 do_test tcl-1.11 {

   103   set v [catch {db changes xyz} msg]

   104   lappend v $msg

   105 } {1 {wrong # args: should be "db changes "}}

   106 do_test tcl-1.12 {

   107   set v [catch {db commit_hook a b c} msg]

   108   lappend v $msg

   109 } {1 {wrong # args: should be "db commit_hook ?CALLBACK?"}}

   110 ifcapable {complete} {

   111   do_test tcl-1.13 {

   112     set v [catch {db complete} msg]

   113     lappend v $msg

   114   } {1 {wrong # args: should be "db complete SQL"}}

   115 }

   116 do_test tcl-1.14 {

   117   set v [catch {db eval} msg]

   118   lappend v $msg

   119 } {1 {wrong # args: should be "db eval SQL ?ARRAY-NAME? ?SCRIPT?"}}

   120 do_test tcl-1.15 {

   121   set v [catch {db function} msg]

   122   lappend v $msg

   123 } {1 {wrong # args: should be "db function NAME [-argcount N] SCRIPT"}}

   124 do_test tcl-1.16 {

   125   set v [catch {db last_insert_rowid xyz} msg]

   126   lappend v $msg

   127 } {1 {wrong # args: should be "db last_insert_rowid "}}

   128 do_test tcl-1.17 {

   129   set v [catch {db rekey} msg]

   130   lappend v $msg

   131 } {1 {wrong # args: should be "db rekey KEY"}}

   132 do_test tcl-1.18 {

   133   set v [catch {db timeout} msg]

   134   lappend v $msg

   135 } {1 {wrong # args: should be "db timeout MILLISECONDS"}}

   136 do_test tcl-1.19 {

   137   set v [catch {db collate} msg]

   138   lappend v $msg

   139 } {1 {wrong # args: should be "db collate NAME SCRIPT"}}

   140 do_test tcl-1.20 {

   141   set v [catch {db collation_needed} msg]

   142   lappend v $msg

   143 } {1 {wrong # args: should be "db collation_needed SCRIPT"}}

   144 do_test tcl-1.21 {

   145   set v [catch {db total_changes xyz} msg]

   146   lappend v $msg

   147 } {1 {wrong # args: should be "db total_changes "}}

   148 do_test tcl-1.20 {

   149   set v [catch {db copy} msg]

   150   lappend v $msg

   151 } {1 {wrong # args: should be "db copy CONFLICT-ALGORITHM TABLE FILENAME ?SEPARATOR? ?NULLINDICATOR?"}}

   152 do_test tcl-1.21 {

   153   set v [catch {sqlite3 db2 test.db -vfs nosuchvfs} msg]

   154   lappend v $msg

   155 } {1 {no such vfs: nosuchvfs}}

   156 

   157 catch {unset ::result}

   158 do_test tcl-2.1 {

   159   execsql "CREATE TABLE t\u0123x(a int, b\u1235 float)"

   160 } {}

   161 ifcapable schema_pragmas {

   162   do_test tcl-2.2 {

   163     execsql "PRAGMA table_info(t\u0123x)"

   164   } "0 a int 0 {} 0 1 b\u1235 float 0 {} 0"

   165 }

   166 do_test tcl-2.3 {

   167   execsql "INSERT INTO t\u0123x VALUES(1,2.3)"

   168   db eval "SELECT * FROM t\u0123x" result break

   169   set result(*)

   170 } "a b\u1235"

   171 

   172 

   173 # Test the onecolumn method

   174 #

   175 do_test tcl-3.1 {

   176   execsql {

   177     INSERT INTO t1 SELECT a*2, b*2 FROM t1;

   178     INSERT INTO t1 SELECT a*2+1, b*2+1 FROM t1;

   179     INSERT INTO t1 SELECT a*2+3, b*2+3 FROM t1;

   180   }

   181   set rc [catch {db onecolumn {SELECT * FROM t1 ORDER BY a}} msg]

   182   lappend rc $msg

   183 } {0 10}

   184 do_test tcl-3.2 {

   185   db onecolumn {SELECT * FROM t1 WHERE a<0}

   186 } {}

   187 do_test tcl-3.3 {

   188   set rc [catch {db onecolumn} errmsg]

   189   lappend rc $errmsg

   190 } {1 {wrong # args: should be "db onecolumn SQL"}}

   191 do_test tcl-3.4 {

   192   set rc [catch {db onecolumn {SELECT bogus}} errmsg]

   193   lappend rc $errmsg

   194 } {1 {no such column: bogus}}

   195 ifcapable {tclvar} {

   196   do_test tcl-3.5 {

   197     set b 50

   198     set rc [catch {db one {SELECT * FROM t1 WHERE b>$b}} msg]

   199     lappend rc $msg

   200   } {0 41}

   201   do_test tcl-3.6 {

   202     set b 500

   203     set rc [catch {db one {SELECT * FROM t1 WHERE b>$b}} msg]

   204     lappend rc $msg

   205   } {0 {}}

   206   do_test tcl-3.7 {

   207     set b 500

   208     set rc [catch {db one {

   209       INSERT INTO t1 VALUES(99,510);

   210       SELECT * FROM t1 WHERE b>$b

   211     }} msg]

   212     lappend rc $msg

   213   } {0 99}

   214 }

   215 ifcapable {!tclvar} {

   216    execsql {INSERT INTO t1 VALUES(99,510)}

   217 }

   218 

   219 # Turn the busy handler on and off

   220 #

   221 do_test tcl-4.1 {

   222   proc busy_callback {cnt} {

   223     break

   224   }

   225   db busy busy_callback

   226   db busy

   227 } {busy_callback}

   228 do_test tcl-4.2 {

   229   db busy {}

   230   db busy

   231 } {}

   232 

   233 ifcapable {tclvar} {

   234   # Parsing of TCL variable names within SQL into bound parameters.

   235   #

   236   do_test tcl-5.1 {

   237     execsql {CREATE TABLE t3(a,b,c)}

   238     catch {unset x}

   239     set x(1) A

   240     set x(2) B

   241     execsql {

   242       INSERT INTO t3 VALUES($::x(1),$::x(2),$::x(3));

   243       SELECT * FROM t3

   244     }

   245   } {A B {}}

   246   do_test tcl-5.2 {

   247     execsql {

   248       SELECT typeof(a), typeof(b), typeof(c) FROM t3

   249     }

   250   } {text text null}

   251   do_test tcl-5.3 {

   252     catch {unset x}

   253     set x [binary format h12 686900686f00]

   254     execsql {

   255       UPDATE t3 SET a=$::x;

   256     }

   257     db eval {

   258       SELECT a FROM t3

   259     } break

   260     binary scan $a h12 adata

   261     set adata

   262   } {686900686f00}

   263   do_test tcl-5.4 {

   264     execsql {

   265       SELECT typeof(a), typeof(b), typeof(c) FROM t3

   266     }

   267   } {blob text null}

   268 }

   269 

   270 # Operation of "break" and "continue" within row scripts

   271 #

   272 do_test tcl-6.1 {

   273   db eval {SELECT * FROM t1} {

   274     break

   275   }

   276   lappend a $b

   277 } {10 20}

   278 do_test tcl-6.2 {

   279   set cnt 0

   280   db eval {SELECT * FROM t1} {

   281     if {$a>40} continue

   282     incr cnt

   283   }

   284   set cnt

   285 } {4}

   286 do_test tcl-6.3 {

   287   set cnt 0

   288   db eval {SELECT * FROM t1} {

   289     if {$a<40} continue

   290     incr cnt

   291   }

   292   set cnt

   293 } {5}

   294 do_test tcl-6.4 {

   295   proc return_test {x} {

   296     db eval {SELECT * FROM t1} {

   297       if {$a==$x} {return $b}

   298     }

   299   }

   300   return_test 10

   301 } 20

   302 do_test tcl-6.5 {

   303   return_test 20

   304 } 40

   305 do_test tcl-6.6 {

   306   return_test 99

   307 } 510

   308 do_test tcl-6.7 {

   309   return_test 0

   310 } {}

   311 

   312 do_test tcl-7.1 {

   313   db version

   314   expr 0

   315 } {0}

   316 

   317 # modify and reset the NULL representation

   318 #

   319 do_test tcl-8.1 {

   320   db nullvalue NaN

   321   execsql {INSERT INTO t1 VALUES(30,NULL)}

   322   db eval {SELECT * FROM t1 WHERE b IS NULL}

   323 } {30 NaN}

   324 do_test tcl-8.2 {

   325   db nullvalue NULL

   326   db nullvalue

   327 } {NULL}

   328 do_test tcl-8.3 {

   329   db nullvalue {}

   330   db eval {SELECT * FROM t1 WHERE b IS NULL}

   331 } {30 {}}

   332 

   333 # Test the return type of user-defined functions

   334 #

   335 do_test tcl-9.1 {

   336   db function ret_str {return "hi"}

   337   execsql {SELECT typeof(ret_str())}

   338 } {text}

   339 do_test tcl-9.2 {

   340   db function ret_dbl {return [expr {rand()*0.5}]}

   341   execsql {SELECT typeof(ret_dbl())}

   342 } {real}

   343 do_test tcl-9.3 {

   344   db function ret_int {return [expr {int(rand()*200)}]}

   345   execsql {SELECT typeof(ret_int())}

   346 } {integer}

   347 

   348 # Recursive calls to the same user-defined function

   349 #

   350 ifcapable tclvar {

   351   do_test tcl-9.10 {

   352     proc userfunc_r1 {n} {

   353       if {$n<=0} {return 0}

   354       set nm1 [expr {$n-1}]

   355       return [expr {[db eval {SELECT r1($nm1)}]+$n}]

   356     }

   357     db function r1 userfunc_r1

   358     execsql {SELECT r1(10)}

   359   } {55}

   360   if {$::tcl_platform(platform)!="symbian"} {

   361     do_test tcl-9.11 {

   362       execsql {SELECT r1(100)}

   363     } {5050}

   364   }  

   365 }

   366 

   367 # Tests for the new transaction method

   368 #

   369 do_test tcl-10.1 {

   370   db transaction {}

   371 } {}

   372 do_test tcl-10.2 {

   373   db transaction deferred {}

   374 } {}

   375 do_test tcl-10.3 {

   376   db transaction immediate {}

   377 } {}

   378 do_test tcl-10.4 {

   379   db transaction exclusive {}

   380 } {}

   381 do_test tcl-10.5 {

   382   set rc [catch {db transaction xyzzy {}} msg]

   383   lappend rc $msg

   384 } {1 {bad transaction type "xyzzy": must be deferred, exclusive, or immediate}}

   385 do_test tcl-10.6 {

   386   set rc [catch {db transaction {error test-error}} msg]

   387   lappend rc $msg

   388 } {1 test-error}

   389 do_test tcl-10.7 {

   390   db transaction {

   391     db eval {CREATE TABLE t4(x)}

   392     db transaction {

   393       db eval {INSERT INTO t4 VALUES(1)}

   394     }

   395   }

   396   db eval {SELECT * FROM t4}

   397 } 1

   398 do_test tcl-10.8 {

   399   catch {

   400     db transaction {

   401       db eval {INSERT INTO t4 VALUES(2)}

   402       db eval {INSERT INTO t4 VALUES(3)}

   403       db eval {INSERT INTO t4 VALUES(4)}

   404       error test-error

   405     }

   406   }

   407   db eval {SELECT * FROM t4}

   408 } 1

   409 do_test tcl-10.9 {

   410   db transaction {

   411     db eval {INSERT INTO t4 VALUES(2)}

   412     catch {

   413       db transaction {

   414         db eval {INSERT INTO t4 VALUES(3)}

   415         db eval {INSERT INTO t4 VALUES(4)}

   416         error test-error

   417       }

   418     }

   419   }

   420   db eval {SELECT * FROM t4}

   421 } {1 2 3 4}

   422 do_test tcl-10.10 {

   423   for {set i 0} {$i<1} {incr i} {

   424     db transaction {

   425       db eval {INSERT INTO t4 VALUES(5)}

   426       continue

   427     }

   428   }

   429   db eval {SELECT * FROM t4}

   430 } {1 2 3 4 5}

   431 do_test tcl-10.11 {

   432   for {set i 0} {$i<10} {incr i} {

   433     db transaction {

   434       db eval {INSERT INTO t4 VALUES(6)}

   435       break

   436     }

   437   }

   438   db eval {SELECT * FROM t4}

   439 } {1 2 3 4 5 6}

   440 do_test tcl-10.12 {

   441   set rc [catch {

   442     for {set i 0} {$i<10} {incr i} {

   443       db transaction {

   444         db eval {INSERT INTO t4 VALUES(7)}

   445         return

   446       }

   447     }

   448   }]

   449 } {2}

   450 do_test tcl-10.13 {

   451   db eval {SELECT * FROM t4}

   452 } {1 2 3 4 5 6 7}

   453 

   454 do_test tcl-11.1 {

   455   db exists {SELECT x,x*2,x+x FROM t4 WHERE x==4}

   456 } {1}

   457 do_test tcl-11.2 {

   458   db exists {SELECT 0 FROM t4 WHERE x==4}

   459 } {1}

   460 do_test tcl-11.3 {

   461   db exists {SELECT 1 FROM t4 WHERE x==8}

   462 } {0}

   463 

   464 do_test tcl-12.1 {

   465   unset -nocomplain a b c version

   466   set version [db version]

   467   scan $version "%d.%d.%d" a b c

   468   expr $a*1000000 + $b*1000 + $c

   469 } [sqlite3_libversion_number]

   470 

   471 

   472 # Check to see that when bindings of the form @aaa are used instead

   473 # of $aaa, that objects are treated as bytearray and are inserted

   474 # as BLOBs.

   475 #

   476 ifcapable tclvar {

   477   do_test tcl-13.1 {

   478     db eval {CREATE TABLE t5(x BLOB)}

   479     set x abc123

   480     db eval {INSERT INTO t5 VALUES($x)}

   481     db eval {SELECT typeof(x) FROM t5}

   482   } {text}

   483   do_test tcl-13.2 {

   484     binary scan $x H notUsed

   485     db eval {

   486       DELETE FROM t5;

   487       INSERT INTO t5 VALUES($x);

   488       SELECT typeof(x) FROM t5;

   489     }

   490   } {text}

   491   do_test tcl-13.3 {

   492     db eval {

   493       DELETE FROM t5;

   494       INSERT INTO t5 VALUES(@x);

   495       SELECT typeof(x) FROM t5;

   496     }

   497   } {blob}

   498   do_test tcl-13.4 {

   499     set y 1234

   500     db eval {

   501       DELETE FROM t5;

   502       INSERT INTO t5 VALUES(@y);

   503       SELECT hex(x), typeof(x) FROM t5

   504     }

   505   } {31323334 blob}

   506 }

   507 

   508 

   509 finish_test