Tcl interface uses Tcl_Objs to implement user-defined functions, thus allowing
BLOB values to be transferred correctly. Ticket #1304. (CVS 2530) FossilOrigin-Name: 514aaab3f99637ebb8b6e352f4e29738102579b4
This commit is contained in:
drh
parent
8a15132904
commit
d1e4733d07
16
manifest
16
manifest
@ -1,5 +1,5 @@
|
||||
C Documentation\sfixes.\s\sTicket\s#1306.\s(CVS\s2529)
|
||||
D 2005-06-25T19:42:38
|
||||
C Tcl\sinterface\suses\sTcl_Objs\sto\simplement\suser-defined\sfunctions,\sthus\sallowing\nBLOB\svalues\sto\sbe\stransferred\scorrectly.\s\sTicket\s#1304.\s(CVS\s2530)
|
||||
D 2005-06-26T17:55:34
|
||||
F Makefile.in 64a6635ef44a98325e0cffe8d67669920a3dad47
|
||||
F Makefile.linux-gcc 06be33b2a9ad4f005a5f42b22c4a19dab3cbb5c7
|
||||
F README 9c4e2d6706bdcc3efdd773ce752a8cdab4f90028
|
||||
@ -65,7 +65,7 @@ F src/shell.c 25b3217d7c64e6497225439d261a253a23efff26
|
||||
F src/sqlite.h.in e06d5774e9cfa5962376ae988300a9f114a3e3d7
|
||||
F src/sqliteInt.h 2135a5bab820af868bf308f51cdf1adbcb3a85b7
|
||||
F src/table.c 25b3ff2b39b7d87e8d4a5da0713d68dfc06cbee9
|
||||
F src/tclsqlite.c 9b84e9e612ed573ee664e12bda62c7511e7b7746
|
||||
F src/tclsqlite.c cccaf6b78c290d824cf8ea089b8b27377e545830
|
||||
F src/test1.c b2885afb71c93e49db6a36f101fe38c71e7e3d6c
|
||||
F src/test2.c 716c1809dba8e5be6093703e9cada99d627542dc
|
||||
F src/test3.c 683e1e3819152ffd35da2f201e507228921148d0
|
||||
@ -80,7 +80,7 @@ F src/vacuum.c 829d9e1a6d7c094b80e0899686670932eafd768c
|
||||
F src/vdbe.c 56e892e351eb3ed634c3c239e4ad5c03aecfc2bf
|
||||
F src/vdbe.h 75e466d84d362b0c4498978a9d6b1e6bd32ecf3b
|
||||
F src/vdbeInt.h 4312faf41630a6c215924b6c7c2f39ebb1af8ffb
|
||||
F src/vdbeapi.c 5025a9163107e0a4964212d16e1c4defa13dc5c2
|
||||
F src/vdbeapi.c 7f392f0792d1258c958083d7de9eae7c3530c9a6
|
||||
F src/vdbeaux.c 38332d91887817a2146f46b58fff2a8a88ed0278
|
||||
F src/vdbemem.c da8e8d6f29dd1323f782f000d7cd120027c9ff03
|
||||
F src/where.c 3a9a2258ab3364655e9ea215ad5ae7bf41813f54
|
||||
@ -196,7 +196,7 @@ F test/subquery.test 0e37f0f032799c28aa8fcc0dc04ee28a78e5ce8b
|
||||
F test/subselect.test 3f3f7a940dc3195c3139f4d530385cb54665d614
|
||||
F test/table.test e87fb2211b97c6a3a367fbc116e8572091b53160
|
||||
F test/tableapi.test 6a66d58b37d46dc0f2b3c7d4bd2617d209399bd1
|
||||
F test/tclsqlite.test 7593733310c1d89f0b63c84fb155104ad948135c
|
||||
F test/tclsqlite.test faa15080060c39c9d6caa7e067c35e0ab3d4e793
|
||||
F test/temptable.test c71eeffe8af807f76eafdc5a39824639a1e301df
|
||||
F test/tester.tcl 98ecdc5723b3b2be5a8a5c3a7f38fa53031466ee
|
||||
F test/thread1.test 776c9e459b75ba905193b351926ac4019b049f35
|
||||
@ -283,7 +283,7 @@ F www/tclsqlite.tcl 425be741b8ae664f55cb1ef2371aab0a75109cf9
|
||||
F www/vdbe.tcl 87a31ace769f20d3627a64fa1fade7fed47b90d0
|
||||
F www/version3.tcl a99cf5f6d8bd4d5537584a2b342f0fb9fa601d8b
|
||||
F www/whentouse.tcl 528299b8316726dbcc5548e9aa0648c8b1bd055b
|
||||
P 8c99dca60aebee0ec5de9ed11350de864bc76584
|
||||
R f298a28bc4d82dbd5adfaab265db9284
|
||||
P 3dcdb7942ea9a9e5d708a198ba5183103d5075d9
|
||||
R 921bd56e87c8fac8c240733a327a399e
|
||||
U drh
|
||||
Z e8b0b3df38f0878df8807440d3147bbe
|
||||
Z 2d49decf778ceb912dc5c67c477d786e
|
||||
|
||||
@ -1 +1 @@
|
||||
3dcdb7942ea9a9e5d708a198ba5183103d5075d9
|
||||
514aaab3f99637ebb8b6e352f4e29738102579b4
|
||||
205
src/tclsqlite.c
205
src/tclsqlite.c
@ -11,7 +11,7 @@
|
||||
*************************************************************************
|
||||
** A TCL Interface to SQLite
|
||||
**
|
||||
** $Id: tclsqlite.c,v 1.126 2005/06/25 19:31:48 drh Exp $
|
||||
** $Id: tclsqlite.c,v 1.127 2005/06/26 17:55:34 drh Exp $
|
||||
*/
|
||||
#ifndef NO_TCL /* Omit this whole file if TCL is unavailable */
|
||||
|
||||
@ -21,6 +21,7 @@
|
||||
#include <stdlib.h>
|
||||
#include <string.h>
|
||||
#include <assert.h>
|
||||
#include <ctype.h>
|
||||
|
||||
#define NUM_PREPARED_STMTS 10
|
||||
#define MAX_PREPARED_STMTS 100
|
||||
@ -42,7 +43,9 @@
|
||||
typedef struct SqlFunc SqlFunc;
|
||||
struct SqlFunc {
|
||||
Tcl_Interp *interp; /* The TCL interpret to execute the function */
|
||||
char *zScript; /* The script to be run */
|
||||
Tcl_Obj *pScript; /* The Tcl_Obj representation of the script */
|
||||
int useEvalObjv; /* True if it is safe to use Tcl_EvalObjv */
|
||||
char *zName; /* Name of this function */
|
||||
SqlFunc *pNext; /* Next function on the list of them all */
|
||||
};
|
||||
|
||||
@ -54,7 +57,7 @@ typedef struct SqlCollate SqlCollate;
|
||||
struct SqlCollate {
|
||||
Tcl_Interp *interp; /* The TCL interpret to execute the function */
|
||||
char *zScript; /* The script to be run */
|
||||
SqlCollate *pNext; /* Next function on the list of them all */
|
||||
SqlCollate *pNext; /* Next function on the list of them all */
|
||||
};
|
||||
|
||||
/*
|
||||
@ -76,24 +79,76 @@ struct SqlPreparedStmt {
|
||||
*/
|
||||
typedef struct SqliteDb SqliteDb;
|
||||
struct SqliteDb {
|
||||
sqlite3 *db; /* The "real" database structure */
|
||||
Tcl_Interp *interp; /* The interpreter used for this database */
|
||||
char *zBusy; /* The busy callback routine */
|
||||
char *zCommit; /* The commit hook callback routine */
|
||||
char *zTrace; /* The trace callback routine */
|
||||
char *zProgress; /* The progress callback routine */
|
||||
char *zAuth; /* The authorization callback routine */
|
||||
char *zNull; /* Text to substitute for an SQL NULL value */
|
||||
SqlFunc *pFunc; /* List of SQL functions */
|
||||
SqlCollate *pCollate; /* List of SQL collation functions */
|
||||
int rc; /* Return code of most recent sqlite3_exec() */
|
||||
Tcl_Obj *pCollateNeeded; /* Collation needed script */
|
||||
sqlite3 *db; /* The "real" database structure */
|
||||
Tcl_Interp *interp; /* The interpreter used for this database */
|
||||
char *zBusy; /* The busy callback routine */
|
||||
char *zCommit; /* The commit hook callback routine */
|
||||
char *zTrace; /* The trace callback routine */
|
||||
char *zProgress; /* The progress callback routine */
|
||||
char *zAuth; /* The authorization callback routine */
|
||||
char *zNull; /* Text to substitute for an SQL NULL value */
|
||||
SqlFunc *pFunc; /* List of SQL functions */
|
||||
SqlCollate *pCollate; /* List of SQL collation functions */
|
||||
int rc; /* Return code of most recent sqlite3_exec() */
|
||||
Tcl_Obj *pCollateNeeded; /* Collation needed script */
|
||||
SqlPreparedStmt *stmtList; /* List of prepared statements*/
|
||||
SqlPreparedStmt *stmtLast; /* Last statement in the list */
|
||||
int maxStmt; /* The next maximum number of stmtList */
|
||||
int nStmt; /* Number of statements in stmtList */
|
||||
};
|
||||
|
||||
/*
|
||||
** Look at the script prefix in pCmd. We will be executing this script
|
||||
** after first appending one or more arguments. This routine analyzes
|
||||
** the script to see if it is safe to use Tcl_EvalObjv() on the script
|
||||
** rather than the more general Tcl_EvalEx(). Tcl_EvalObjv() is much
|
||||
** faster.
|
||||
**
|
||||
** Scripts that are safe to use with Tcl_EvalObjv() consists of a
|
||||
** command name followed by zero or more arguments with no [...] or $
|
||||
** or {...} or ; to be seen anywhere. Most callback scripts consist
|
||||
** of just a single procedure name and they meet this requirement.
|
||||
*/
|
||||
static int safeToUseEvalObjv(Tcl_Interp *interp, Tcl_Obj *pCmd){
|
||||
/* We could try to do something with Tcl_Parse(). But we will instead
|
||||
** just do a search for forbidden characters. If any of the forbidden
|
||||
** characters appear in pCmd, we will report the string as unsafe.
|
||||
*/
|
||||
const char *z;
|
||||
int n;
|
||||
z = Tcl_GetStringFromObj(pCmd, &n);
|
||||
while( n-- > 0 ){
|
||||
int c = *(z++);
|
||||
if( c=='$' || c=='[' || c==';' ) return 0;
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
/*
|
||||
** Find an SqlFunc structure with the given name. Or create a new
|
||||
** one if an existing one cannot be found. Return a pointer to the
|
||||
** structure.
|
||||
*/
|
||||
static SqlFunc *findSqlFunc(SqliteDb *pDb, const char *zName){
|
||||
SqlFunc *p, *pNew;
|
||||
int i;
|
||||
pNew = (SqlFunc*)Tcl_Alloc( sizeof(*pNew) + strlen(zName) + 1 );
|
||||
pNew->zName = (char*)&pNew[1];
|
||||
for(i=0; zName[i]; i++){ pNew->zName[i] = tolower(zName[i]); }
|
||||
pNew->zName[i] = 0;
|
||||
for(p=pDb->pFunc; p; p=p->pNext){
|
||||
if( strcmp(p->zName, pNew->zName)==0 ){
|
||||
Tcl_Free((char*)pNew);
|
||||
return p;
|
||||
}
|
||||
}
|
||||
pNew->interp = pDb->interp;
|
||||
pNew->pScript = 0;
|
||||
pNew->pNext = pDb->pFunc;
|
||||
pDb->pFunc = pNew;
|
||||
return pNew;
|
||||
}
|
||||
|
||||
/*
|
||||
** Finalize and free a list of prepared statements
|
||||
*/
|
||||
@ -121,6 +176,7 @@ static void DbDeleteCmd(void *db){
|
||||
while( pDb->pFunc ){
|
||||
SqlFunc *pFunc = pDb->pFunc;
|
||||
pDb->pFunc = pFunc->pNext;
|
||||
Tcl_DecrRefCount(pFunc->pScript);
|
||||
Tcl_Free((char*)pFunc);
|
||||
}
|
||||
while( pDb->pCollate ){
|
||||
@ -151,16 +207,9 @@ static int DbBusyHandler(void *cd, int nTries){
|
||||
SqliteDb *pDb = (SqliteDb*)cd;
|
||||
int rc;
|
||||
char zVal[30];
|
||||
char *zCmd;
|
||||
Tcl_DString cmd;
|
||||
|
||||
Tcl_DStringInit(&cmd);
|
||||
Tcl_DStringAppend(&cmd, pDb->zBusy, -1);
|
||||
sprintf(zVal, "%d", nTries);
|
||||
Tcl_DStringAppendElement(&cmd, zVal);
|
||||
zCmd = Tcl_DStringValue(&cmd);
|
||||
rc = Tcl_Eval(pDb->interp, zCmd);
|
||||
Tcl_DStringFree(&cmd);
|
||||
rc = Tcl_VarEval(pDb->interp, pDb->zBusy, " ", zVal, (char*)0);
|
||||
if( rc!=TCL_OK || atoi(Tcl_GetStringResult(pDb->interp)) ){
|
||||
return 0;
|
||||
}
|
||||
@ -247,7 +296,7 @@ static int tclSqlCollate(
|
||||
Tcl_IncrRefCount(pCmd);
|
||||
Tcl_ListObjAppendElement(p->interp, pCmd, Tcl_NewStringObj(zA, nA));
|
||||
Tcl_ListObjAppendElement(p->interp, pCmd, Tcl_NewStringObj(zB, nB));
|
||||
Tcl_EvalObjEx(p->interp, pCmd, 0);
|
||||
Tcl_EvalObjEx(p->interp, pCmd, TCL_EVAL_DIRECT);
|
||||
Tcl_DecrRefCount(pCmd);
|
||||
return (atoi(Tcl_GetStringResult(p->interp)));
|
||||
}
|
||||
@ -258,22 +307,88 @@ static int tclSqlCollate(
|
||||
*/
|
||||
static void tclSqlFunc(sqlite3_context *context, int argc, sqlite3_value**argv){
|
||||
SqlFunc *p = sqlite3_user_data(context);
|
||||
Tcl_DString cmd;
|
||||
Tcl_Obj *pCmd;
|
||||
int i;
|
||||
int rc;
|
||||
|
||||
Tcl_DStringInit(&cmd);
|
||||
Tcl_DStringAppend(&cmd, p->zScript, -1);
|
||||
for(i=0; i<argc; i++){
|
||||
if( SQLITE_NULL==sqlite3_value_type(argv[i]) ){
|
||||
Tcl_DStringAppendElement(&cmd, "");
|
||||
}else{
|
||||
Tcl_DStringAppendElement(&cmd, sqlite3_value_text(argv[i]));
|
||||
if( argc==0 ){
|
||||
/* If there are no arguments to the function, call Tcl_EvalObjEx on the
|
||||
** script object directly. This allows the TCL compiler to generate
|
||||
** bytecode for the command on the first invocation and thus make
|
||||
** subsequent invocations much faster. */
|
||||
pCmd = p->pScript;
|
||||
Tcl_IncrRefCount(pCmd);
|
||||
rc = Tcl_EvalObjEx(p->interp, pCmd, 0);
|
||||
Tcl_DecrRefCount(pCmd);
|
||||
}else{
|
||||
/* If there are arguments to the function, make a shallow copy of the
|
||||
** script object, lappend the arguments, then evaluate the copy.
|
||||
**
|
||||
** By "shallow" copy, we mean a only the outer list Tcl_Obj is duplicated.
|
||||
** The new Tcl_Obj contains pointers to the original list elements.
|
||||
** That way, when Tcl_EvalObjv() is run and shimmers the first element
|
||||
** of the list to tclCmdNameType, that alternate representation will
|
||||
** be preserved and reused on the next invocation.
|
||||
*/
|
||||
Tcl_Obj **aArg;
|
||||
int nArg;
|
||||
if( Tcl_ListObjGetElements(p->interp, p->pScript, &nArg, &aArg) ){
|
||||
sqlite3_result_error(context, Tcl_GetStringResult(p->interp), -1);
|
||||
return;
|
||||
}
|
||||
pCmd = Tcl_NewListObj(nArg, aArg);
|
||||
Tcl_IncrRefCount(pCmd);
|
||||
for(i=0; i<argc; i++){
|
||||
sqlite3_value *pIn = argv[i];
|
||||
Tcl_Obj *pVal;
|
||||
|
||||
/* Set pVal to contain the i'th column of this row. */
|
||||
switch( sqlite3_value_type(pIn) ){
|
||||
case SQLITE_BLOB: {
|
||||
int bytes = sqlite3_value_bytes(pIn);
|
||||
pVal = Tcl_NewByteArrayObj(sqlite3_value_blob(pIn), bytes);
|
||||
break;
|
||||
}
|
||||
case SQLITE_INTEGER: {
|
||||
sqlite_int64 v = sqlite3_value_int64(pIn);
|
||||
if( v>=-2147483647 && v<=2147483647 ){
|
||||
pVal = Tcl_NewIntObj(v);
|
||||
}else{
|
||||
pVal = Tcl_NewWideIntObj(v);
|
||||
}
|
||||
break;
|
||||
}
|
||||
case SQLITE_FLOAT: {
|
||||
double r = sqlite3_value_double(pIn);
|
||||
pVal = Tcl_NewDoubleObj(r);
|
||||
break;
|
||||
}
|
||||
case SQLITE_NULL: {
|
||||
pVal = Tcl_NewStringObj("", 0);
|
||||
break;
|
||||
}
|
||||
default: {
|
||||
int bytes = sqlite3_value_bytes(pIn);
|
||||
pVal = Tcl_NewStringObj(sqlite3_value_text(pIn), bytes);
|
||||
break;
|
||||
}
|
||||
}
|
||||
rc = Tcl_ListObjAppendElement(p->interp, pCmd, pVal);
|
||||
if( rc ){
|
||||
Tcl_DecrRefCount(pCmd);
|
||||
sqlite3_result_error(context, Tcl_GetStringResult(p->interp), -1);
|
||||
return;
|
||||
}
|
||||
}
|
||||
if( !p->useEvalObjv ){
|
||||
/* Tcl_EvalObjEx() will automatically call Tcl_EvalObjv() if pCmd
|
||||
** is a list without a string representation. To prevent this from
|
||||
** happening, make sure pCmd has a valid string representation */
|
||||
Tcl_GetString(pCmd);
|
||||
}
|
||||
rc = Tcl_EvalObjEx(p->interp, pCmd, TCL_EVAL_DIRECT);
|
||||
Tcl_DecrRefCount(pCmd);
|
||||
}
|
||||
rc = Tcl_EvalEx(p->interp, Tcl_DStringValue(&cmd), Tcl_DStringLength(&cmd),
|
||||
TCL_EVAL_DIRECT);
|
||||
Tcl_DStringFree(&cmd);
|
||||
|
||||
if( rc && rc!=TCL_RETURN ){
|
||||
sqlite3_result_error(context, Tcl_GetStringResult(p->interp), -1);
|
||||
@ -284,7 +399,7 @@ static void tclSqlFunc(sqlite3_context *context, int argc, sqlite3_value**argv){
|
||||
char *zType = pVar->typePtr ? pVar->typePtr->name : "";
|
||||
char c = zType[0];
|
||||
if( c=='b' && strcmp(zType,"bytearray")==0 && pVar->bytes==0 ){
|
||||
/* Only load a BLOB type if the Tcl variable is a bytearray and
|
||||
/* Only return a BLOB type if the Tcl variable is a bytearray and
|
||||
** has no string representation. */
|
||||
data = Tcl_GetByteArrayFromObj(pVar, &n);
|
||||
sqlite3_result_blob(context, data, n, SQLITE_TRANSIENT);
|
||||
@ -1158,22 +1273,22 @@ static int DbObjCmd(void *cd, Tcl_Interp *interp, int objc,Tcl_Obj *const*objv){
|
||||
*/
|
||||
case DB_FUNCTION: {
|
||||
SqlFunc *pFunc;
|
||||
Tcl_Obj *pScript;
|
||||
char *zName;
|
||||
char *zScript;
|
||||
int nScript;
|
||||
if( objc!=4 ){
|
||||
Tcl_WrongNumArgs(interp, 2, objv, "NAME SCRIPT");
|
||||
return TCL_ERROR;
|
||||
}
|
||||
zName = Tcl_GetStringFromObj(objv[2], 0);
|
||||
zScript = Tcl_GetStringFromObj(objv[3], &nScript);
|
||||
pFunc = (SqlFunc*)Tcl_Alloc( sizeof(*pFunc) + nScript + 1 );
|
||||
pScript = objv[3];
|
||||
pFunc = findSqlFunc(pDb, zName);
|
||||
if( pFunc==0 ) return TCL_ERROR;
|
||||
pFunc->interp = interp;
|
||||
pFunc->pNext = pDb->pFunc;
|
||||
pFunc->zScript = (char*)&pFunc[1];
|
||||
pDb->pFunc = pFunc;
|
||||
strcpy(pFunc->zScript, zScript);
|
||||
if( pFunc->pScript ){
|
||||
Tcl_DecrRefCount(pFunc->pScript);
|
||||
}
|
||||
pFunc->pScript = pScript;
|
||||
Tcl_IncrRefCount(pScript);
|
||||
pFunc->useEvalObjv = safeToUseEvalObjv(interp, pScript);
|
||||
rc = sqlite3_create_function(pDb->db, zName, -1, SQLITE_UTF8,
|
||||
pFunc, tclSqlFunc, 0, 0);
|
||||
if( rc!=SQLITE_OK ){
|
||||
|
||||
@ -369,6 +369,11 @@ sqlite_int64 sqlite3_column_int64(sqlite3_stmt *pStmt, int i){
|
||||
const unsigned char *sqlite3_column_text(sqlite3_stmt *pStmt, int i){
|
||||
return sqlite3_value_text( columnMem(pStmt,i) );
|
||||
}
|
||||
#if 0
|
||||
sqlite3_value *sqlite3_column_value(sqlite3_stmt *pStmt, int i){
|
||||
return columnMem(pStmt, i);
|
||||
}
|
||||
#endif
|
||||
#ifndef SQLITE_OMIT_UTF16
|
||||
const void *sqlite3_column_text16(sqlite3_stmt *pStmt, int i){
|
||||
return sqlite3_value_text16( columnMem(pStmt,i) );
|
||||
|
||||
@ -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.40 2005/05/05 10:30:30 drh Exp $
|
||||
# $Id: tclsqlite.test,v 1.41 2005/06/26 17:55:34 drh Exp $
|
||||
|
||||
set testdir [file dirname $argv0]
|
||||
source $testdir/tester.tcl
|
||||
@ -333,5 +333,20 @@ do_test tcl-9.3 {
|
||||
execsql {SELECT typeof(ret_int())}
|
||||
} {integer}
|
||||
|
||||
# Recursive calls to the same user-defined function
|
||||
#
|
||||
do_test tcl-9.10 {
|
||||
proc userfunc_r1 {n} {
|
||||
if {$n<=0} {return 0}
|
||||
set nm1 [expr {$n-1}]
|
||||
return [expr {[db eval {SELECT r1($nm1)}]+$n}]
|
||||
}
|
||||
db function r1 userfunc_r1
|
||||
execsql {SELECT r1(10)}
|
||||
} {55}
|
||||
do_test tcl-9.11 {
|
||||
execsql {SELECT r1(100)}
|
||||
} {5050}
|
||||
|
||||
|
||||
finish_test
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user