third_party/sqlite/src/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.73 2009/03/16 13:19:36 danielk1977 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.22 {
 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.23 {
 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 proc concatFunc args {return [join $args {}]}
 323 do_test tcl-8.2 {
 324   db function concat concatFunc
 325   db eval {SELECT concat('a', b, 'z') FROM t1 WHERE b is NULL}
 326 } {aNaNz}
 327 do_test tcl-8.3 {
 328   db nullvalue NULL
 329   db nullvalue
 330 } {NULL}
 331 do_test tcl-8.4 {
 332   db nullvalue {}
 333   db eval {SELECT * FROM t1 WHERE b IS NULL}
 334 } {30 {}}
 335 do_test tcl-8.5 {
 336   db function concat concatFunc
 337   db eval {SELECT concat('a', b, 'z') FROM t1 WHERE b is NULL}
 338 } {az}
 339
 340 # Test the return type of user-defined functions
 341 #
 342 do_test tcl-9.1 {
 343   db function ret_str {return "hi"}
 344   execsql {SELECT typeof(ret_str())}
 345 } {text}
 346 do_test tcl-9.2 {
 347   db function ret_dbl {return [expr {rand()*0.5}]}
 348   execsql {SELECT typeof(ret_dbl())}
 349 } {real}
 350 do_test tcl-9.3 {
 351   db function ret_int {return [expr {int(rand()*200)}]}
 352   execsql {SELECT typeof(ret_int())}
 353 } {integer}
 354
 355 # Recursive calls to the same user-defined function
 356 #
 357 ifcapable tclvar {
 358   do_test tcl-9.10 {
 359     proc userfunc_r1 {n} {
 360       if {$n<=0} {return 0}
 361       set nm1 [expr {$n-1}]
 362       return [expr {[db eval {SELECT r1($nm1)}]+$n}]
 363     }
 364     db function r1 userfunc_r1
 365     execsql {SELECT r1(10)}
 366   } {55}
 367   do_test tcl-9.11 {
 368     execsql {SELECT r1(100)}
 369   } {5050}
 370 }
 371
 372 # Tests for the new transaction method
 373 #
 374 do_test tcl-10.1 {
 375   db transaction {}
 376 } {}
 377 do_test tcl-10.2 {
 378   db transaction deferred {}
 379 } {}
 380 do_test tcl-10.3 {
 381   db transaction immediate {}
 382 } {}
 383 do_test tcl-10.4 {
 384   db transaction exclusive {}
 385 } {}
 386 do_test tcl-10.5 {
 387   set rc [catch {db transaction xyzzy {}} msg]
 388   lappend rc $msg
 389 } {1 {bad transaction type "xyzzy": must be deferred, exclusive, or immediate}}
 390 do_test tcl-10.6 {
 391   set rc [catch {db transaction {error test-error}} msg]
 392   lappend rc $msg
 393 } {1 test-error}
 394 do_test tcl-10.7 {
 395   db transaction {
 396     db eval {CREATE TABLE t4(x)}
 397     db transaction {
 398       db eval {INSERT INTO t4 VALUES(1)}
 399     }
 400   }
 401   db eval {SELECT * FROM t4}
 402 } 1
 403 do_test tcl-10.8 {
 404   catch {
 405     db transaction {
 406       db eval {INSERT INTO t4 VALUES(2)}
 407       db eval {INSERT INTO t4 VALUES(3)}
 408       db eval {INSERT INTO t4 VALUES(4)}
 409       error test-error
 410     }
 411   }
 412   db eval {SELECT * FROM t4}
 413 } 1
 414 do_test tcl-10.9 {
 415   db transaction {
 416     db eval {INSERT INTO t4 VALUES(2)}
 417     catch {
 418       db transaction {
 419         db eval {INSERT INTO t4 VALUES(3)}
 420         db eval {INSERT INTO t4 VALUES(4)}
 421         error test-error
 422       }
 423     }
 424   }
 425   db eval {SELECT * FROM t4}
 426 } {1 2}
 427 do_test tcl-10.10 {
 428   for {set i 0} {$i<1} {incr i} {
 429     db transaction {
 430       db eval {INSERT INTO t4 VALUES(5)}
 431       continue
 432     }
 433     error "This line should not be run"
 434   }
 435   db eval {SELECT * FROM t4}
 436 } {1 2 5}
 437 do_test tcl-10.11 {
 438   for {set i 0} {$i<10} {incr i} {
 439     db transaction {
 440       db eval {INSERT INTO t4 VALUES(6)}
 441       break
 442     }
 443   }
 444   db eval {SELECT * FROM t4}
 445 } {1 2 5 6}
 446 do_test tcl-10.12 {
 447   set rc [catch {
 448     for {set i 0} {$i<10} {incr i} {
 449       db transaction {
 450         db eval {INSERT INTO t4 VALUES(7)}
 451         return
 452       }
 453     }
 454   }]
 455 } {2}
 456 do_test tcl-10.13 {
 457   db eval {SELECT * FROM t4}
 458 } {1 2 5 6 7}
 459
 460 # Now test that [db transaction] commands may be nested with
 461 # the expected results.
 462 #
 463 do_test tcl-10.14 {
 464   db transaction {
 465     db eval {
 466       DELETE FROM t4;
 467       INSERT INTO t4 VALUES('one');
 468     }
 469
 470     catch {
 471       db transaction {
 472         db eval { INSERT INTO t4 VALUES('two') }
 473         db transaction {
 474           db eval { INSERT INTO t4 VALUES('three') }
 475           error "throw an error!"
 476         }
 477       }
 478     }
 479   }
 480
 481   db eval {SELECT * FROM t4}
 482 } {one}
 483 do_test tcl-10.15 {
 484   # Make sure a transaction has not been left open.
 485   db eval {BEGIN ; COMMIT}
 486 } {}
 487 do_test tcl-10.16 {
 488   db transaction {
 489     db eval { INSERT INTO t4 VALUES('two'); }
 490     db transaction {
 491       db eval { INSERT INTO t4 VALUES('three') }
 492       db transaction {
 493         db eval { INSERT INTO t4 VALUES('four') }
 494       }
 495     }
 496   }
 497   db eval {SELECT * FROM t4}
 498 } {one two three four}
 499 do_test tcl-10.17 {
 500   catch {
 501     db transaction {
 502       db eval { INSERT INTO t4 VALUES('A'); }
 503       db transaction {
 504         db eval { INSERT INTO t4 VALUES('B') }
 505         db transaction {
 506           db eval { INSERT INTO t4 VALUES('C') }
 507           error "throw an error!"
 508         }
 509       }
 510     }
 511   }
 512   db eval {SELECT * FROM t4}
 513 } {one two three four}
 514 do_test tcl-10.18 {
 515   # Make sure a transaction has not been left open.
 516   db eval {BEGIN ; COMMIT}
 517 } {}
 518
 519 # Mess up a [db transaction] command by locking the database using a
 520 # second connection when it tries to commit. Make sure the transaction
 521 # is not still open after the "database is locked" exception is thrown.
 522 #
 523 do_test tcl-10.18 {
 524   sqlite3 db2 test.db
 525   db2 eval {
 526     BEGIN;
 527     SELECT * FROM sqlite_master;
 528   }
 529
 530   set rc [catch {
 531     db transaction {
 532       db eval {INSERT INTO t4 VALUES('five')}
 533     }
 534   } msg]
 535   list $rc $msg
 536 } {1 {database is locked}}
 537 do_test tcl-10.19 {
 538   db eval {BEGIN ; COMMIT}
 539 } {}
 540
 541 # Thwart a [db transaction] command by locking the database using a
 542 # second connection with "BEGIN EXCLUSIVE". Make sure no transaction is
 543 # open after the "database is locked" exception is thrown.
 544 #
 545 do_test tcl-10.20 {
 546   db2 eval {
 547     COMMIT;
 548     BEGIN EXCLUSIVE;
 549   }
 550   set rc [catch {
 551     db transaction {
 552       db eval {INSERT INTO t4 VALUES('five')}
 553     }
 554   } msg]
 555   list $rc $msg
 556 } {1 {database is locked}}
 557 do_test tcl-10.21 {
 558   db2 close
 559   db eval {BEGIN ; COMMIT}
 560 } {}
 561 do_test tcl-10.22 {
 562   sqlite3 db2 test.db
 563   db transaction exclusive {
 564     catch { db2 eval {SELECT * FROM sqlite_master} } msg
 565     set msg "db2: $msg"
 566   }
 567   set msg
 568 } {db2: database is locked}
 569 db2 close
 570
 571 do_test tcl-11.1 {
 572   db eval {INSERT INTO t4 VALUES(6)}
 573   db exists {SELECT x,x*2,x+x FROM t4 WHERE x==6}
 574 } {1}
 575 do_test tcl-11.2 {
 576   db exists {SELECT 0 FROM t4 WHERE x==6}
 577 } {1}
 578 do_test tcl-11.3 {
 579   db exists {SELECT 1 FROM t4 WHERE x==8}
 580 } {0}
 581 do_test tcl-11.3.1 {
 582   tcl_objproc db exists {SELECT 1 FROM t4 WHERE x==8}
 583 } {0}
 584
 585 do_test tcl-12.1 {
 586   unset -nocomplain a b c version
 587   set version [db version]
 588   scan $version "%d.%d.%d" a b c
 589   expr $a*1000000 + $b*1000 + $c
 590 } [sqlite3_libversion_number]
 591
 592
 593 # Check to see that when bindings of the form @aaa are used instead
 594 # of $aaa, that objects are treated as bytearray and are inserted
 595 # as BLOBs.
 596 #
 597 ifcapable tclvar {
 598   do_test tcl-13.1 {
 599     db eval {CREATE TABLE t5(x BLOB)}
 600     set x abc123
 601     db eval {INSERT INTO t5 VALUES($x)}
 602     db eval {SELECT typeof(x) FROM t5}
 603   } {text}
 604   do_test tcl-13.2 {
 605     binary scan $x H notUsed
 606     db eval {
 607       DELETE FROM t5;
 608       INSERT INTO t5 VALUES($x);
 609       SELECT typeof(x) FROM t5;
 610     }
 611   } {text}
 612   do_test tcl-13.3 {
 613     db eval {
 614       DELETE FROM t5;
 615       INSERT INTO t5 VALUES(@x);
 616       SELECT typeof(x) FROM t5;
 617     }
 618   } {blob}
 619   do_test tcl-13.4 {
 620     set y 1234
 621     db eval {
 622       DELETE FROM t5;
 623       INSERT INTO t5 VALUES(@y);
 624       SELECT hex(x), typeof(x) FROM t5
 625     }
 626   } {31323334 blob}
 627 }
 628
 629 db func xCall xCall
 630 proc xCall {} { return "value" }
 631 do_execsql_test tcl-14.1 {
 632   CREATE TABLE t6(x);
 633   INSERT INTO t6 VALUES(1);
 634 }
 635 do_test tcl-14.2 {
 636   db one {SELECT x FROM t6 WHERE xCall()!='value'}
 637 } {}
 638
 639
 640
 641 finish_test