/ Check-in [f047758d]
Login

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

Overview
Comment:Modify the (transaction) method of the tcl interface to use savepoints. This makes nested calls to (transaction) work more intuitively. (CVS 6101)
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: f047758de9b499866aa4ddf16011498b12a7b963
User & Date: danielk1977 2009-01-02 17:33:46
Context
2009-01-02
18:10
Fix compiler warnings in pager.c (CVS 6102) check-in: 78dd7909 user: drh tags: trunk
17:33
Modify the (transaction) method of the tcl interface to use savepoints. This makes nested calls to (transaction) work more intuitively. (CVS 6101) check-in: f047758d user: danielk1977 tags: trunk
15:47
Add fts_expr.* files to Makefile.in. (CVS 6100) check-in: 524c8634 user: shane tags: trunk
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Changes to src/sqliteInt.h.

     7      7   **    May you do good and not evil.
     8      8   **    May you find forgiveness for yourself and forgive others.
     9      9   **    May you share freely, never taking more than you give.
    10     10   **
    11     11   *************************************************************************
    12     12   ** Internal interface definitions for SQLite.
    13     13   **
    14         -** @(#) $Id: sqliteInt.h,v 1.816 2008/12/28 16:55:25 drh Exp $
           14  +** @(#) $Id: sqliteInt.h,v 1.817 2009/01/02 17:33:46 danielk1977 Exp $
    15     15   */
    16     16   #ifndef _SQLITEINT_H_
    17     17   #define _SQLITEINT_H_
    18     18   
    19     19   /*
    20     20   ** Include the configuration header output by 'configure' if we're using the
    21     21   ** autoconf-based build
................................................................................
  1499   1499       Select *pSelect;  /* A SELECT statement used in place of a table name */
  1500   1500       u8 isPopulated;   /* Temporary table associated with SELECT is populated */
  1501   1501       u8 jointype;      /* Type of join between this able and the previous */
  1502   1502       u8 notIndexed;    /* True if there is a NOT INDEXED clause */
  1503   1503       int iCursor;      /* The VDBE cursor number used to access this table */
  1504   1504       Expr *pOn;        /* The ON clause of a join */
  1505   1505       IdList *pUsing;   /* The USING clause of a join */
  1506         -    Bitmask colUsed;  /* Bit N (1<<N) set if column N or pTab is used */
         1506  +    Bitmask colUsed;  /* Bit N (1<<N) set if column N of pTab is used */
  1507   1507       char *zIndex;     /* Identifier from "INDEXED BY <zIndex>" clause */
  1508   1508       Index *pIndex;    /* Index structure corresponding to zIndex, if any */
  1509   1509     } a[1];             /* One entry for each identifier on the list */
  1510   1510   };
  1511   1511   
  1512   1512   /*
  1513   1513   ** Permitted values of the SrcList.a.jointype field

Changes to src/tclsqlite.c.

     8      8   **    May you find forgiveness for yourself and forgive others.
     9      9   **    May you share freely, never taking more than you give.
    10     10   **
    11     11   *************************************************************************
    12     12   ** A TCL Interface to SQLite.  Append this file to sqlite3.c and
    13     13   ** compile the whole thing to build a TCL-enabled version of SQLite.
    14     14   **
    15         -** $Id: tclsqlite.c,v 1.232 2008/12/30 06:24:58 danielk1977 Exp $
           15  +** $Id: tclsqlite.c,v 1.233 2009/01/02 17:33:46 danielk1977 Exp $
    16     16   */
    17     17   #include "tcl.h"
    18     18   #include <errno.h>
    19     19   
    20     20   /*
    21     21   ** Some additional include files are needed if this file is not
    22     22   ** appended to the amalgamation.
................................................................................
   114    114     Tcl_Obj *pCollateNeeded;   /* Collation needed script */
   115    115     SqlPreparedStmt *stmtList; /* List of prepared statements*/
   116    116     SqlPreparedStmt *stmtLast; /* Last statement in the list */
   117    117     int maxStmt;               /* The next maximum number of stmtList */
   118    118     int nStmt;                 /* Number of statements in stmtList */
   119    119     IncrblobChannel *pIncrblob;/* Linked list of open incrblob channels */
   120    120     int nStep, nSort;          /* Statistics for most recent operation */
          121  +  int nTransaction;          /* Number of nested [transaction] methods */
   121    122   };
   122    123   
   123    124   struct IncrblobChannel {
   124    125     sqlite3_blob *pBlob;      /* sqlite3 blob handle */
   125    126     SqliteDb *pDb;            /* Associated database connection */
   126    127     int iSeek;                /* Current seek offset */
   127    128     Tcl_Channel channel;      /* Channel identifier */
................................................................................
  2257   2258     ** throws an exception.  Or if no new transation was started, do nothing.
  2258   2259     ** pass the exception on up the stack.
  2259   2260     **
  2260   2261     ** This command was inspired by Dave Thomas's talk on Ruby at the
  2261   2262     ** 2005 O'Reilly Open Source Convention (OSCON).
  2262   2263     */
  2263   2264     case DB_TRANSACTION: {
  2264         -    int inTrans;
  2265   2265       Tcl_Obj *pScript;
  2266         -    const char *zBegin = "BEGIN";
         2266  +    const char *zBegin = "SAVEPOINT _tcl_transaction";
         2267  +    const char *zEnd;
  2267   2268       if( objc!=3 && objc!=4 ){
  2268   2269         Tcl_WrongNumArgs(interp, 2, objv, "[TYPE] SCRIPT");
  2269   2270         return TCL_ERROR;
  2270   2271       }
  2271         -    if( objc==3 ){
  2272         -      pScript = objv[2];
  2273         -    } else {
         2272  +
         2273  +    if( pDb->nTransaction ){
         2274  +      zBegin = "SAVEPOINT _tcl_transaction";
         2275  +    }else if( pDb->nTransaction==0 && objc==4 ){
  2274   2276         static const char *TTYPE_strs[] = {
  2275   2277           "deferred",   "exclusive",  "immediate", 0
  2276   2278         };
  2277   2279         enum TTYPE_enum {
  2278   2280           TTYPE_DEFERRED, TTYPE_EXCLUSIVE, TTYPE_IMMEDIATE
  2279   2281         };
  2280   2282         int ttype;
................................................................................
  2283   2285           return TCL_ERROR;
  2284   2286         }
  2285   2287         switch( (enum TTYPE_enum)ttype ){
  2286   2288           case TTYPE_DEFERRED:    /* no-op */;                 break;
  2287   2289           case TTYPE_EXCLUSIVE:   zBegin = "BEGIN EXCLUSIVE";  break;
  2288   2290           case TTYPE_IMMEDIATE:   zBegin = "BEGIN IMMEDIATE";  break;
  2289   2291         }
  2290         -      pScript = objv[3];
  2291   2292       }
  2292         -    inTrans = !sqlite3_get_autocommit(pDb->db);
  2293         -    if( !inTrans ){
  2294         -      pDb->disableAuth++;
  2295         -      (void)sqlite3_exec(pDb->db, zBegin, 0, 0, 0);
  2296         -      pDb->disableAuth--;
         2293  +    pScript = objv[objc-1];
         2294  +
         2295  +    pDb->disableAuth++;
         2296  +    rc = sqlite3_exec(pDb->db, zBegin, 0, 0, 0);
         2297  +    pDb->disableAuth--;
         2298  +    if( rc!=SQLITE_OK ){
         2299  +      Tcl_AppendResult(interp, sqlite3_errmsg(pDb->db), 0);
         2300  +      return TCL_ERROR;
  2297   2301       }
         2302  +
         2303  +    pDb->nTransaction++;
  2298   2304       rc = Tcl_EvalObjEx(interp, pScript, 0);
  2299         -    if( !inTrans ){
  2300         -      const char *zEnd;
  2301         -      if( rc==TCL_ERROR ){
  2302         -        zEnd = "ROLLBACK";
  2303         -      } else {
         2305  +    pDb->nTransaction--;
         2306  +
         2307  +    if( rc!=TCL_ERROR ){
         2308  +      if( pDb->nTransaction ){
         2309  +        zEnd = "RELEASE _tcl_transaction";
         2310  +      }else{
  2304   2311           zEnd = "COMMIT";
  2305   2312         }
  2306         -      pDb->disableAuth++;
  2307         -      if( sqlite3_exec(pDb->db, zEnd, 0, 0, 0) ){
  2308         -        sqlite3_exec(pDb->db, "ROLLBACK", 0, 0, 0);
         2313  +    }else{
         2314  +      if( pDb->nTransaction ){
         2315  +        zEnd = "ROLLBACK TO _tcl_transaction ; RELEASE _tcl_transaction";
         2316  +      }else{
         2317  +        zEnd = "ROLLBACK";
         2318  +      }
         2319  +    }
         2320  +
         2321  +    pDb->disableAuth++;
         2322  +    if( sqlite3_exec(pDb->db, zEnd, 0, 0, 0) ){
         2323  +      /* This is a tricky scenario to handle. The most likely cause of an
         2324  +      ** error is that the exec() above was an attempt to commit the 
         2325  +      ** top-level transaction that returned SQLITE_BUSY. Or, less likely,
         2326  +      ** that an IO-error has occured. In either case, throw a Tcl exception
         2327  +      ** and try to rollback the transaction.
         2328  +      **
         2329  +      ** But it could also be that the user executed one or more BEGIN, 
         2330  +      ** COMMIT, SAVEPOINT, RELEASE or ROLLBACK commands that are confusing
         2331  +      ** this method's logic. Not clear how this would be best handled.
         2332  +      */
         2333  +      if( rc!=TCL_ERROR ){
         2334  +        Tcl_AppendResult(interp, sqlite3_errmsg(pDb->db), 0);
         2335  +        rc = TCL_ERROR;
  2309   2336         }
  2310         -      pDb->disableAuth--;
         2337  +      sqlite3_exec(pDb->db, "ROLLBACK", 0, 0, 0);
  2311   2338       }
         2339  +    pDb->disableAuth--;
         2340  +
  2312   2341       break;
  2313   2342     }
  2314   2343   
  2315   2344     /*
  2316   2345     **    $db update_hook ?script?
  2317   2346     **    $db rollback_hook ?script?
  2318   2347     */

Changes to test/fts3near.test.

     6      6   #
     7      7   #    May you do good and not evil.
     8      8   #    May you find forgiveness for yourself and forgive others.
     9      9   #    May you share freely, never taking more than you give.
    10     10   #
    11     11   #*************************************************************************
    12     12   #
    13         -# $Id: fts3near.test,v 1.2 2008/09/12 18:25:31 drh Exp $
           13  +# $Id: fts3near.test,v 1.3 2009/01/02 17:33:46 danielk1977 Exp $
    14     14   #
    15     15   
    16     16   set testdir [file dirname $argv0]
    17     17   source $testdir/tester.tcl
    18     18   
    19     19   # If SQLITE_ENABLE_FTS3 is defined, omit this file.
    20     20   ifcapable !fts3 {
................................................................................
    64     64   } {1}
    65     65   do_test fts3near-1.12 {
    66     66     execsql {SELECT docid FROM t1 WHERE content MATCH 'five NEAR/1 "two three"'}
    67     67   } {2 3} 
    68     68   do_test fts3near-1.13 {
    69     69     execsql {SELECT docid FROM t1 WHERE content MATCH 'one NEAR five'}
    70     70   } {1 3} 
           71  +
           72  +do_test fts3near-1.14 {
           73  +  execsql {SELECT docid FROM t1 WHERE content MATCH 'four NEAR four'}
           74  +} {} 
           75  +do_test fts3near-1.15 {
           76  +  execsql {SELECT docid FROM t1 WHERE content MATCH 'one NEAR two NEAR one'}
           77  +} {3} 
    71     78   
    72     79   
    73     80   # Output format of the offsets() function:
    74     81   #
    75     82   #     <column number> <term number> <starting offset> <number of bytes>
    76     83   #
    77     84   db eval {

Changes to test/tclsqlite.test.

    11     11   # This file implements regression tests for TCL interface to the
    12     12   # SQLite library. 
    13     13   #
    14     14   # Actually, all tests are based on the TCL interface, so the main
    15     15   # interface is pretty well tested.  This file contains some addition
    16     16   # tests for fringe issues that the main test suite does not cover.
    17     17   #
    18         -# $Id: tclsqlite.test,v 1.70 2008/10/09 14:45:26 drh Exp $
           18  +# $Id: tclsqlite.test,v 1.71 2009/01/02 17:33:46 danielk1977 Exp $
    19     19   
    20     20   set testdir [file dirname $argv0]
    21     21   source $testdir/tester.tcl
    22     22   
    23     23   # Check the error messages generated by tclsqlite
    24     24   #
    25     25   if {[sqlite3 -has-codec]} {
................................................................................
   410    410           db eval {INSERT INTO t4 VALUES(3)}
   411    411           db eval {INSERT INTO t4 VALUES(4)}
   412    412           error test-error
   413    413         }
   414    414       }
   415    415     }
   416    416     db eval {SELECT * FROM t4}
   417         -} {1 2 3 4}
          417  +} {1 2}
   418    418   do_test tcl-10.10 {
   419    419     for {set i 0} {$i<1} {incr i} {
   420    420       db transaction {
   421    421         db eval {INSERT INTO t4 VALUES(5)}
   422    422         continue
   423    423       }
          424  +    error "This line should not be run"
   424    425     }
   425    426     db eval {SELECT * FROM t4}
   426         -} {1 2 3 4 5}
          427  +} {1 2 5}
   427    428   do_test tcl-10.11 {
   428    429     for {set i 0} {$i<10} {incr i} {
   429    430       db transaction {
   430    431         db eval {INSERT INTO t4 VALUES(6)}
   431    432         break
   432    433       }
   433    434     }
   434    435     db eval {SELECT * FROM t4}
   435         -} {1 2 3 4 5 6}
          436  +} {1 2 5 6}
   436    437   do_test tcl-10.12 {
   437    438     set rc [catch {
   438    439       for {set i 0} {$i<10} {incr i} {
   439    440         db transaction {
   440    441           db eval {INSERT INTO t4 VALUES(7)}
   441    442           return
   442    443         }
   443    444       }
   444    445     }]
   445    446   } {2}
   446    447   do_test tcl-10.13 {
   447    448     db eval {SELECT * FROM t4}
   448         -} {1 2 3 4 5 6 7}
          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
   449    561   
   450    562   do_test tcl-11.1 {
   451         -  db exists {SELECT x,x*2,x+x FROM t4 WHERE x==4}
          563  +  db eval {INSERT INTO t4 VALUES(6)}
          564  +  db exists {SELECT x,x*2,x+x FROM t4 WHERE x==6}
   452    565   } {1}
   453    566   do_test tcl-11.2 {
   454         -  db exists {SELECT 0 FROM t4 WHERE x==4}
          567  +  db exists {SELECT 0 FROM t4 WHERE x==6}
   455    568   } {1}
   456    569   do_test tcl-11.3 {
   457    570     db exists {SELECT 1 FROM t4 WHERE x==8}
   458    571   } {0}
   459    572   
   460    573   do_test tcl-12.1 {
   461    574     unset -nocomplain a b c version