sqlite3/test/tclsqlite.test

   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.40 2005/05/05 10:30:30 drh 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 "sqlite3 HANDLE FILENAME ?MODE?"
  29 }
  30 do_test tcl-1.1 {
  31   set v [catch {sqlite3 bogus} 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, busy, cache, changes, close, collate, collation_needed, commit_hook, complete, copy, errorcode, eval, function, last_insert_rowid, nullvalue, onecolumn, progress, rekey, timeout, total_changes, trace, or version}}
  38 do_test tcl-1.3 {
  39   execsql {CREATE TABLE t1(a int, b int)}
  40   execsql {INSERT INTO t1 VALUES(10,20)}
  41   set v [catch {
  42     db eval {SELECT * FROM t1} data {
  43       error "The error message"
  44     }
  45   } msg]
  46   lappend v $msg
  47 } {1 {The error message}}
  48 do_test tcl-1.4 {
  49   set v [catch {
  50     db eval {SELECT * FROM t2} data {
  51       error "The error message"
  52     }
  53   } msg]
  54   lappend v $msg
  55 } {1 {no such table: t2}}
  56 do_test tcl-1.5 {
  57   set v [catch {
  58     db eval {SELECT * FROM t1} data {
  59       break
  60     }
  61   } msg]
  62   lappend v $msg
  63 } {0 {}}
  64 do_test tcl-1.6 {
  65   set v [catch {
  66     db eval {SELECT * FROM t1} data {
  67       expr x*
  68     }
  69   } msg]
  70   regsub {:.*$} $msg {} msg
  71   lappend v $msg
  72 } {1 {syntax error in expression "x*"}}
  73 do_test tcl-1.7 {
  74   set v [catch {db} msg]
  75   lappend v $msg
  76 } {1 {wrong # args: should be "db SUBCOMMAND ..."}}
  77 if {[catch {db auth {}}]==0} {
  78   do_test tcl-1.8 {
  79     set v [catch {db authorizer 1 2 3} msg]
  80     lappend v $msg
  81   } {1 {wrong # args: should be "db authorizer ?CALLBACK?"}}
  82 }
  83 do_test tcl-1.9 {
  84   set v [catch {db busy 1 2 3} msg]
  85   lappend v $msg
  86 } {1 {wrong # args: should be "db busy CALLBACK"}}
  87 do_test tcl-1.10 {
  88   set v [catch {db progress 1} msg]
  89   lappend v $msg
  90 } {1 {wrong # args: should be "db progress N CALLBACK"}}
  91 do_test tcl-1.11 {
  92   set v [catch {db changes xyz} msg]
  93   lappend v $msg
  94 } {1 {wrong # args: should be "db changes "}}
  95 do_test tcl-1.12 {
  96   set v [catch {db commit_hook a b c} msg]
  97   lappend v $msg
  98 } {1 {wrong # args: should be "db commit_hook ?CALLBACK?"}}
  99 ifcapable {complete} {
 100   do_test tcl-1.13 {
 101     set v [catch {db complete} msg]
 102     lappend v $msg
 103   } {1 {wrong # args: should be "db complete SQL"}}
 104 }
 105 do_test tcl-1.14 {
 106   set v [catch {db eval} msg]
 107   lappend v $msg
 108 } {1 {wrong # args: should be "db eval SQL ?ARRAY-NAME? ?SCRIPT?"}}
 109 do_test tcl-1.15 {
 110   set v [catch {db function} msg]
 111   lappend v $msg
 112 } {1 {wrong # args: should be "db function NAME SCRIPT"}}
 113 do_test tcl-1.14 {
 114   set v [catch {db last_insert_rowid xyz} msg]
 115   lappend v $msg
 116 } {1 {wrong # args: should be "db last_insert_rowid "}}
 117 do_test tcl-1.15 {
 118   set v [catch {db rekey} msg]
 119   lappend v $msg
 120 } {1 {wrong # args: should be "db rekey KEY"}}
 121 do_test tcl-1.16 {
 122   set v [catch {db timeout} msg]
 123   lappend v $msg
 124 } {1 {wrong # args: should be "db timeout MILLISECONDS"}}
 125 do_test tcl-1.17 {
 126   set v [catch {db collate} msg]
 127   lappend v $msg
 128 } {1 {wrong # args: should be "db collate NAME SCRIPT"}}
 129 do_test tcl-1.18 {
 130   set v [catch {db collation_needed} msg]
 131   lappend v $msg
 132 } {1 {wrong # args: should be "db collation_needed SCRIPT"}}
 133 do_test tcl-1.19 {
 134   set v [catch {db total_changes xyz} msg]
 135   lappend v $msg
 136 } {1 {wrong # args: should be "db total_changes "}}
 137 do_test tcl-1.20 {
 138   set v [catch {db copy} msg]
 139   lappend v $msg
 140 } {1 {wrong # args: should be "db copy CONFLICT-ALGORITHM TABLE FILENAME ?SEPARATOR? ?NULLINDICATOR?"}}
 141
 142
 143 if {[sqlite3 -tcl-uses-utf]} {
 144   catch {unset ::result}
 145   do_test tcl-2.1 {
 146     execsql "CREATE TABLE t\u0123x(a int, b\u1235 float)"
 147   } {}
 148   ifcapable schema_pragmas {
 149     do_test tcl-2.2 {
 150       execsql "PRAGMA table_info(t\u0123x)"
 151     } "0 a int 0 {} 0 1 b\u1235 float 0 {} 0"
 152   }
 153   do_test tcl-2.3 {
 154     execsql "INSERT INTO t\u0123x VALUES(1,2.3)"
 155     db eval "SELECT * FROM t\u0123x" result break
 156     set result(*)
 157   } "a b\u1235"
 158 }
 159
 160
 161 # Test the onecolumn method
 162 #
 163 do_test tcl-3.1 {
 164   execsql {
 165     INSERT INTO t1 SELECT a*2, b*2 FROM t1;
 166     INSERT INTO t1 SELECT a*2+1, b*2+1 FROM t1;
 167     INSERT INTO t1 SELECT a*2+3, b*2+3 FROM t1;
 168   }
 169   set rc [catch {db onecolumn {SELECT * FROM t1 ORDER BY a}} msg]
 170   lappend rc $msg
 171 } {0 10}
 172 do_test tcl-3.2 {
 173   db onecolumn {SELECT * FROM t1 WHERE a<0}
 174 } {}
 175 do_test tcl-3.3 {
 176   set rc [catch {db onecolumn} errmsg]
 177   lappend rc $errmsg
 178 } {1 {wrong # args: should be "db onecolumn SQL"}}
 179 do_test tcl-3.4 {
 180   set rc [catch {db onecolumn {SELECT bogus}} errmsg]
 181   lappend rc $errmsg
 182 } {1 {no such column: bogus}}
 183 ifcapable {tclvar} {
 184   do_test tcl-3.5 {
 185     set b 50
 186     set rc [catch {db one {SELECT * FROM t1 WHERE b>$b}} msg]
 187     lappend rc $msg
 188   } {0 41}
 189   do_test tcl-3.6 {
 190     set b 500
 191     set rc [catch {db one {SELECT * FROM t1 WHERE b>$b}} msg]
 192     lappend rc $msg
 193   } {0 {}}
 194   do_test tcl-3.7 {
 195     set b 500
 196     set rc [catch {db one {
 197       INSERT INTO t1 VALUES(99,510);
 198       SELECT * FROM t1 WHERE b>$b
 199     }} msg]
 200     lappend rc $msg
 201   } {0 99}
 202 }
 203 ifcapable {!tclvar} {
 204    execsql {INSERT INTO t1 VALUES(99,510)}
 205 }
 206
 207 # Turn the busy handler on and off
 208 #
 209 do_test tcl-4.1 {
 210   proc busy_callback {cnt} {
 211     break
 212   }
 213   db busy busy_callback
 214   db busy
 215 } {busy_callback}
 216 do_test tcl-4.2 {
 217   db busy {}
 218   db busy
 219 } {}
 220
 221 ifcapable {tclvar} {
 222   # Parsing of TCL variable names within SQL into bound parameters.
 223   #
 224   do_test tcl-5.1 {
 225     execsql {CREATE TABLE t3(a,b,c)}
 226     catch {unset x}
 227     set x(1) 5
 228     set x(2) 7
 229     execsql {
 230       INSERT INTO t3 VALUES($::x(1),$::x(2),$::x(3));
 231       SELECT * FROM t3
 232     }
 233   } {5 7 {}}
 234   do_test tcl-5.2 {
 235     execsql {
 236       SELECT typeof(a), typeof(b), typeof(c) FROM t3
 237     }
 238   } {text text null}
 239   do_test tcl-5.3 {
 240     catch {unset x}
 241     set x [binary format h12 686900686f00]
 242     execsql {
 243       UPDATE t3 SET a=$::x;
 244     }
 245     db eval {
 246       SELECT a FROM t3
 247     } break
 248     binary scan $a h12 adata
 249     set adata
 250   } {686900686f00}
 251   do_test tcl-5.4 {
 252     execsql {
 253       SELECT typeof(a), typeof(b), typeof(c) FROM t3
 254     }
 255   } {blob text null}
 256 }
 257
 258 # Operation of "break" and "continue" within row scripts
 259 #
 260 do_test tcl-6.1 {
 261   db eval {SELECT * FROM t1} {
 262     break
 263   }
 264   lappend a $b
 265 } {10 20}
 266 do_test tcl-6.2 {
 267   set cnt 0
 268   db eval {SELECT * FROM t1} {
 269     if {$a>40} continue
 270     incr cnt
 271   }
 272   set cnt
 273 } {4}
 274 do_test tcl-6.3 {
 275   set cnt 0
 276   db eval {SELECT * FROM t1} {
 277     if {$a<40} continue
 278     incr cnt
 279   }
 280   set cnt
 281 } {5}
 282 do_test tcl-6.4 {
 283   proc return_test {x} {
 284     db eval {SELECT * FROM t1} {
 285       if {$a==$x} {return $b}
 286     }
 287   }
 288   return_test 10
 289 } 20
 290 do_test tcl-6.5 {
 291   return_test 20
 292 } 40
 293 do_test tcl-6.6 {
 294   return_test 99
 295 } 510
 296 do_test tcl-6.7 {
 297   return_test 0
 298 } {}
 299
 300 do_test tcl-7.1 {
 301   db version
 302   expr 0
 303 } {0}
 304
 305 # modify and reset the NULL representation
 306 #
 307 do_test tcl-8.1 {
 308   db nullvalue NaN
 309   execsql {INSERT INTO t1 VALUES(30,NULL)}
 310   db eval {SELECT * FROM t1 WHERE b IS NULL}
 311 } {30 NaN}
 312 do_test tcl-8.2 {
 313   db nullvalue NULL
 314   db nullvalue
 315 } {NULL}
 316 do_test tcl-8.3 {
 317   db nullvalue {}
 318   db eval {SELECT * FROM t1 WHERE b IS NULL}
 319 } {30 {}}
 320
 321 # Test the return type of user-defined functions
 322 #
 323 do_test tcl-9.1 {
 324   db function ret_str {return "hi"}
 325   execsql {SELECT typeof(ret_str())}
 326 } {text}
 327 do_test tcl-9.2 {
 328   db function ret_dbl {return [expr {[clock seconds]*0.5}]}
 329   execsql {SELECT typeof(ret_dbl())}
 330 } {real}
 331 do_test tcl-9.3 {
 332   db function ret_int {clock seconds}
 333   execsql {SELECT typeof(ret_int())}
 334 } {integer}
 335
 336
 337 finish_test