# define CONST const
#elif !defined(Tcl_Size)
typedef int Tcl_Size;
+# ifndef Tcl_BounceRefCount
+# define Tcl_BounceRefCount(X) Tcl_IncrRefCount(X); Tcl_DecrRefCount(X)
+ /* https://www.tcl-lang.org/man/tcl9.0/TclLib/Object.html */
+# endif
#endif
/**** End copy of tclsqlite.h ****/
Tcl_DecrRefCount(pCmd);
}
- if( rc && rc!=TCL_RETURN ){
+ if( TCL_BREAK==rc ){
+ sqlite3_result_null(context);
+ }else if( rc && rc!=TCL_RETURN ){
sqlite3_result_error(context, Tcl_GetStringResult(p->interp), -1);
}else{
Tcl_Obj *pVar = Tcl_GetObjResult(p->interp);
}else if( (c=='b' && pVar->bytes==0 && strcmp(zType,"boolean")==0 )
|| (c=='b' && pVar->bytes==0 && strcmp(zType,"booleanString")==0 )
|| (c=='w' && strcmp(zType,"wideInt")==0)
- || (c=='i' && strcmp(zType,"int")==0)
+ || (c=='i' && strcmp(zType,"int")==0)
){
eType = SQLITE_INTEGER;
}else if( c=='d' && strcmp(zType,"double")==0 ){
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 *pVarName; /* Name of target array/dict 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
/*
** Initialize a DbEvalContext structure.
**
-** If pArray is not NULL, then it contains the name of a Tcl array
+** If pVarName 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 ${pVarName}(*) {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 *pVarName, /* Name of Tcl array to set (*) element of */
int evalFlags /* Flags controlling evaluation */
){
memset(p, 0, sizeof(DbEvalContext));
p->zSql = Tcl_GetString(pSql);
p->pSql = pSql;
Tcl_IncrRefCount(pSql);
- if( pArray ){
- p->pArray = pArray;
- Tcl_IncrRefCount(pArray);
+ if( pVarName ){
+ p->pVarName = pVarName;
+ Tcl_IncrRefCount(pVarName);
}
p->evalFlags = evalFlags;
addDatabaseRef(p->pDb);
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->pVarName) ){
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);
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->pVarName ){
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->pVarName, pStar, pColList, 0);
+ }else{
+ Tcl_Obj * pDict = Tcl_ObjGetVar2(interp, p->pVarName, NULL, 0);
+ if( !pDict ){
+ pDict = Tcl_NewDictObj();
+ }else if( Tcl_IsShared(pDict) ){
+ pDict = Tcl_DuplicateObj(pDict);
+ }
+ if( Tcl_DictObjPut(interp, pDict, pStar, pColList)==TCL_OK ){
+ Tcl_ObjSetVar2(interp, p->pVarName, NULL, pDict, 0);
+ }
+ Tcl_BounceRefCount(pDict);
+ }
Tcl_DecrRefCount(pStar);
+ Tcl_DecrRefCount(pColList);
}
}
if( rcs==SQLITE_ROW ){
return TCL_OK;
}
- if( p->pArray ){
+ if( p->pVarName ){
dbEvalRowInfo(p, 0, 0);
}
rcs = sqlite3_reset(pStmt);
dbReleaseStmt(p->pDb, p->pPreStmt, 0);
p->pPreStmt = 0;
}
- if( p->pArray ){
- Tcl_DecrRefCount(p->pArray);
- p->pArray = 0;
+ if( p->pVarName ){
+ Tcl_DecrRefCount(p->pVarName);
+ p->pVarName = 0;
}
Tcl_DecrRefCount(p->pSql);
dbReleaseColumnNames(p);
/*
** 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*) */
** 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 *pArray = p->pArray;
+ Tcl_Obj * const pScript = (Tcl_Obj *)data[1];
+ Tcl_Obj * const pVarName = p->pVarName;
while( (rc==TCL_OK || rc==TCL_CONTINUE) && TCL_OK==(rc = dbEvalStep(p)) ){
int i;
Tcl_Obj **apColName;
dbEvalRowInfo(p, &nCol, &apColName);
for(i=0; i<nCol; i++){
- if( pArray==0 ){
+ if( pVarName==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_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(pVarName),
+ Tcl_GetString(apColName[i]), 0);
+ }else{
+ /* Target is a dict */
+ Tcl_Obj *pDict = Tcl_ObjGetVar2(interp, pVarName, NULL, 0);
+ if( pDict ){
+ if( Tcl_IsShared(pDict) ){
+ pDict = Tcl_DuplicateObj(pDict);
+ }
+ if( Tcl_DictObjRemove(interp, pDict, apColName[i])==TCL_OK ){
+ Tcl_ObjSetVar2(interp, pVarName, 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, pVarName, apColName[i],
+ dbEvalColumnValue(p,i), 0);
}else{
- Tcl_ObjSetVar2(interp, pArray, apColName[i], dbEvalColumnValue(p,i), 0);
+ /* Target is a dict: set target(colName) = colValue */
+ Tcl_Obj *pDict = Tcl_ObjGetVar2(interp, pVarName, 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, pVarName, NULL, pDict, 0);
+ }
+ Tcl_BounceRefCount(pDict);
}
}
"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,
}
/*
- ** $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;
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;
}
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;
}
}else{
ClientData cd2[2];
DbEvalContext *p;
- Tcl_Obj *pArray = 0;
+ Tcl_Obj *pVarName = 0;
Tcl_Obj *pScript;
if( objc>=5 && *(char *)Tcl_GetString(objv[3]) ){
- pArray = objv[3];
+ pVarName = 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], pVarName, evalFlags);
cd2[0] = (void *)p;
cd2[1] = (void *)pScript;
#
#***********************************************************************
# 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
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
execsql {SELECT typeof(ret_int())}
} {integer}
+proc breakAsNullUdf args {
+ if {"1" eq [lindex $args 0]} {return -code break}
+}
+do_test tcl-9.4 {
+ db function banu breakAsNullUdf
+ execsql {SELECT typeof(banu()), typeof(banu(1))}
+} {text null}
+do_test tcl-9.5 {
+ db nullvalue banunull
+ db eval {SELECT banu(), banu(1)}
+} {{} banunull}
+
+
# Recursive calls to the same user-defined function
#
ifcapable tclvar {
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 {
INSERT INTO t4 VALUES('one');
}
- catch {
+ catch {
db transaction {
db eval { INSERT INTO t4 VALUES('two') }
db transaction {
} {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}
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 {
} {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 }
} msg]
list $rc $msg
} {1 {invalid command name "db"}}
-
+
+
proc closedb {} {
db close
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
} {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
projects / thirdparty / sqlite.git / commitdiff
