diff options
| -rw-r--r-- | manifest | 16 | ||||
| -rw-r--r-- | manifest.uuid | 2 | ||||
| -rw-r--r-- | src/tclsqlite.c | 205 | ||||
| -rw-r--r-- | src/vdbeapi.c | 5 | ||||
| -rw-r--r-- | test/tclsqlite.test | 17 |
5 files changed, 190 insertions, 55 deletions
@@ -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 diff --git a/manifest.uuid b/manifest.uuid index 59e0cd176..94261a392 100644 --- a/manifest.uuid +++ b/manifest.uuid @@ -1 +1 @@ -3dcdb7942ea9a9e5d708a198ba5183103d5075d9
\ No newline at end of file +514aaab3f99637ebb8b6e352f4e29738102579b4
\ No newline at end of file diff --git a/src/tclsqlite.c b/src/tclsqlite.c index f1e80e5ff..64a2a3b8e 100644 --- a/src/tclsqlite.c +++ b/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,18 +79,18 @@ 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 */ @@ -95,6 +98,58 @@ struct SqliteDb { }; /* +** 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 */ static void flushStmtCache( SqliteDb *pDb ){ @@ -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 ){ diff --git a/src/vdbeapi.c b/src/vdbeapi.c index 99da1c30b..3366d2030 100644 --- a/src/vdbeapi.c +++ b/src/vdbeapi.c @@ -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) ); diff --git a/test/tclsqlite.test b/test/tclsqlite.test index b98dfa1ae..b41b6eec7 100644 --- 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.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 |