From b64b143b61db38b715c502552060efb42a918587 Mon Sep 17 00:00:00 2001 From: stephan Date: Mon, 5 May 2025 22:56:07 +0000 Subject: [PATCH] Part 2 of 2(?) of adding the -asdict flag to the db eval command of the Tcl interface. This needs a critical review from seasoned Tcl C API users before merging can be considered (noting that it's not planned for inclusion until 3.51). FossilOrigin-Name: 5368647a1f3f97c34c5d1f6dc406e62cd19fda28005c610bc789ce89dd7b58e6 --- manifest | 14 ++--- manifest.uuid | 2 +- src/tclsqlite.c | 50 ++++++++++++---- test/tclsqlite.test | 137 ++++++++++++++++++++++++++++++-------------- 4 files changed, 141 insertions(+), 62 deletions(-) diff --git a/manifest b/manifest index 115feb0ad7..5d5f1e4d96 100644 --- a/manifest +++ b/manifest @@ -1,5 +1,5 @@ -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 +C Part\s2\sof\s2(?)\sof\sadding\sthe\s-asdict\sflag\sto\sthe\sdb\seval\scommand\sof\sthe\sTcl\sinterface.\sThis\sneeds\sa\scritical\sreview\sfrom\sseasoned\sTcl\sC\sAPI\susers\sbefore\smerging\scan\sbe\sconsidered\s(noting\sthat\sit's\snot\splanned\sfor\sinclusion\suntil\s3.51). +D 2025-05-05T22:56:07.042 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 e909c4532311743907e38c8effeeaa03aa4b22bf75df11a2c35b10719a49fbe7 +F src/tclsqlite.c deb1fb446c0e98c3a226624cd2824d29300e4a2fee7259745b21c74ab5ecf960 F src/tclsqlite.h 65e2c761446e1c9fa0342b7d2612a703483643c8b6a316d12a65b745a4727395 F src/test1.c 9b54135e5f1352f06b1d23d7c183f124c1f33de6ea8997cd801f0f215c43591d F src/test2.c 62f0830958f9075692c29c6de51b495ae8969e1bef85f239ffcd9ba5fb44a5ff @@ -1725,7 +1725,7 @@ F test/tabfunc01.test 8a484fe8b19fc24844f72ca1ceb7c9ae8c9a6bca000a5c6ccab5d89f5c F test/table.test e87294bf1c80bfd7792142b84ab32ea5beb4f3f71e535d7fb263a6b2068377bf F test/tableapi.test e37c33e6be2276e3a96bb54b00eea7f321277115d10e5b30fdb52a112b432750 F test/tableopts.test dba698ba97251017b7c80d738c198d39ab747930 -F test/tclsqlite.test 0d0a1192a1d79057c30387868cbb662134331ec34180a341caac506c80202070 +F test/tclsqlite.test d27a320cad0dc3e3b282549a04ad809d666f40e330c3c0691b904c2a82f5f280 F test/tempdb.test 4cdaa23ddd8acb4d79cbb1b68ccdfd09b0537aaba909ca69a876157c2a2cbd08 F test/tempdb2.test 353864e96fd3ae2f70773d0ffbf8b1fe48589b02c2ec05013b540879410c3440 F test/tempfault.test 0c0d349c9a99bf5f374655742577f8712c647900 @@ -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 ad1ae76ad1209a2a63a1d8c4ac2ab536f3446d81c6ddffaebbd0bc578ed38833 -R f07b854267f4a21e26b0dd22bb106a9e +P 003e2c9bcaf560ee99c8fcf5d6f85f3813caaaf004ec0a04d9ef3bc58f0e8ce5 +R c575c0837760d3bcdf9311246eaa7997 U stephan -Z 4020ff00da56efd5eecb3f0aa327933a +Z 57f1200969b68de06c87296ce6645501 # Remove this line to create a well-formed Fossil manifest. diff --git a/manifest.uuid b/manifest.uuid index a75ba37a33..91aaf9d435 100644 --- a/manifest.uuid +++ b/manifest.uuid @@ -1 +1 @@ -003e2c9bcaf560ee99c8fcf5d6f85f3813caaaf004ec0a04d9ef3bc58f0e8ce5 +5368647a1f3f97c34c5d1f6dc406e62cd19fda28005c610bc789ce89dd7b58e6 diff --git a/src/tclsqlite.c b/src/tclsqlite.c index 1ebd38840c..987ef7e62c 100644 --- a/src/tclsqlite.c +++ b/src/tclsqlite.c @@ -1618,7 +1618,7 @@ struct DbEvalContext { SqlPreparedStmt *pPreStmt; /* Current statement */ int nCol; /* Number of columns returned by pStmt */ int evalFlags; /* Flags used */ - Tcl_Obj *pTgtName; /* Name of array variable */ + Tcl_Obj *pTgtName; /* Name of target array/dict variable */ Tcl_Obj **apColName; /* Array of column names */ }; @@ -1721,11 +1721,10 @@ static void dbEvalRowInfo( }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_BounceRefCount(pDict); } Tcl_DecrRefCount(pStar); Tcl_DecrRefCount(pColList); @@ -1898,7 +1897,7 @@ static int DbUseNre(void){ /* ** This function is part of the implementation of the command: ** -** $db eval SQL ?ARRAYNAME? SCRIPT +** $db eval SQL ?TGT-NAME? SCRIPT */ static int SQLITE_TCLAPI DbEvalNextCmd( ClientData data[], /* data[0] is the (DbEvalContext*) */ @@ -1912,8 +1911,8 @@ static int SQLITE_TCLAPI DbEvalNextCmd( ** is a pointer to a Tcl_Obj containing the script to run for each row ** returned by the queries encapsulated in data[0]. */ DbEvalContext *p = (DbEvalContext *)data[0]; - Tcl_Obj *pScript = (Tcl_Obj *)data[1]; - Tcl_Obj *pTgtName = p->pTgtName; + Tcl_Obj * const pScript = (Tcl_Obj *)data[1]; + Tcl_Obj * const pTgtName = p->pTgtName; while( (rc==TCL_OK || rc==TCL_CONTINUE) && TCL_OK==(rc = dbEvalStep(p)) ){ int i; @@ -1926,10 +1925,41 @@ static int SQLITE_TCLAPI DbEvalNextCmd( }else if( (p->evalFlags & SQLITE_EVAL_WITHOUTNULLS)!=0 && sqlite3_column_type(p->pPreStmt->pStmt, i)==SQLITE_NULL ){ - Tcl_UnsetVar2(interp, Tcl_GetString(pTgtName), - Tcl_GetString(apColName[i]), 0); + /* Remove NULL-containing column from the target container... */ + if( 0==(SQLITE_EVAL_ASDICT & p->evalFlags) ){ + /* Target is an array */ + Tcl_UnsetVar2(interp, Tcl_GetString(pTgtName), + Tcl_GetString(apColName[i]), 0); + }else{ + /* Target is a dict */ + Tcl_Obj *pDict = Tcl_ObjGetVar2(interp, pTgtName, NULL, 0); + if( pDict ){ + if( Tcl_IsShared(pDict) ){ + pDict = Tcl_DuplicateObj(pDict); + } + if( Tcl_DictObjRemove(interp, pDict, apColName[i])==TCL_OK ){ + Tcl_ObjSetVar2(interp, pTgtName, NULL, pDict, 0); + } + Tcl_BounceRefCount(pDict); + } + } + }else if( 0==(SQLITE_EVAL_ASDICT & p->evalFlags) ){ + /* Target is an array: set target(colName) = colValue */ + Tcl_ObjSetVar2(interp, pTgtName, apColName[i], + dbEvalColumnValue(p,i), 0); }else{ - Tcl_ObjSetVar2(interp, pTgtName, apColName[i], dbEvalColumnValue(p,i), 0); + /* Target is a dict: set target(colName) = colValue */ + Tcl_Obj *pDict = Tcl_ObjGetVar2(interp, pTgtName, NULL, 0); + if( !pDict ){ + pDict = Tcl_NewDictObj(); + }else if( Tcl_IsShared(pDict) ){ + pDict = Tcl_DuplicateObj(pDict); + } + if( Tcl_DictObjPut(interp, pDict, apColName[i], + dbEvalColumnValue(p,i))==TCL_OK ){ + Tcl_ObjSetVar2(interp, pTgtName, NULL, pDict, 0); + } + Tcl_BounceRefCount(pDict); } } @@ -2038,7 +2068,7 @@ static int SQLITE_TCLAPI DbObjCmd( "timeout", "total_changes", "trace", "trace_v2", "transaction", "unlock_notify", "update_hook", "version", "wal_hook", - 0 + 0 }; enum DB_enum { DB_AUTHORIZER, DB_BACKUP, DB_BIND_FALLBACK, diff --git a/test/tclsqlite.test b/test/tclsqlite.test index b2b00212da..74568cfc69 100644 --- a/test/tclsqlite.test +++ b/test/tclsqlite.test @@ -9,7 +9,7 @@ # #*********************************************************************** # This file implements regression tests for TCL interface to the -# SQLite library. +# SQLite library. # # Actually, all tests are based on the TCL interface, so the main # interface is pretty well tested. This file contains some addition @@ -121,7 +121,7 @@ ifcapable {complete} { do_test tcl-1.14 { set v [catch {db eval} msg] lappend v $msg -} {1 {wrong # args: should be "db eval ?OPTIONS? SQL ?ARRAY-NAME? ?SCRIPT?"}} +} {1 {wrong # args: should be "db eval ?OPTIONS? SQL ?VAR-NAME? ?SCRIPT?"}} do_test tcl-1.15 { set v [catch {db function} msg] lappend v $msg @@ -477,7 +477,7 @@ do_test tcl-10.13 { db eval {SELECT * FROM t4} } {1 2 5 6 7} -# Now test that [db transaction] commands may be nested with +# Now test that [db transaction] commands may be nested with # the expected results. # do_test tcl-10.14 { @@ -487,7 +487,7 @@ do_test tcl-10.14 { INSERT INTO t4 VALUES('one'); } - catch { + catch { db transaction { db eval { INSERT INTO t4 VALUES('two') } db transaction { @@ -686,11 +686,11 @@ do_test tcl-15.5 { } {0} -# 2017-06-26: The --withoutnulls flag to "db eval". +# 2017-06-26: The -withoutnulls flag to "db eval". # -# In the "db eval --withoutnulls SQL ARRAY" form, NULL results cause the -# corresponding array entry to be unset. The default behavior (without -# the -withoutnulls flags) is for the corresponding array value to get +# In the "db eval -withoutnulls SQL TARGET" form, NULL results cause the +# corresponding target entry to be unset. The default behavior (without +# the -withoutnulls flags) is for the corresponding target value to get # the [db nullvalue] string. # catch {db close} @@ -732,64 +732,64 @@ reset_db proc add {a b} { return [expr $a + $b] } proc ret {a} { return $a } -db function add_i -returntype integer add +db function add_i -returntype integer add db function add_r -ret real add -db function add_t -return text add -db function add_b -returntype blob add -db function add_a -returntype any add +db function add_t -return text add +db function add_b -returntype blob add +db function add_a -returntype any add -db function ret_i -returntype int ret +db function ret_i -returntype int ret db function ret_r -returntype real ret -db function ret_t -returntype text ret -db function ret_b -returntype blob ret -db function ret_a -r any ret +db function ret_t -returntype text ret +db function ret_b -returntype blob ret +db function ret_a -r any ret do_execsql_test 17.0 { SELECT quote( add_i(2, 3) ); - SELECT quote( add_r(2, 3) ); - SELECT quote( add_t(2, 3) ); - SELECT quote( add_b(2, 3) ); - SELECT quote( add_a(2, 3) ); + SELECT quote( add_r(2, 3) ); + SELECT quote( add_t(2, 3) ); + SELECT quote( add_b(2, 3) ); + SELECT quote( add_a(2, 3) ); } {5 5.0 '5' X'35' 5} do_execsql_test 17.1 { SELECT quote( add_i(2.2, 3.3) ); - SELECT quote( add_r(2.2, 3.3) ); - SELECT quote( add_t(2.2, 3.3) ); - SELECT quote( add_b(2.2, 3.3) ); - SELECT quote( add_a(2.2, 3.3) ); + SELECT quote( add_r(2.2, 3.3) ); + SELECT quote( add_t(2.2, 3.3) ); + SELECT quote( add_b(2.2, 3.3) ); + SELECT quote( add_a(2.2, 3.3) ); } {5.5 5.5 '5.5' X'352E35' 5.5} do_execsql_test 17.2 { SELECT quote( ret_i(2.5) ); - SELECT quote( ret_r(2.5) ); - SELECT quote( ret_t(2.5) ); - SELECT quote( ret_b(2.5) ); - SELECT quote( ret_a(2.5) ); + SELECT quote( ret_r(2.5) ); + SELECT quote( ret_t(2.5) ); + SELECT quote( ret_b(2.5) ); + SELECT quote( ret_a(2.5) ); } {2.5 2.5 '2.5' X'322E35' 2.5} do_execsql_test 17.3 { SELECT quote( ret_i('2.5') ); - SELECT quote( ret_r('2.5') ); - SELECT quote( ret_t('2.5') ); - SELECT quote( ret_b('2.5') ); - SELECT quote( ret_a('2.5') ); + SELECT quote( ret_r('2.5') ); + SELECT quote( ret_t('2.5') ); + SELECT quote( ret_b('2.5') ); + SELECT quote( ret_a('2.5') ); } {2.5 2.5 '2.5' X'322E35' '2.5'} do_execsql_test 17.4 { SELECT quote( ret_i('abc') ); - SELECT quote( ret_r('abc') ); - SELECT quote( ret_t('abc') ); - SELECT quote( ret_b('abc') ); - SELECT quote( ret_a('abc') ); + SELECT quote( ret_r('abc') ); + SELECT quote( ret_t('abc') ); + SELECT quote( ret_b('abc') ); + SELECT quote( ret_a('abc') ); } {'abc' 'abc' 'abc' X'616263' 'abc'} do_execsql_test 17.5 { SELECT quote( ret_i(X'616263') ); - SELECT quote( ret_r(X'616263') ); - SELECT quote( ret_t(X'616263') ); - SELECT quote( ret_b(X'616263') ); - SELECT quote( ret_a(X'616263') ); + SELECT quote( ret_r(X'616263') ); + SELECT quote( ret_t(X'616263') ); + SELECT quote( ret_b(X'616263') ); + SELECT quote( ret_a(X'616263') ); } {'abc' 'abc' 'abc' X'616263' X'616263'} do_test 17.6.1 { @@ -860,14 +860,60 @@ do_catchsql_test 19.911 { } {1 {invalid command name "bind_fallback_does_not_exist"}} db bind_fallback {} -#------------------------------------------------------------------------- +# 2025-05-05: the -asdict eval flag +# do_test 20.0 { + execsql {CREATE TABLE tad(a,b)} + execsql {INSERT INTO tad(a,b) VALUES('aa','bb'),('AA','BB')} + db eval -asdict { + SELECT a, b FROM tad WHERE 0 + } D {} + set D +} {* {a b}} +do_test 20.1 { + unset D + set i 0 + set res {} + set colNames {} + db eval -asdict { + SELECT a, b FROM tad ORDER BY a + } D { + dict set D i [incr i] + lappend res $i [dict get $D a] [dict get $D b] + if {1 == $i} { + set colNames [dict get $D *] + } + } + lappend res $colNames + unset D + set res +} {1 AA BB 2 aa bb {a b}} +do_test 20.2 { + set res {} + db eval -asdict -withoutnulls { + SELECT n, a, b FROM ( + SELECT 1 as n, 'aa' as a, NULL as b + UNION ALL + SELECT 2 as n, NULL as a, 'bb' as b + ) + ORDER BY n + } D { + dict unset D * + lappend res [dict values $D] + } + unset D + execsql {DROP TABLE tad} + set res +} {{1 aa} {2 bb}} + +#------------------------------------------------------------------------- +do_test 21.0 { db transaction { db close } } {} -do_test 20.1 { +do_test 21.1 { sqlite3 db test.db set rc [catch { db eval {SELECT 1 UNION ALL SELECT 2 UNION ALL SELECT 3} { db close } @@ -875,6 +921,8 @@ do_test 20.1 { list $rc $msg } {1 {invalid command name "db"}} + + proc closedb {} { db close return 10 @@ -885,7 +933,7 @@ sqlite3 db test.db db func closedb closedb db func func1 func1 -do_test 20.2 { +do_test 21.2 { set rc [catch { db eval { SELECT closedb(),func1() UNION ALL SELECT 20,30 UNION ALL SELECT 30,40 @@ -895,9 +943,10 @@ do_test 20.2 { } {0 {10 1 20 30 30 40}} sqlite3 db :memory: -do_test 21.1 { +do_test 22.1 { catch {db eval {SELECT 1 2 3;}} msg db erroroffset } {9} + finish_test -- 2.47.2