/ Check-in [68dd0ed5]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Tests and bug fixes on the new transaction method in the TCL interface. (CVS 2574)
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 68dd0ed5e312ecd5e98ee0fa1c21b70ff330f711
User & Date: drh 2005-08-02 17:15:15
Context
2005-08-02
17:38
Update the documentation for the new transaction method on the TCL interface. (CVS 2575) check-in: 3dc823a0 user: drh tags: trunk
17:15
Tests and bug fixes on the new transaction method in the TCL interface. (CVS 2574) check-in: 68dd0ed5 user: drh tags: trunk
17:13
Fix a bug in the btree balancer. ticket #1346. (CVS 2573) check-in: 3af69a49 user: drh tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to src/tclsqlite.c.

7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
....
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
**    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.
**
*************************************************************************
** A TCL Interface to SQLite
**
** $Id: tclsqlite.c,v 1.129 2005/08/02 12:21:09 drh Exp $
*/
#ifndef NO_TCL     /* Omit this whole file if TCL is unavailable */

#include "sqliteInt.h"
#include "hash.h"
#include "tcl.h"
#include <stdlib.h>
................................................................................
      static const char *TTYPE_strs[] = {
        "deferred",   "exclusive",  "immediate"
      };
      enum TTYPE_enum {
        TTYPE_DEFERRED, TTYPE_EXCLUSIVE, TTYPE_IMMEDIATE
      };
      int ttype;
      if( Tcl_GetIndexFromObj(interp, objv[2], TTYPE_strs, "transaction_type",
                              0, &ttype) ){
        return TCL_ERROR;
      }
      switch( (enum TTYPE_enum)ttype ){
        case TTYPE_DEFERRED:    /* no-op */;                 break;
        case TTYPE_EXCLUSIVE:   zBegin = "BEGIN EXCLUSIVE";  break;
        case TTYPE_IMMEDIATE:   zBegin = "BEGIN IMMEDIATE";  break;







|







 







|







7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
....
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
**    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.
**
*************************************************************************
** A TCL Interface to SQLite
**
** $Id: tclsqlite.c,v 1.130 2005/08/02 17:15:15 drh Exp $
*/
#ifndef NO_TCL     /* Omit this whole file if TCL is unavailable */

#include "sqliteInt.h"
#include "hash.h"
#include "tcl.h"
#include <stdlib.h>
................................................................................
      static const char *TTYPE_strs[] = {
        "deferred",   "exclusive",  "immediate"
      };
      enum TTYPE_enum {
        TTYPE_DEFERRED, TTYPE_EXCLUSIVE, TTYPE_IMMEDIATE
      };
      int ttype;
      if( Tcl_GetIndexFromObj(interp, objv[2], TTYPE_strs, "transaction type",
                              0, &ttype) ){
        return TCL_ERROR;
      }
      switch( (enum TTYPE_enum)ttype ){
        case TTYPE_DEFERRED:    /* no-op */;                 break;
        case TTYPE_EXCLUSIVE:   zBegin = "BEGIN EXCLUSIVE";  break;
        case TTYPE_IMMEDIATE:   zBegin = "BEGIN IMMEDIATE";  break;

Changes to test/tclsqlite.test.

11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
...
344
345
346
347
348
349
350

351





















































































352
# 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.42 2005/08/02 12:21:10 drh Exp $

set testdir [file dirname $argv0]
source $testdir/tester.tcl

# Check the error messages generated by tclsqlite
#
if {[sqlite3 -has-codec]} {
................................................................................
  db function r1 userfunc_r1
  execsql {SELECT r1(10)}
} {55}
do_test tcl-9.11 {
  execsql {SELECT r1(100)}
} {5050}
























































































finish_test







|







 







>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>

11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
...
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
# 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.43 2005/08/02 17:15:16 drh Exp $

set testdir [file dirname $argv0]
source $testdir/tester.tcl

# Check the error messages generated by tclsqlite
#
if {[sqlite3 -has-codec]} {
................................................................................
  db function r1 userfunc_r1
  execsql {SELECT r1(10)}
} {55}
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}

finish_test