Fix the onecolumn method in the TCL interface so that it works the same

as the eval method in all ways except for returning just the first value
in the result set. (CVS 1944)

FossilOrigin-Name: f323e4f86a08fe6448cbd4ff7cab459e8039d9f1

diff --git a/manifest b/manifest
index d2863b16707b23204c17d4b34a4623a06211a7be..9e4b1c1fd749b9388c9f6bec12024f73efd4553b 100644 (file)
--- a/manifest
+++ b/manifest
@@ -1,5 +1,5 @@
-C Lemon\sescapes\sbackslashes\sin\sfilenames\sin\s#line\sdirectives\sit\sgenerates.\nTicket\s#892.\s(CVS\s1943)
-D 2004-09-07T11:28:25
+C Fix\sthe\sonecolumn\smethod\sin\sthe\sTCL\sinterface\sso\sthat\sit\sworks\sthe\ssame\nas\sthe\seval\smethod\sin\sall\sways\sexcept\sfor\sreturning\sjust\sthe\sfirst\svalue\nin\sthe\sresult\sset.\s(CVS\s1944)
+D 2004-09-07T13:20:35
 F Makefile.in 65a7c43fcaf9a710d62f120b11b6e435eeb4a450
 F Makefile.linux-gcc a9e5a0d309fa7c38e7c14d3ecf7690879d3a5457
 F README f1de682fbbd94899d50aca13d387d1b3fd3be2dd
@@ -63,7 +63,7 @@ F src/shell.c 4f1a2760ced81c829defb47b0a3b61ffec61b604
 F src/sqlite.h.in 8bdf3fc4c76040f939cb1831eb97babf6a2fa858
 F src/sqliteInt.h 0840e651db8e16f88f2b8a2393ac98dfdbf01df0
 F src/table.c 8168c6e824009f8485bff79fc60ea8fea6829b10
-F src/tclsqlite.c ad6460a22cee18f292614a083cd15db670298213
+F src/tclsqlite.c 9225350a3144b3c0dd07a3cc88d2c219d57e2f0d
 F src/test1.c 0a7ae23d822177ecf3e8b577d026f0c8a39fe5c3
 F src/test2.c f4c2f3928f1998fd8cb75a81e33a60e025ea85d4
 F src/test3.c 94d0a2a90bccd85802488cb42c69ec8afd2e4646
@@ -170,7 +170,7 @@ F test/sort.test 35e9d6bd6930969050606c8feb9c6745469720e3
 F test/subselect.test 50f98723f00e97b1839d36410ee63597ca82d775
 F test/table.test fd9a0f4992230e4ca89cd37ae3191a12750df1d0
 F test/tableapi.test b21ab097e87a5484bb61029e69e1a4e5c5e65ede
-F test/tclsqlite.test d84b91f5e8219bbaf7f960ce649806eb39cc703f
+F test/tclsqlite.test de670beccf910163bf49973a3a96eaa00cdf127e
 F test/temptable.test 63a16e3ad19adf073cfbcdf7624c92ac5236522c
 F test/tester.tcl 1ff1170dd4203d87f572871080cdb64330dade99
 F test/thread1.test 776c9e459b75ba905193b351926ac4019b049f35
@@ -248,7 +248,7 @@ F www/tclsqlite.tcl 560ecd6a916b320e59f2917317398f3d59b7cc25
 F www/vdbe.tcl 59288db1ac5c0616296b26dce071c36cb611dfe9
 F www/version3.tcl 092a01f5ef430d2c4acc0ae558d74c4bb89638a0
 F www/whentouse.tcl a8335bce47cc2fddb07f19052cb0cb4d9129a8e4
-P 23e5bed1c5062f0f639751f89873bf1a277547bd
-R e40cf5a15ff3721d6f9f87371f66f8fc
+P d53047cbbc4e618c7bb5161b6f82876bb113db25
+R 303fc0394eb00108b3dd869bec641bd9
 U drh
-Z 9268fa6b52f2c5d13e0dc61c8a84d6ef
+Z 3769d67a37ed8f4ac0e4d151ebaba45a

diff --git a/manifest.uuid b/manifest.uuid
index 96bb6f9a3b7a9bf8602086e123a1a5049f9077a0..4d5283f9dd7c8c5c106c764702ee8aa751872086 100644 (file)
--- a/manifest.uuid
+++ b/manifest.uuid
@@ -1 +1 @@
-d53047cbbc4e618c7bb5161b6f82876bb113db25
\ No newline at end of file
+f323e4f86a08fe6448cbd4ff7cab459e8039d9f1
\ No newline at end of file

diff --git a/src/tclsqlite.c b/src/tclsqlite.c
index bcc2f0ef6f83de640494542515bbccfd3a629c5c..e907878d0fc1c586611c538df5c286d64fdffce7 100644 (file)
--- a/src/tclsqlite.c
+++ b/src/tclsqlite.c
@@ -11,7 +11,7 @@
 *************************************************************************
 ** A TCL Interface to SQLite
 **
-** $Id: tclsqlite.c,v 1.104 2004/09/06 17:24:13 drh Exp $
+** $Id: tclsqlite.c,v 1.105 2004/09/07 13:20:35 drh Exp $
 */
 #ifndef NO_TCL     /* Omit this whole file if TCL is unavailable */
 
@@ -73,35 +73,6 @@ struct SqliteDb {
   Tcl_Obj *pCollateNeeded;  /* Collation needed script */
 };
 
-/*
-** This is a second alternative callback for database queries.  A the
-** first column of the first row of the result is made the TCL result.
-*/
-static int DbEvalCallback3(
-  void *clientData,      /* An instance of CallbackData */
-  int nCol,              /* Number of columns in the result */
-  char ** azCol,         /* Data for each column */
-  char ** azN            /* Name for each column */
-){
-  Tcl_Interp *interp = (Tcl_Interp*)clientData;
-  Tcl_Obj *pElem;
-  if( azCol==0 ) return 1;
-  if( nCol==0 ) return 1;
-#ifdef UTF_TRANSLATION_NEEDED
-  {
-    Tcl_DString dCol;
-    Tcl_DStringInit(&dCol);
-    Tcl_ExternalToUtfDString(NULL, azCol[0], -1, &dCol);
-    pElem = Tcl_NewStringObj(Tcl_DStringValue(&dCol), -1);
-    Tcl_DStringFree(&dCol);
-  }
-#else
-  pElem = Tcl_NewStringObj(azCol[0], -1);
-#endif
-  Tcl_SetObjResult(interp, pElem);
-  return 1;
-}
-
 /*
 ** TCL calls this procedure when an sqlite3 database command is
 ** deleted.
@@ -496,48 +467,6 @@ static int DbObjCmd(void *cd, Tcl_Interp *interp, int objc,Tcl_Obj *const*objv){
     break;
   }
 
-  /*    $db progress ?N CALLBACK?
-  ** 
-  ** Invoke the given callback every N virtual machine opcodes while executing
-  ** queries.
-  */
-  case DB_PROGRESS: {
-    if( objc==2 ){
-      if( pDb->zProgress ){
-        Tcl_AppendResult(interp, pDb->zProgress, 0);
-      }
-    }else if( objc==4 ){
-      char *zProgress;
-      int len;
-      int N;
-      if( TCL_OK!=Tcl_GetIntFromObj(interp, objv[2], &N) ){
-       return TCL_ERROR;
-      };
-      if( pDb->zProgress ){
-        Tcl_Free(pDb->zProgress);
-      }
-      zProgress = Tcl_GetStringFromObj(objv[3], &len);
-      if( zProgress && len>0 ){
-        pDb->zProgress = Tcl_Alloc( len + 1 );
-        strcpy(pDb->zProgress, zProgress);
-      }else{
-        pDb->zProgress = 0;
-      }
-#ifndef SQLITE_OMIT_PROGRESS_CALLBACK
-      if( pDb->zProgress ){
-        pDb->interp = interp;
-        sqlite3_progress_handler(pDb->db, N, DbProgressHandler, pDb);
-      }else{
-        sqlite3_progress_handler(pDb->db, 0, 0, 0);
-      }
-#endif
-    }else{
-      Tcl_WrongNumArgs(interp, 2, objv, "N CALLBACK");
-      return TCL_ERROR;
-    }
-    break;
-  }
-
   /*     $db changes
   **
   ** Return the number of rows that were modified, inserted, or deleted by
@@ -685,13 +614,18 @@ static int DbObjCmd(void *cd, Tcl_Interp *interp, int objc,Tcl_Obj *const*objv){
    
   /*
   **    $db eval $sql ?array? ?{  ...code... }?
+  **    $db onecolumn $sql
   **
   ** The SQL statement in $sql is evaluated.  For each row, the values are
   ** placed in elements of the array named "array" and ...code... is executed.
   ** If "array" and "code" are omitted, then no callback is every invoked.
   ** If "array" is an empty string, then the values are placed in variables
   ** that have the same name as the fields extracted by the query.
+  **
+  ** The onecolumn method is the equivalent of:
+  **     lindex [$db eval $sql] 0
   */
+  case DB_ONECOLUMN:
   case DB_EVAL: {
     char const *zSql;      /* Next SQL statement to execute */
     char const *zLeft;     /* What is left after first stmt in zSql */
@@ -701,13 +635,21 @@ static int DbObjCmd(void *cd, Tcl_Interp *interp, int objc,Tcl_Obj *const*objv){
     Tcl_Obj **apParm;      /* Parameters that need a Tcl_DecrRefCount() */
     int nParm;             /* Number of entries used in apParm[] */
     Tcl_Obj *aParm[10];    /* Static space for apParm[] in the common case */
+    Tcl_Obj *pRet;         /* Value to be returned */
 
-    Tcl_Obj *pRet = Tcl_NewObj();
-    Tcl_IncrRefCount(pRet);
-
-    if( objc<3 || objc>5 ){
-      Tcl_WrongNumArgs(interp, 2, objv, "SQL ?ARRAY-NAME? ?SCRIPT?");
-      return TCL_ERROR;
+    if( choice==DB_ONECOLUMN ){
+      if( objc!=3 ){
+        Tcl_WrongNumArgs(interp, 2, objv, "SQL");
+        return TCL_ERROR;
+      }
+      pRet = 0;
+    }else{
+      if( objc<3 || objc>5 ){
+        Tcl_WrongNumArgs(interp, 2, objv, "SQL ?ARRAY-NAME? ?SCRIPT?");
+        return TCL_ERROR;
+      }
+      pRet = Tcl_NewObj();
+      Tcl_IncrRefCount(pRet);
     }
     if( objc==3 ){
       pArray = pScript = 0;
@@ -784,7 +726,6 @@ static int DbObjCmd(void *cd, Tcl_Interp *interp, int objc,Tcl_Obj *const*objv){
           }
         }
       }
-   
 
       /* Compute column names */
       nCol = sqlite3_column_count(pStmt);
@@ -848,6 +789,12 @@ static int DbObjCmd(void *cd, Tcl_Interp *interp, int objc,Tcl_Obj *const*objv){
             }else{
               Tcl_ObjSetVar2(interp, pArray, apColName[i], pVal, 0);
             }
+          }else if( choice==DB_ONECOLUMN ){
+            if( pRet==0 ){
+              pRet = pVal;
+              Tcl_IncrRefCount(pRet);
+            }
+            goto end_step;
           }else{
             Tcl_ListObjAppendElement(interp, pRet, pVal);
           }
@@ -858,6 +805,7 @@ static int DbObjCmd(void *cd, Tcl_Interp *interp, int objc,Tcl_Obj *const*objv){
           if( rc!=TCL_ERROR ) rc = TCL_OK;
         }
       }
+    end_step:
 
       /* Free the column name objects */
       if( pScript ){
@@ -892,10 +840,12 @@ static int DbObjCmd(void *cd, Tcl_Interp *interp, int objc,Tcl_Obj *const*objv){
     }
     Tcl_DecrRefCount(objv[2]);
 
-    if( rc==TCL_OK ){
-      Tcl_SetObjResult(interp, pRet);
+    if( pRet ){
+      if( rc==TCL_OK ){
+        Tcl_SetObjResult(interp, pRet);
+      }
+      Tcl_DecrRefCount(pRet);
     }
-    Tcl_DecrRefCount(pRet);
 
     break;
   }
@@ -949,29 +899,48 @@ static int DbObjCmd(void *cd, Tcl_Interp *interp, int objc,Tcl_Obj *const*objv){
   }
 
   /*
-  **     $db onecolumn SQL
-  **
-  ** Return a single column from a single row of the given SQL query.
+  ** The DB_ONECOLUMN method is implemented together with DB_EVAL.
   */
-  case DB_ONECOLUMN: {
-    char *zSql;
-    char *zErrMsg = 0;
-    if( objc!=3 ){
-      Tcl_WrongNumArgs(interp, 2, objv, "SQL");
+
+  /*    $db progress ?N CALLBACK?
+  ** 
+  ** Invoke the given callback every N virtual machine opcodes while executing
+  ** queries.
+  */
+  case DB_PROGRESS: {
+    if( objc==2 ){
+      if( pDb->zProgress ){
+        Tcl_AppendResult(interp, pDb->zProgress, 0);
+      }
+    }else if( objc==4 ){
+      char *zProgress;
+      int len;
+      int N;
+      if( TCL_OK!=Tcl_GetIntFromObj(interp, objv[2], &N) ){
+       return TCL_ERROR;
+      };
+      if( pDb->zProgress ){
+        Tcl_Free(pDb->zProgress);
+      }
+      zProgress = Tcl_GetStringFromObj(objv[3], &len);
+      if( zProgress && len>0 ){
+        pDb->zProgress = Tcl_Alloc( len + 1 );
+        strcpy(pDb->zProgress, zProgress);
+      }else{
+        pDb->zProgress = 0;
+      }
+#ifndef SQLITE_OMIT_PROGRESS_CALLBACK
+      if( pDb->zProgress ){
+        pDb->interp = interp;
+        sqlite3_progress_handler(pDb->db, N, DbProgressHandler, pDb);
+      }else{
+        sqlite3_progress_handler(pDb->db, 0, 0, 0);
+      }
+#endif
+    }else{
+      Tcl_WrongNumArgs(interp, 2, objv, "N CALLBACK");
       return TCL_ERROR;
     }
-    zSql = Tcl_GetStringFromObj(objv[2], 0);
-    rc = sqlite3_exec(pDb->db, zSql, DbEvalCallback3, interp, &zErrMsg);
-    if( rc==SQLITE_ABORT ){
-      rc = SQLITE_OK;
-    }else if( zErrMsg ){
-      Tcl_SetResult(interp, zErrMsg, TCL_VOLATILE);
-      free(zErrMsg);
-      rc = TCL_ERROR;
-    }else if( rc!=SQLITE_OK ){
-      Tcl_AppendResult(interp, sqlite3ErrStr(rc), 0);
-      rc = TCL_ERROR;
-    }
     break;
   }
 

diff --git a/test/tclsqlite.test b/test/tclsqlite.test
index 7dcbe5f6db4b60db79d96d4079a8150be96be1f7..b654ecd048559cb10e304e8bf3b8151fa09f87e5 100644 (file)
--- a/test/tclsqlite.test
+++ b/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.30 2004/08/20 18:34:20 drh Exp $
+# $Id: tclsqlite.test,v 1.31 2004/09/07 13:20:35 drh Exp $
 
 set testdir [file dirname $argv0]
 source $testdir/tester.tcl
@@ -170,6 +170,24 @@ do_test tcl-3.4 {
   set rc [catch {db onecolumn {SELECT bogus}} errmsg]
   lappend rc $errmsg
 } {1 {no such column: bogus}}
+do_test tcl-3.5 {
+  set b 50
+  set rc [catch {db one {SELECT * FROM t1 WHERE b>$b}} msg]
+  lappend rc $msg
+} {0 41}
+do_test tcl-3.6 {
+  set b 500
+  set rc [catch {db one {SELECT * FROM t1 WHERE b>$b}} msg]
+  lappend rc $msg
+} {0 {}}
+do_test tcl-3.7 {
+  set b 500
+  set rc [catch {db one {
+    INSERT INTO t1 VALUES(99,510);
+    SELECT * FROM t1 WHERE b>$b
+  }} msg]
+  lappend rc $msg
+} {0 99}
 
 # Turn the busy handler on and off
 #