From: stephan <stephan@noemail.net>
Date: Mon, 5 May 2025 20:44:58 +0000 (+0000)
Subject: Part 1 of 2(3?) of adding the -asdict flag to the db eval command of the Tcl interfac... 
X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=f44bf6c48215604569bedc69456f45665c6b8ac5;p=thirdparty%2Fsqlite.git

Part 1 of 2(3?) of adding the -asdict flag to the db eval command of the Tcl interface, as proposed in [forum:dce85c5ab9f0bc10|forum post dce85c5ab9f0bc10]. This is the lowest-level part but it does nothing because the higher-level part does not yet exist to activate it, a notable consequence of which is that it's untested. Rename pArray to pTgtName because the former name is now confusingly incorrect.

FossilOrigin-Name: 003e2c9bcaf560ee99c8fcf5d6f85f3813caaaf004ec0a04d9ef3bc58f0e8ce5
---

diff --git a/manifest b/manifest
index ffdf5b9bc2..115feb0ad7 100644
--- a/manifest
+++ b/manifest
@@ -1,5 +1,5 @@
-C Flesh\sout\sthe\sbreak-as-null\stest\scases\sto\sbetter\sdemonstrate\show\sit\scompares\sto\sthe\sdefault\sof\sreturning\san\sempty\sstring.
-D 2025-05-05T17:13:15.361
+C Part\s1\sof\s2(3?)\sof\sadding\sthe\s-asdict\sflag\sto\sthe\sdb\seval\scommand\sof\sthe\sTcl\sinterface,\sas\sproposed\sin\s[forum:dce85c5ab9f0bc10|forum\spost\sdce85c5ab9f0bc10].\sThis\sis\sthe\slowest-level\spart\sbut\sit\sdoes\snothing\sbecause\sthe\shigher-level\spart\sdoes\snot\syet\sexist\sto\sactivate\sit,\sa\snotable\sconsequence\sof\swhich\sis\sthat\sit's\suntested.\sRename\spArray\sto\spTgtName\sbecause\sthe\sformer\sname\sis\snow\sconfusingly\sincorrect.
+D 2025-05-05T20:44:58.422
 F .fossil-settings/binary-glob 61195414528fb3ea9693577e1980230d78a1f8b0a54c78cf1b9b24d0a409ed6a x
 F .fossil-settings/empty-dirs dbb81e8fc0401ac46a1491ab34a7f2c7c0452f2f06b54ebb845d024ca8283ef1
 F .fossil-settings/ignore-glob 35175cdfcf539b2318cb04a9901442804be81cd677d8b889fcc9149c21f239ea
@@ -794,7 +794,7 @@ F src/sqliteInt.h 8b18ed676757ce49df633b603a465655aa105d9862821ffa9296afb189ba56
 F src/sqliteLimit.h 6d817c28a8f19af95e6f4921933b7fbbca48a962bce0eb0ec81e8bb3ef38e68b
 F src/status.c 0e72e4f6be6ccfde2488eb63210297e75f569f3ce9920f6c3d77590ec6ce5ffd
 F src/table.c 0f141b58a16de7e2fbe81c308379e7279f4c6b50eb08efeec5892794a0ba30d1
-F src/tclsqlite.c 23cab775ff323bbd119eabf78bf747c9b88463bd12d46017a95c0b845f6a7d52
+F src/tclsqlite.c e909c4532311743907e38c8effeeaa03aa4b22bf75df11a2c35b10719a49fbe7
 F src/tclsqlite.h 65e2c761446e1c9fa0342b7d2612a703483643c8b6a316d12a65b745a4727395
 F src/test1.c 9b54135e5f1352f06b1d23d7c183f124c1f33de6ea8997cd801f0f215c43591d
 F src/test2.c 62f0830958f9075692c29c6de51b495ae8969e1bef85f239ffcd9ba5fb44a5ff
@@ -2207,8 +2207,8 @@ F tool/version-info.c 3b36468a90faf1bbd59c65fd0eb66522d9f941eedd364fabccd7227350
 F tool/warnings-clang.sh bbf6a1e685e534c92ec2bfba5b1745f34fb6f0bc2a362850723a9ee87c1b31a7
 F tool/warnings.sh 49a486c5069de041aedcbde4de178293e0463ae9918ecad7539eedf0ec77a139
 F tool/win/sqlite.vsix deb315d026cc8400325c5863eef847784a219a2f
-P 034211985da244a7e6544cb57a3273fb99e5939d6c3446ec3afc1c2d84b5ec98
-R 87bf710f552e5f13081622f9297236f4
+P ad1ae76ad1209a2a63a1d8c4ac2ab536f3446d81c6ddffaebbd0bc578ed38833
+R f07b854267f4a21e26b0dd22bb106a9e
 U stephan
-Z 90e0a56bb258ad6e4bfaa00f875858d4
+Z 4020ff00da56efd5eecb3f0aa327933a
 # Remove this line to create a well-formed Fossil manifest.
diff --git a/manifest.uuid b/manifest.uuid
index 0cce53780e..a75ba37a33 100644
--- a/manifest.uuid
+++ b/manifest.uuid
@@ -1 +1 @@
-ad1ae76ad1209a2a63a1d8c4ac2ab536f3446d81c6ddffaebbd0bc578ed38833
+003e2c9bcaf560ee99c8fcf5d6f85f3813caaaf004ec0a04d9ef3bc58f0e8ce5
diff --git a/src/tclsqlite.c b/src/tclsqlite.c
index 5a06ebd049..1ebd38840c 100644
--- a/src/tclsqlite.c
+++ b/src/tclsqlite.c
@@ -1618,11 +1618,12 @@ struct DbEvalContext {
   SqlPreparedStmt *pPreStmt;      /* Current statement */
   int nCol;                       /* Number of columns returned by pStmt */
   int evalFlags;                  /* Flags used */
-  Tcl_Obj *pArray;                /* Name of array variable */
+  Tcl_Obj *pTgtName;              /* Name of array variable */
   Tcl_Obj **apColName;            /* Array of column names */
 };
 
 #define SQLITE_EVAL_WITHOUTNULLS  0x00001  /* Unset array(*) for NULL */
+#define SQLITE_EVAL_ASDICT        0x00002  /* Use dict instead of array */
 
 /*
 ** Release any cache of column names currently held as part of
@@ -1643,20 +1644,20 @@ static void dbReleaseColumnNames(DbEvalContext *p){
 /*
 ** Initialize a DbEvalContext structure.
 **
-** If pArray is not NULL, then it contains the name of a Tcl array
+** If pTgtName is not NULL, then it contains the name of a Tcl array
 ** variable. The "*" member of this array is set to a list containing
 ** the names of the columns returned by the statement as part of each
 ** call to dbEvalStep(), in order from left to right. e.g. if the names
 ** of the returned columns are a, b and c, it does the equivalent of the
 ** tcl command:
 **
-**     set ${pArray}(*) {a b c}
+**     set ${pTgtName}(*) {a b c}
 */
 static void dbEvalInit(
   DbEvalContext *p,               /* Pointer to structure to initialize */
   SqliteDb *pDb,                  /* Database handle */
   Tcl_Obj *pSql,                  /* Object containing SQL script */
-  Tcl_Obj *pArray,                /* Name of Tcl array to set (*) element of */
+  Tcl_Obj *pTgtName,              /* Name of Tcl array to set (*) element of */
   int evalFlags                   /* Flags controlling evaluation */
 ){
   memset(p, 0, sizeof(DbEvalContext));
@@ -1664,9 +1665,9 @@ static void dbEvalInit(
   p->zSql = Tcl_GetString(pSql);
   p->pSql = pSql;
   Tcl_IncrRefCount(pSql);
-  if( pArray ){
-    p->pArray = pArray;
-    Tcl_IncrRefCount(pArray);
+  if( pTgtName ){
+    p->pTgtName = pTgtName;
+    Tcl_IncrRefCount(pTgtName);
   }
   p->evalFlags = evalFlags;
   addDatabaseRef(p->pDb);
@@ -1689,7 +1690,7 @@ static void dbEvalRowInfo(
     Tcl_Obj **apColName = 0;      /* Array of column names */
 
     p->nCol = nCol = sqlite3_column_count(pStmt);
-    if( nCol>0 && (papColName || p->pArray) ){
+    if( nCol>0 && (papColName || p->pTgtName) ){
       apColName = (Tcl_Obj**)Tcl_Alloc( sizeof(Tcl_Obj*)*nCol );
       for(i=0; i<nCol; i++){
         apColName[i] = Tcl_NewStringObj(sqlite3_column_name(pStmt,i), -1);
@@ -1698,20 +1699,36 @@ static void dbEvalRowInfo(
       p->apColName = apColName;
     }
 
-    /* If results are being stored in an array variable, then create
-    ** the array(*) entry for that array
+    /* If results are being stored in a variable then create the
+    ** array(*) or dict(*) entry for that variable.
     */
-    if( p->pArray ){
+    if( p->pTgtName ){
       Tcl_Interp *interp = p->pDb->interp;
       Tcl_Obj *pColList = Tcl_NewObj();
       Tcl_Obj *pStar = Tcl_NewStringObj("*", -1);
 
+      Tcl_IncrRefCount(pColList);
+      Tcl_IncrRefCount(pStar);
       for(i=0; i<nCol; i++){
         Tcl_ListObjAppendElement(interp, pColList, apColName[i]);
       }
-      Tcl_IncrRefCount(pStar);
-      Tcl_ObjSetVar2(interp, p->pArray, pStar, pColList, 0);
+      if( 0==(SQLITE_EVAL_ASDICT & p->evalFlags) ){
+        Tcl_ObjSetVar2(interp, p->pTgtName, pStar, pColList, 0);
+      }else{
+        Tcl_Obj * pDict = Tcl_ObjGetVar2(interp, p->pTgtName, NULL, 0);
+        if( !pDict ){
+          pDict = Tcl_NewDictObj();
+        }else if( Tcl_IsShared(pDict) ){
+          pDict = Tcl_DuplicateObj(pDict);
+        }
+        Tcl_IncrRefCount(pDict);
+        if( Tcl_DictObjPut(interp, pDict, pStar, pColList)==TCL_OK ){
+          Tcl_ObjSetVar2(interp, p->pTgtName, NULL, pDict, 0);
+        }
+        Tcl_DecrRefCount(pDict);
+      }
       Tcl_DecrRefCount(pStar);
+      Tcl_DecrRefCount(pColList);
     }
   }
 
@@ -1753,7 +1770,7 @@ static int dbEvalStep(DbEvalContext *p){
       if( rcs==SQLITE_ROW ){
         return TCL_OK;
       }
-      if( p->pArray ){
+      if( p->pTgtName ){
         dbEvalRowInfo(p, 0, 0);
       }
       rcs = sqlite3_reset(pStmt);
@@ -1804,9 +1821,9 @@ static void dbEvalFinalize(DbEvalContext *p){
     dbReleaseStmt(p->pDb, p->pPreStmt, 0);
     p->pPreStmt = 0;
   }
-  if( p->pArray ){
-    Tcl_DecrRefCount(p->pArray);
-    p->pArray = 0;
+  if( p->pTgtName ){
+    Tcl_DecrRefCount(p->pTgtName);
+    p->pTgtName = 0;
   }
   Tcl_DecrRefCount(p->pSql);
   dbReleaseColumnNames(p);
@@ -1896,7 +1913,7 @@ static int SQLITE_TCLAPI DbEvalNextCmd(
   ** returned by the queries encapsulated in data[0]. */
   DbEvalContext *p = (DbEvalContext *)data[0];
   Tcl_Obj *pScript = (Tcl_Obj *)data[1];
-  Tcl_Obj *pArray = p->pArray;
+  Tcl_Obj *pTgtName = p->pTgtName;
 
   while( (rc==TCL_OK || rc==TCL_CONTINUE) && TCL_OK==(rc = dbEvalStep(p)) ){
     int i;
@@ -1904,15 +1921,15 @@ static int SQLITE_TCLAPI DbEvalNextCmd(
     Tcl_Obj **apColName;
     dbEvalRowInfo(p, &nCol, &apColName);
     for(i=0; i<nCol; i++){
-      if( pArray==0 ){
+      if( pTgtName==0 ){
         Tcl_ObjSetVar2(interp, apColName[i], 0, dbEvalColumnValue(p,i), 0);
       }else if( (p->evalFlags & SQLITE_EVAL_WITHOUTNULLS)!=0
-             && sqlite3_column_type(p->pPreStmt->pStmt, i)==SQLITE_NULL 
+             && sqlite3_column_type(p->pPreStmt->pStmt, i)==SQLITE_NULL
       ){
-        Tcl_UnsetVar2(interp, Tcl_GetString(pArray), 
+        Tcl_UnsetVar2(interp, Tcl_GetString(pTgtName),
                       Tcl_GetString(apColName[i]), 0);
       }else{
-        Tcl_ObjSetVar2(interp, pArray, apColName[i], dbEvalColumnValue(p,i), 0);
+        Tcl_ObjSetVar2(interp, pTgtName, apColName[i], dbEvalColumnValue(p,i), 0);
       }
     }
 
@@ -2855,13 +2872,15 @@ deserialize_error:
   }
 
   /*
-  **    $db eval ?options? $sql ?array? ?{  ...code... }?
+  **    $db eval ?options? $sql ?varName? ?{  ...code... }?
   **
-  ** 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 SQL statement in $sql is evaluated.  For each row, the values
+  ** are placed in elements of the array or dict named $varName and
+  ** ...code... is executed.  If $varName and $code are omitted, then
+  ** no callback is ever invoked.  If $varName is an empty string,
+  ** then the values are placed in variables that have the same name
+  ** as the fields extracted by the query, and those variables are
+  ** accessible during the eval of $code.
   */
   case DB_EVAL: {
     int evalFlags = 0;
@@ -2869,8 +2888,9 @@ deserialize_error:
     while( objc>3 && (zOpt = Tcl_GetString(objv[2]))!=0 && zOpt[0]=='-' ){
       if( strcmp(zOpt, "-withoutnulls")==0 ){
         evalFlags |= SQLITE_EVAL_WITHOUTNULLS;
-      }
-      else{
+      }else if( strcmp(zOpt, "-asdict")==0 ){
+        evalFlags |= SQLITE_EVAL_ASDICT;
+      }else{
         Tcl_AppendResult(interp, "unknown option: \"", zOpt, "\"", (void*)0);
         return TCL_ERROR;
       }
@@ -2878,8 +2898,8 @@ deserialize_error:
       objv++;
     }
     if( objc<3 || objc>5 ){
-      Tcl_WrongNumArgs(interp, 2, objv, 
-          "?OPTIONS? SQL ?ARRAY-NAME? ?SCRIPT?");
+      Tcl_WrongNumArgs(interp, 2, objv,
+          "?OPTIONS? SQL ?VAR-NAME? ?SCRIPT?");
       return TCL_ERROR;
     }
 
@@ -2905,17 +2925,17 @@ deserialize_error:
     }else{
       ClientData cd2[2];
       DbEvalContext *p;
-      Tcl_Obj *pArray = 0;
+      Tcl_Obj *pTgtName = 0;
       Tcl_Obj *pScript;
 
       if( objc>=5 && *(char *)Tcl_GetString(objv[3]) ){
-        pArray = objv[3];
+        pTgtName = objv[3];
       }
       pScript = objv[objc-1];
       Tcl_IncrRefCount(pScript);
 
       p = (DbEvalContext *)Tcl_Alloc(sizeof(DbEvalContext));
-      dbEvalInit(p, pDb, objv[2], pArray, evalFlags);
+      dbEvalInit(p, pDb, objv[2], pTgtName, evalFlags);
 
       cd2[0] = (void *)p;
       cd2[1] = (void *)pScript;