Modify the (transaction) method of the tcl interface to use savepoints. This makes nested calls to (transaction) work more intuitively. (CVS 6101)

FossilOrigin-Name: f047758de9b499866aa4ddf16011498b12a7b963

manifest

@@ -1,5 +1,5 @@
-C Add\sfts_expr.*\sfiles\sto\sMakefile.in.\s(CVS\s6100)
+C Modify\sthe\s(transaction)\smethod\sof\sthe\stcl\sinterface\sto\suse\ssavepoints.\sThis\smakes\snested\scalls\sto\s(transaction)\swork\smore\sintuitively.\s(CVS\s6101)
-D 2009-01-02T15:47:02
+D 2009-01-02T17:33:46
 F Makefile.arm-wince-mingw32ce-gcc fcd5e9cd67fe88836360bb4f9ef4cb7f8e2fb5a0
 F Makefile.in 05461a9b5803d5ad10c79f989801e9fd2cc3e592
 F Makefile.linux-gcc d53183f4aa6a9192d249731c90dbdffbd2c68654
@@ -158,11 +158,11 @@ F src/select.c 6c2a5675c21bef11d8160f3dc97e1adfbf26bbb9
 F src/shell.c 65d19f8996a160f288087e31810f24025439c62a
 F src/sqlite.h.in 6cd2489e40fe97ba58c60044a4ced377e08b6d09
 F src/sqlite3ext.h 1db7d63ab5de4b3e6b83dd03d1a4e64fef6d2a17
-F src/sqliteInt.h 85c72545ac3195bb7d9aefc8377f91123594c59c
+F src/sqliteInt.h db087faf9556d61a05baf6f935307b4ce4b8af11
 F src/sqliteLimit.h f435e728c6b620ef7312814d660a81f9356eb5c8
 F src/status.c 237b193efae0cf6ac3f0817a208de6c6c6ef6d76
 F src/table.c 23db1e5f27c03160987c122a078b4bb51ef0b2f8
-F src/tclsqlite.c 9368e617bf2fe08a7b6659695190ce844c77f251
+F src/tclsqlite.c 4415e1033bd3e92b05a6a9cde911ee4de3b82df9
 F src/test1.c b193b8b80617bdb8297b25a87d00ee8d5a125d0d
 F src/test2.c 4e0ea288e1cf237f8ff26c8817f177f45486f4a6
 F src/test3.c 88a246b56b824275300e6c899634fbac1dc94b14
@@ -370,7 +370,7 @@ F test/fts3d.test d92a47fe8ed59c9e53d2d8e6d2685bb380aadadc
 F test/fts3e.test 1f6c6ac9cc8b772ca256e6b22aaeed50c9350851
 F test/fts3expr.test 000f05df771e203187ceac49ad21c303c720b783
 F test/fts3expr2.test 8501de895a4c0631e7226c9bac055cd49c9f6646
-F test/fts3near.test e8a9b4e16c63a795918b334b74d4aec14815bf8b
+F test/fts3near.test dc196dd17b4606f440c580d45b3d23aa975fd077
 F test/func.test a50f0a4b69ac251debe1dce3ba29da7476dc8c52
 F test/fuzz.test 62fc19dd36a427777fd671b569df07166548628a
 F test/fuzz2.test ea38692ce2da99ad79fe0be5eb1a452c1c4d37bb
@@ -537,7 +537,7 @@ F test/substr.test 4be572ac017143e59b4058dc75c91a0d0dc6d4e0
 F test/sync.test ded6b39d8d8ca3c0c5518516c6371b3316d3e3a3
 F test/table.test 13b1c2e2fb4727b35ee1fb7641fc469214fd2455
 F test/tableapi.test 505031f15b18a750184d967d2c896cf88fcc969c
-F test/tclsqlite.test 001682e3c188967fbd790c617991efadf9518386
+F test/tclsqlite.test 30636c3151ccc2d553aa09020b885054141a1963
 F test/tempdb.test b88ac8a19823cf771d742bf61eef93ef337c06b1
 F test/temptable.test 19b851b9e3e64d91e9867619b2a3f5fffee6e125
 F test/tester.tcl 66c41fc4d8a7f185d9abb21d68821c1f05e41f53
@@ -690,7 +690,7 @@ F tool/speedtest16.c c8a9c793df96db7e4933f0852abb7a03d48f2e81
 F tool/speedtest2.tcl ee2149167303ba8e95af97873c575c3e0fab58ff
 F tool/speedtest8.c 2902c46588c40b55661e471d7a86e4dd71a18224
 F tool/speedtest8inst1.c 293327bc76823f473684d589a8160bde1f52c14e
-P b1a4a17f8752d27f3b360019490ab3f15a1f629f
+P 524c8634dfa5926f38fac8bac1da6a14178c7764
-R 57a4990a0fb70a890cd794ab924e461e
+R 2c40d2ccc6b74b81b7ef9d1e2941c402
-U shane
+U danielk1977
-Z 3b7277361480f5eb73a2d074106d5f9f
+Z aab5684424ca9aa2a11e60efaac97954

manifest.uuid

@@ -1 +1 @@
-524c8634dfa5926f38fac8bac1da6a14178c7764
+f047758de9b499866aa4ddf16011498b12a7b963

src/sqliteInt.h

@@ -11,7 +11,7 @@
 *************************************************************************
 ** Internal interface definitions for SQLite.
 **
-** @(#) $Id: sqliteInt.h,v 1.816 2008/12/28 16:55:25 drh Exp $
+** @(#) $Id: sqliteInt.h,v 1.817 2009/01/02 17:33:46 danielk1977 Exp $
 */
 #ifndef _SQLITEINT_H_
 #define _SQLITEINT_H_
@@ -1503,7 +1503,7 @@ struct SrcList {
     int iCursor;      /* The VDBE cursor number used to access this table */
     Expr *pOn;        /* The ON clause of a join */
     IdList *pUsing;   /* The USING clause of a join */
-    Bitmask colUsed;  /* Bit N (1<<N) set if column N or pTab is used */
+    Bitmask colUsed;  /* Bit N (1<<N) set if column N of pTab is used */
     char *zIndex;     /* Identifier from "INDEXED BY <zIndex>" clause */
     Index *pIndex;    /* Index structure corresponding to zIndex, if any */
   } a[1];             /* One entry for each identifier on the list */

src/tclsqlite.c

@@ -12,7 +12,7 @@
 ** A TCL Interface to SQLite.  Append this file to sqlite3.c and
 ** compile the whole thing to build a TCL-enabled version of SQLite.
 **
-** $Id: tclsqlite.c,v 1.232 2008/12/30 06:24:58 danielk1977 Exp $
+** $Id: tclsqlite.c,v 1.233 2009/01/02 17:33:46 danielk1977 Exp $
 */
 #include "tcl.h"
 #include <errno.h>
@@ -118,6 +118,7 @@ struct SqliteDb {
   int nStmt;                 /* Number of statements in stmtList */
   IncrblobChannel *pIncrblob;/* Linked list of open incrblob channels */
   int nStep, nSort;          /* Statistics for most recent operation */
+  int nTransaction;          /* Number of nested [transaction] methods */
 };
 
 struct IncrblobChannel {
@@ -2261,16 +2262,17 @@ static int DbObjCmd(void *cd, Tcl_Interp *interp, int objc,Tcl_Obj *const*objv){
   ** 2005 O'Reilly Open Source Convention (OSCON).
   */
   case DB_TRANSACTION: {
-    int inTrans;
     Tcl_Obj *pScript;
-    const char *zBegin = "BEGIN";
+    const char *zBegin = "SAVEPOINT _tcl_transaction";
+    const char *zEnd;
     if( objc!=3 && objc!=4 ){
       Tcl_WrongNumArgs(interp, 2, objv, "[TYPE] SCRIPT");
       return TCL_ERROR;
     }
-    if( objc==3 ){
+
-      pScript = objv[2];
+    if( pDb->nTransaction ){
-    } else {
+      zBegin = "SAVEPOINT _tcl_transaction";
+    }else if( pDb->nTransaction==0 && objc==4 ){
       static const char *TTYPE_strs[] = {
         "deferred",   "exclusive",  "immediate", 0
       };
@@ -2287,28 +2289,55 @@ static int DbObjCmd(void *cd, Tcl_Interp *interp, int objc,Tcl_Obj *const*objv){
         case TTYPE_EXCLUSIVE:   zBegin = "BEGIN EXCLUSIVE";  break;
         case TTYPE_IMMEDIATE:   zBegin = "BEGIN IMMEDIATE";  break;
       }
-      pScript = objv[3];
     }
-    inTrans = !sqlite3_get_autocommit(pDb->db);
+    pScript = objv[objc-1];
-    if( !inTrans ){
+
-      pDb->disableAuth++;
+    pDb->disableAuth++;
-      (void)sqlite3_exec(pDb->db, zBegin, 0, 0, 0);
+    rc = sqlite3_exec(pDb->db, zBegin, 0, 0, 0);
-      pDb->disableAuth--;
+    pDb->disableAuth--;
+    if( rc!=SQLITE_OK ){
+      Tcl_AppendResult(interp, sqlite3_errmsg(pDb->db), 0);
+      return TCL_ERROR;
     }
+
+    pDb->nTransaction++;
     rc = Tcl_EvalObjEx(interp, pScript, 0);
-    if( !inTrans ){
+    pDb->nTransaction--;
-      const char *zEnd;
+
-      if( rc==TCL_ERROR ){
+    if( rc!=TCL_ERROR ){
-        zEnd = "ROLLBACK";
+      if( pDb->nTransaction ){
-      } else {
+        zEnd = "RELEASE _tcl_transaction";
+      }else{
         zEnd = "COMMIT";
       }
-      pDb->disableAuth++;
+    }else{
-      if( sqlite3_exec(pDb->db, zEnd, 0, 0, 0) ){
+      if( pDb->nTransaction ){
-        sqlite3_exec(pDb->db, "ROLLBACK", 0, 0, 0);
+        zEnd = "ROLLBACK TO _tcl_transaction ; RELEASE _tcl_transaction";
+      }else{
+        zEnd = "ROLLBACK";
       }
-      pDb->disableAuth--;
     }
+
+    pDb->disableAuth++;
+    if( sqlite3_exec(pDb->db, zEnd, 0, 0, 0) ){
+      /* This is a tricky scenario to handle. The most likely cause of an
+      ** error is that the exec() above was an attempt to commit the 
+      ** top-level transaction that returned SQLITE_BUSY. Or, less likely,
+      ** that an IO-error has occured. In either case, throw a Tcl exception
+      ** and try to rollback the transaction.
+      **
+      ** But it could also be that the user executed one or more BEGIN, 
+      ** COMMIT, SAVEPOINT, RELEASE or ROLLBACK commands that are confusing
+      ** this method's logic. Not clear how this would be best handled.
+      */
+      if( rc!=TCL_ERROR ){
+        Tcl_AppendResult(interp, sqlite3_errmsg(pDb->db), 0);
+        rc = TCL_ERROR;
+      }
+      sqlite3_exec(pDb->db, "ROLLBACK", 0, 0, 0);
+    }
+    pDb->disableAuth--;
+
     break;
   }
 

test/fts3near.test

@@ -10,7 +10,7 @@
 #
 #*************************************************************************
 #
-# $Id: fts3near.test,v 1.2 2008/09/12 18:25:31 drh Exp $
+# $Id: fts3near.test,v 1.3 2009/01/02 17:33:46 danielk1977 Exp $
 #
 
 set testdir [file dirname $argv0]
@@ -69,6 +69,13 @@ do_test fts3near-1.13 {
   execsql {SELECT docid FROM t1 WHERE content MATCH 'one NEAR five'}
 } {1 3} 
 
+do_test fts3near-1.14 {
+  execsql {SELECT docid FROM t1 WHERE content MATCH 'four NEAR four'}
+} {} 
+do_test fts3near-1.15 {
+  execsql {SELECT docid FROM t1 WHERE content MATCH 'one NEAR two NEAR one'}
+} {3} 
+
 
 # Output format of the offsets() function:
 #

test/tclsqlite.test

@@ -15,7 +15,7 @@
 # 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.70 2008/10/09 14:45:26 drh Exp $
+# $Id: tclsqlite.test,v 1.71 2009/01/02 17:33:46 danielk1977 Exp $
 
 set testdir [file dirname $argv0]
 source $testdir/tester.tcl
@@ -414,16 +414,17 @@ do_test tcl-10.9 {
     }
   }
   db eval {SELECT * FROM t4}
-} {1 2 3 4}
+} {1 2}
 do_test tcl-10.10 {
   for {set i 0} {$i<1} {incr i} {
     db transaction {
       db eval {INSERT INTO t4 VALUES(5)}
       continue
     }
+    error "This line should not be run"
   }
   db eval {SELECT * FROM t4}
-} {1 2 3 4 5}
+} {1 2 5}
 do_test tcl-10.11 {
   for {set i 0} {$i<10} {incr i} {
     db transaction {
@@ -432,7 +433,7 @@ do_test tcl-10.11 {
     }
   }
   db eval {SELECT * FROM t4}
-} {1 2 3 4 5 6}
+} {1 2 5 6}
 do_test tcl-10.12 {
   set rc [catch {
     for {set i 0} {$i<10} {incr i} {
@@ -445,13 +446,125 @@ do_test tcl-10.12 {
 } {2}
 do_test tcl-10.13 {
   db eval {SELECT * FROM t4}
-} {1 2 3 4 5 6 7}
+} {1 2 5 6 7}
+
+# Now test that [db transaction] commands may be nested with 
+# the expected results.
+#
+do_test tcl-10.14 {
+  db transaction {
+    db eval {
+      DELETE FROM t4;
+      INSERT INTO t4 VALUES('one');
+    }
+
+    catch { 
+      db transaction {
+        db eval { INSERT INTO t4 VALUES('two') }
+        db transaction {
+          db eval { INSERT INTO t4 VALUES('three') }
+          error "throw an error!"
+        }
+      }
+    }
+  }
+
+  db eval {SELECT * FROM t4}
+} {one}
+do_test tcl-10.15 {
+  # Make sure a transaction has not been left open.
+  db eval {BEGIN ; COMMIT}
+} {}
+do_test tcl-10.16 {
+  db transaction {
+    db eval { INSERT INTO t4 VALUES('two'); }
+    db transaction {
+      db eval { INSERT INTO t4 VALUES('three') }
+      db transaction {
+        db eval { INSERT INTO t4 VALUES('four') }
+      }
+    }
+  }
+  db eval {SELECT * FROM t4}
+} {one two three four}
+do_test tcl-10.17 {
+  catch {
+    db transaction {
+      db eval { INSERT INTO t4 VALUES('A'); }
+      db transaction {
+        db eval { INSERT INTO t4 VALUES('B') }
+        db transaction {
+          db eval { INSERT INTO t4 VALUES('C') }
+          error "throw an error!"
+        }
+      }
+    }
+  }
+  db eval {SELECT * FROM t4}
+} {one two three four}
+do_test tcl-10.18 {
+  # Make sure a transaction has not been left open.
+  db eval {BEGIN ; COMMIT}
+} {}
+
+# Mess up a [db transaction] command by locking the database using a
+# second connection when it tries to commit. Make sure the transaction
+# is not still open after the "database is locked" exception is thrown.
+#
+do_test tcl-10.18 {
+  sqlite3 db2 test.db
+  db2 eval {
+    BEGIN;
+    SELECT * FROM sqlite_master;
+  }
+
+  set rc [catch {
+    db transaction {
+      db eval {INSERT INTO t4 VALUES('five')}
+    }
+  } msg]
+  list $rc $msg
+} {1 {database is locked}}
+do_test tcl-10.19 {
+  db eval {BEGIN ; COMMIT}
+} {}
+
+# Thwart a [db transaction] command by locking the database using a
+# second connection with "BEGIN EXCLUSIVE". Make sure no transaction is 
+# open after the "database is locked" exception is thrown.
+#
+do_test tcl-10.20 {
+  db2 eval {
+    COMMIT;
+    BEGIN EXCLUSIVE;
+  }
+  set rc [catch {
+    db transaction {
+      db eval {INSERT INTO t4 VALUES('five')}
+    }
+  } msg]
+  list $rc $msg
+} {1 {database is locked}}
+do_test tcl-10.21 {
+  db2 close
+  db eval {BEGIN ; COMMIT}
+} {}
+do_test tcl-10.22 {
+  sqlite3 db2 test.db
+  db transaction exclusive {
+    catch { db2 eval {SELECT * FROM sqlite_master} } msg
+    set msg "db2: $msg"
+  }
+  set msg
+} {db2: database is locked}
+db2 close
 
 do_test tcl-11.1 {
-  db exists {SELECT x,x*2,x+x FROM t4 WHERE x==4}
+  db eval {INSERT INTO t4 VALUES(6)}
+  db exists {SELECT x,x*2,x+x FROM t4 WHERE x==6}
 } {1}
 do_test tcl-11.2 {
-  db exists {SELECT 0 FROM t4 WHERE x==4}
+  db exists {SELECT 0 FROM t4 WHERE x==6}
 } {1}
 do_test tcl-11.3 {
   db exists {SELECT 1 FROM t4 WHERE x==8}