# 2001 September 15

 #

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

 #

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

 # a legal notice, here is a blessing:

 #

 #    May you do good and not evil.

 #    May you find forgiveness for yourself and forgive others.

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

 #

 #***********************************************************************

 # This file implements regression tests for TCL interface to the

 # SQLite library. 

 #

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

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

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

 #

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

 set testdir [file dirname $argv0]

 source $testdir/tester.tcl

 # Check the error messages generated by tclsqlite

 #

 if {[sqlite3 -has-codec]} {

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

 } else {

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

 }

 do_test tcl-1.1 {

   set v [catch {sqlite3 bogus} msg]

   regsub {really_sqlite3} $msg {sqlite3} msg

   lappend v $msg

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

 do_test tcl-1.2 {

   set v [catch {db bogus} msg]

   lappend v $msg

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

 do_test tcl-1.2.1 {

   set v [catch {db cache bogus} msg]

   lappend v $msg

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

 do_test tcl-1.2.2 {

   set v [catch {db cache} msg]

   lappend v $msg

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

 do_test tcl-1.3 {

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

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

   set v [catch {

     db eval {SELECT * FROM t1} data {

       error "The error message"

     }

   } msg]

   lappend v $msg

 } {1 {The error message}}

 do_test tcl-1.4 {

   set v [catch {

     db eval {SELECT * FROM t2} data {

       error "The error message"

     }

   } msg]

   lappend v $msg

 } {1 {no such table: t2}}

 do_test tcl-1.5 {

   set v [catch {

     db eval {SELECT * FROM t1} data {

       break

     }

   } msg]

   lappend v $msg

 } {0 {}}

 catch {expr x*} msg

 do_test tcl-1.6 {

   set v [catch {

     db eval {SELECT * FROM t1} data {

       expr x*

     }

   } msg]

   lappend v $msg

 } [list 1 $msg]

 do_test tcl-1.7 {

   set v [catch {db} msg]

   lappend v $msg

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

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

   do_test tcl-1.8 {

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

     lappend v $msg

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

 }

 do_test tcl-1.9 {

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

   lappend v $msg

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

 do_test tcl-1.10 {

   set v [catch {db progress 1} msg]

   lappend v $msg

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

 do_test tcl-1.11 {

   set v [catch {db changes xyz} msg]

   lappend v $msg

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

 do_test tcl-1.12 {

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

   lappend v $msg

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

 ifcapable {complete} {

   do_test tcl-1.13 {

     set v [catch {db complete} msg]

     lappend v $msg

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

 }

 do_test tcl-1.14 {

   set v [catch {db eval} msg]

   lappend v $msg

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

 do_test tcl-1.15 {

   set v [catch {db function} msg]

   lappend v $msg

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

 do_test tcl-1.16 {

   set v [catch {db last_insert_rowid xyz} msg]

   lappend v $msg

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

 do_test tcl-1.17 {

   set v [catch {db rekey} msg]

   lappend v $msg

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

 do_test tcl-1.18 {

   set v [catch {db timeout} msg]

   lappend v $msg

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

 do_test tcl-1.19 {

   set v [catch {db collate} msg]

   lappend v $msg

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

 do_test tcl-1.20 {

   set v [catch {db collation_needed} msg]

   lappend v $msg

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

 do_test tcl-1.21 {

   set v [catch {db total_changes xyz} msg]

   lappend v $msg

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

 do_test tcl-1.20 {

   set v [catch {db copy} msg]

   lappend v $msg

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

 do_test tcl-1.21 {

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

   lappend v $msg

 } {1 {no such vfs: nosuchvfs}}

 catch {unset ::result}

 do_test tcl-2.1 {

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

 } {}

 ifcapable schema_pragmas {

   do_test tcl-2.2 {

     execsql "PRAGMA table_info(t\u0123x)"

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

 }

 do_test tcl-2.3 {

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

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

   set result(*)

 } "a b\u1235"

 # Test the onecolumn method

 #

 do_test tcl-3.1 {

   execsql {

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

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

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

   }

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

   lappend rc $msg

 } {0 10}

 do_test tcl-3.2 {

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

 } {}

 do_test tcl-3.3 {

   set rc [catch {db onecolumn} errmsg]

   lappend rc $errmsg

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

 do_test tcl-3.4 {

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

   lappend rc $errmsg

 } {1 {no such column: bogus}}

 ifcapable {tclvar} {

   do_test tcl-3.5 {

     set b 50

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

     lappend rc $msg

   } {0 41}

   do_test tcl-3.6 {

     set b 500

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

     lappend rc $msg

   } {0 {}}

   do_test tcl-3.7 {

     set b 500

     set rc [catch {db one {

       INSERT INTO t1 VALUES(99,510);

       SELECT * FROM t1 WHERE b>$b

     }} msg]

     lappend rc $msg

   } {0 99}

 }

 ifcapable {!tclvar} {

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

 }

 # Turn the busy handler on and off

 #

 do_test tcl-4.1 {

   proc busy_callback {cnt} {

     break

   }

   db busy busy_callback

   db busy

 } {busy_callback}

 do_test tcl-4.2 {

   db busy {}

   db busy

 } {}

 ifcapable {tclvar} {

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

   #

   do_test tcl-5.1 {

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

     catch {unset x}

     set x(1) A

     set x(2) B

     execsql {

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

       SELECT * FROM t3

     }

   } {A B {}}

   do_test tcl-5.2 {

     execsql {

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

     }

   } {text text null}

   do_test tcl-5.3 {

     catch {unset x}

     set x [binary format h12 686900686f00]

     execsql {

       UPDATE t3 SET a=$::x;

     }

     db eval {

       SELECT a FROM t3

     } break

     binary scan $a h12 adata

     set adata

   } {686900686f00}

   do_test tcl-5.4 {

     execsql {

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

     }

   } {blob text null}

 }

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

 #

 do_test tcl-6.1 {

   db eval {SELECT * FROM t1} {

     break

   }

   lappend a $b

 } {10 20}

 do_test tcl-6.2 {

   set cnt 0

   db eval {SELECT * FROM t1} {

     if {$a>40} continue

     incr cnt

   }

   set cnt

 } {4}

 do_test tcl-6.3 {

   set cnt 0

   db eval {SELECT * FROM t1} {

     if {$a<40} continue

     incr cnt

   }

   set cnt

 } {5}

 do_test tcl-6.4 {

   proc return_test {x} {

     db eval {SELECT * FROM t1} {

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

     }

   }

   return_test 10

 } 20

 do_test tcl-6.5 {

   return_test 20

 } 40

 do_test tcl-6.6 {

   return_test 99

 } 510

 do_test tcl-6.7 {

   return_test 0

 } {}

 do_test tcl-7.1 {

   db version

   expr 0

 } {0}

 # modify and reset the NULL representation

 #

 do_test tcl-8.1 {

   db nullvalue NaN

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

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

 } {30 NaN}

 do_test tcl-8.2 {

   db nullvalue NULL

   db nullvalue

 } {NULL}

 do_test tcl-8.3 {

   db nullvalue {}

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

 } {30 {}}

 # Test the return type of user-defined functions

 #

 do_test tcl-9.1 {

   db function ret_str {return "hi"}

   execsql {SELECT typeof(ret_str())}

 } {text}

 do_test tcl-9.2 {

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

   execsql {SELECT typeof(ret_dbl())}

 } {real}

 do_test tcl-9.3 {

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

   execsql {SELECT typeof(ret_int())}

 } {integer}

 # Recursive calls to the same user-defined function

 #

 ifcapable tclvar {

   do_test tcl-9.10 {

     proc userfunc_r1 {n} {

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

       set nm1 [expr {$n-1}]

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

     }

     db function r1 userfunc_r1

     execsql {SELECT r1(10)}

   } {55}

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

     do_test tcl-9.11 {

       execsql {SELECT r1(100)}

     } {5050}

   }  

 }

 # Tests for the new transaction method

 #

 do_test tcl-10.1 {

   db transaction {}

 } {}

 do_test tcl-10.2 {

   db transaction deferred {}

 } {}

 do_test tcl-10.3 {

   db transaction immediate {}

 } {}

 do_test tcl-10.4 {

   db transaction exclusive {}

 } {}

 do_test tcl-10.5 {

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

   lappend rc $msg

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

 do_test tcl-10.6 {

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

   lappend rc $msg

 } {1 test-error}

 do_test tcl-10.7 {

   db transaction {

     db eval {CREATE TABLE t4(x)}

     db transaction {

       db eval {INSERT INTO t4 VALUES(1)}

     }

   }

   db eval {SELECT * FROM t4}

 } 1

 do_test tcl-10.8 {

   catch {

     db transaction {

       db eval {INSERT INTO t4 VALUES(2)}

       db eval {INSERT INTO t4 VALUES(3)}

       db eval {INSERT INTO t4 VALUES(4)}

       error test-error

     }

   }

   db eval {SELECT * FROM t4}

 } 1

 do_test tcl-10.9 {

   db transaction {

     db eval {INSERT INTO t4 VALUES(2)}

     catch {

       db transaction {

         db eval {INSERT INTO t4 VALUES(3)}

         db eval {INSERT INTO t4 VALUES(4)}

         error test-error

       }

     }

   }

   db eval {SELECT * FROM t4}

 } {1 2 3 4}

 do_test tcl-10.10 {

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

     db transaction {

       db eval {INSERT INTO t4 VALUES(5)}

       continue

     }

   }

   db eval {SELECT * FROM t4}

 } {1 2 3 4 5}

 do_test tcl-10.11 {

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

     db transaction {

       db eval {INSERT INTO t4 VALUES(6)}

       break

     }

   }

   db eval {SELECT * FROM t4}

 } {1 2 3 4 5 6}

 do_test tcl-10.12 {

   set rc [catch {

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

       db transaction {

         db eval {INSERT INTO t4 VALUES(7)}

         return

       }

     }

   }]

 } {2}

 do_test tcl-10.13 {

   db eval {SELECT * FROM t4}

 } {1 2 3 4 5 6 7}

 do_test tcl-11.1 {

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

 } {1}

 do_test tcl-11.2 {

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

 } {1}

 do_test tcl-11.3 {

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

 } {0}

 do_test tcl-12.1 {

   unset -nocomplain a b c version

   set version [db version]

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

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

 } [sqlite3_libversion_number]

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

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

 # as BLOBs.

 #

 ifcapable tclvar {

   do_test tcl-13.1 {

     db eval {CREATE TABLE t5(x BLOB)}

     set x abc123

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

     db eval {SELECT typeof(x) FROM t5}

   } {text}

   do_test tcl-13.2 {

     binary scan $x H notUsed

     db eval {

       DELETE FROM t5;

       INSERT INTO t5 VALUES($x);

       SELECT typeof(x) FROM t5;

     }

   } {text}

   do_test tcl-13.3 {

     db eval {

       DELETE FROM t5;

       INSERT INTO t5 VALUES(@x);

       SELECT typeof(x) FROM t5;

     }

   } {blob}

   do_test tcl-13.4 {

     set y 1234

     db eval {

       DELETE FROM t5;

       INSERT INTO t5 VALUES(@y);

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

     }

   } {31323334 blob}

 }

 finish_test