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