diff --git a/manifest b/manifest index 91e378ed90..331c3ed6ec 100644 --- a/manifest +++ b/manifest @@ -1,5 +1,5 @@ -C Verify\sthat\sfts5\sauxiliary\sfunctions\scannot\sbe\sused\sin\saggregate\squeries. -D 2019-02-27T15:26:03.846 +C Add\sthe\s"-returntype"\soption\sto\sthe\s"db\sfunction"\sTcl\smethod. +D 2019-02-27T16:38:19.320 F .fossil-settings/empty-dirs dbb81e8fc0401ac46a1491ab34a7f2c7c0452f2f06b54ebb845d024ca8283ef1 F .fossil-settings/ignore-glob 35175cdfcf539b2318cb04a9901442804be81cd677d8b889fcc9149c21f239ea F Makefile.in 1ad7263f38329c0ecea543c80f30af839ee714ea77fc391bf1a3fbb919a5b6b5 @@ -524,7 +524,7 @@ F src/sqliteInt.h f253c4ec15e577a293a462e5049f8ea1d0c7a31819b3a88acdd24698df8f4d F src/sqliteLimit.h 1513bfb7b20378aa0041e7022d04acb73525de35b80b252f1b83fedb4de6a76b F src/status.c 46e7aec11f79dad50965a5ca5fa9de009f7d6bde08be2156f1538a0a296d4d0e F src/table.c b46ad567748f24a326d9de40e5b9659f96ffff34 -F src/tclsqlite.c 6b19e7562195aaf881f3e35e2472dc01ae3cb156961db5126c3d616744729b7e +F src/tclsqlite.c de81c50e5112a8106da871b4d2dfef7748fe7625e148f85cc89ec7499b8e4de5 F src/test1.c 353b066e7ec761c4c715c1c20b888e0e7a0b0c0eda7f68c110e032d63713cade F src/test2.c 3efb99ab7f1fc8d154933e02ae1378bac9637da5 F src/test3.c 61798bb0d38b915067a8c8e03f5a534b431181f802659a6616f9b4ff7d872644 @@ -1366,7 +1366,7 @@ F test/tabfunc01.test 20e98ffe55f35d8d33fd834ca8bf9d4b637e560af8fcd00464b4154d90 F test/table.test eb3463b7add9f16a5bb836badf118cf391b809d09fdccd1f79684600d07ec132 F test/tableapi.test ecbcc29c4ab62c1912c3717c48ea5c5e59f7d64e4a91034e6148bd2b82f177f4 F test/tableopts.test dba698ba97251017b7c80d738c198d39ab747930 -F test/tclsqlite.test dca8aa30d84175e7d8c8fc43d3ffa11fa56e23fbdac2679d03833a0f326edf34 +F test/tclsqlite.test 0037c0ca7fd3da08202a807f7b76590019841edb9f459fcfcf52aed7212bf853 F test/tempdb.test 4cdaa23ddd8acb4d79cbb1b68ccdfd09b0537aaba909ca69a876157c2a2cbd08 F test/tempdb2.test 2479226e4cb96f4c663eccd2d12c077cf6bda29ca5cc69a8a58a06127105dd62 F test/tempfault.test 0c0d349c9a99bf5f374655742577f8712c647900 @@ -1805,7 +1805,7 @@ F vsixtest/vsixtest.tcl 6a9a6ab600c25a91a7acc6293828957a386a8a93 F vsixtest/vsixtest.vcxproj.data 2ed517e100c66dc455b492e1a33350c1b20fbcdc F vsixtest/vsixtest.vcxproj.filters 37e51ffedcdb064aad6ff33b6148725226cd608e F vsixtest/vsixtest_TemporaryKey.pfx e5b1b036facdb453873e7084e1cae9102ccc67a0 -P 29d02bf2fa9ecacbcc3e862ca70382f5875da8c1dc7fd27366190045fcc42b15 -R 71be3f9cadb3d3db22b5f61c5be60610 +P 122330dba3eb2492875bd02a46442306f73e251408447af5e5914ee0c8d6a110 +R 4166c9e01ccb9a254eef55033738e8bf U dan -Z a18dd99afd6d91ff1d4c6dbed66d97ea +Z f227401976c706870557af555984f5d5 diff --git a/manifest.uuid b/manifest.uuid index 042a028add..a8da48124d 100644 --- a/manifest.uuid +++ b/manifest.uuid @@ -1 +1 @@ -122330dba3eb2492875bd02a46442306f73e251408447af5e5914ee0c8d6a110 \ No newline at end of file +789a492b68c353e2b763d67d399722b7ab61bfe09b472466df2821f65cab1be9 \ No newline at end of file diff --git a/src/tclsqlite.c b/src/tclsqlite.c index eb3bedf9d4..1b0086c7d5 100644 --- a/src/tclsqlite.c +++ b/src/tclsqlite.c @@ -93,6 +93,14 @@ typedef struct SqliteDb SqliteDb; /* ** New SQL functions can be created as TCL scripts. Each such function ** is described by an instance of the following structure. +** +** Variable eType may be set to SQLITE_INTEGER, SQLITE_FLOAT, SQLITE_TEXT, +** SQLITE_BLOB or SQLITE_NULL. If it is SQLITE_NULL, then the implementation +** attempts to determine the type of the result based on the Tcl object. +** If it is SQLITE_TEXT or SQLITE_BLOB, then a text (sqlite3_result_text()) +** or blob (sqlite3_result_blob()) is returned. If it is SQLITE_INTEGER +** or SQLITE_FLOAT, then an attempt is made to return an integer or float +** value, falling back to float and then text if this is not possible. */ typedef struct SqlFunc SqlFunc; struct SqlFunc { @@ -100,6 +108,7 @@ struct SqlFunc { Tcl_Obj *pScript; /* The Tcl_Obj representation of the script */ SqliteDb *pDb; /* Database connection that owns this function */ int useEvalObjv; /* True if it is safe to use Tcl_EvalObjv */ + int eType; /* Type of value to return */ char *zName; /* Name of this function */ SqlFunc *pNext; /* Next function on the list of them all */ }; @@ -995,27 +1004,54 @@ static void tclSqlFunc(sqlite3_context *context, int argc, sqlite3_value**argv){ u8 *data; const char *zType = (pVar->typePtr ? pVar->typePtr->name : ""); char c = zType[0]; - if( c=='b' && strcmp(zType,"bytearray")==0 && pVar->bytes==0 ){ - /* 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); - }else if( c=='b' && strcmp(zType,"boolean")==0 ){ - Tcl_GetIntFromObj(0, pVar, &n); - sqlite3_result_int(context, n); - }else if( c=='d' && strcmp(zType,"double")==0 ){ - double r; - Tcl_GetDoubleFromObj(0, pVar, &r); - sqlite3_result_double(context, r); - }else if( (c=='w' && strcmp(zType,"wideInt")==0) || - (c=='i' && strcmp(zType,"int")==0) ){ - Tcl_WideInt v; - Tcl_GetWideIntFromObj(0, pVar, &v); - sqlite3_result_int64(context, v); - }else{ - data = (unsigned char *)Tcl_GetStringFromObj(pVar, &n); - sqlite3_result_text(context, (char *)data, n, SQLITE_TRANSIENT); + int eType = p->eType; + + if( eType==SQLITE_NULL ){ + if( c=='b' && strcmp(zType,"bytearray")==0 && pVar->bytes==0 ){ + /* Only return a BLOB type if the Tcl variable is a bytearray and + ** has no string representation. */ + eType = SQLITE_BLOB; + }else if( (c=='b' && strcmp(zType,"boolean")==0) + || (c=='w' && strcmp(zType,"wideInt")==0) + || (c=='i' && strcmp(zType,"int")==0) + ){ + eType = SQLITE_INTEGER; + }else if( c=='d' && strcmp(zType,"double")==0 ){ + eType = SQLITE_FLOAT; + }else{ + eType = SQLITE_TEXT; + } } + + switch( eType ){ + case SQLITE_BLOB: { + data = Tcl_GetByteArrayFromObj(pVar, &n); + sqlite3_result_blob(context, data, n, SQLITE_TRANSIENT); + break; + } + case SQLITE_INTEGER: { + Tcl_WideInt v; + if( TCL_OK==Tcl_GetWideIntFromObj(0, pVar, &v) ){ + sqlite3_result_int64(context, v); + break; + } + /* fall-through */ + } + case SQLITE_FLOAT: { + double r; + if( TCL_OK==Tcl_GetDoubleFromObj(0, pVar, &r) ){ + sqlite3_result_double(context, r); + break; + } + /* fall-through */ + } + default: { + data = (unsigned char *)Tcl_GetStringFromObj(pVar, &n); + sqlite3_result_text(context, (char *)data, n, SQLITE_TRANSIENT); + break; + } + } + } } @@ -2646,6 +2682,7 @@ deserialize_error: char *zName; int nArg = -1; int i; + int eType = SQLITE_NULL; if( objc<4 ){ Tcl_WrongNumArgs(interp, 2, objv, "NAME ?SWITCHES? SCRIPT"); return TCL_ERROR; @@ -2653,7 +2690,7 @@ deserialize_error: for(i=3; i<(objc-1); i++){ const char *z = Tcl_GetString(objv[i]); int n = strlen30(z); - if( n>2 && strncmp(z, "-argcount",n)==0 ){ + if( n>1 && strncmp(z, "-argcount",n)==0 ){ if( i==(objc-2) ){ Tcl_AppendResult(interp, "option requires an argument: ", z,(char*)0); return TCL_ERROR; @@ -2666,11 +2703,25 @@ deserialize_error: } i++; }else - if( n>2 && strncmp(z, "-deterministic",n)==0 ){ + if( n>1 && strncmp(z, "-deterministic",n)==0 ){ flags |= SQLITE_DETERMINISTIC; + }else + if( n>1 && strncmp(z, "-returntype", n)==0 ){ + const char *azType[] = {"integer", "real", "text", "blob", "any", 0}; + assert( SQLITE_INTEGER==1 && SQLITE_FLOAT==2 && SQLITE_TEXT==3 ); + assert( SQLITE_BLOB==4 && SQLITE_NULL==5 ); + if( i==(objc-2) ){ + Tcl_AppendResult(interp, "option requires an argument: ", z,(char*)0); + return TCL_ERROR; + } + i++; + if( Tcl_GetIndexFromObj(interp, objv[i], azType, "type", 0, &eType) ){ + return TCL_ERROR; + } + eType++; }else{ Tcl_AppendResult(interp, "bad option \"", z, - "\": must be -argcount or -deterministic", (char*)0 + "\": must be -argcount, -deterministic or -returntype", (char*)0 ); return TCL_ERROR; } @@ -2686,6 +2737,7 @@ deserialize_error: pFunc->pScript = pScript; Tcl_IncrRefCount(pScript); pFunc->useEvalObjv = safeToUseEvalObjv(interp, pScript); + pFunc->eType = eType; rc = sqlite3_create_function(pDb->db, zName, nArg, flags, pFunc, tclSqlFunc, 0, 0); if( rc!=SQLITE_OK ){ diff --git a/test/tclsqlite.test b/test/tclsqlite.test index 36063bc46d..4a674a8f24 100644 --- a/test/tclsqlite.test +++ b/test/tclsqlite.test @@ -21,6 +21,7 @@ catch {sqlite3} set testdir [file dirname $argv0] source $testdir/tester.tcl +set testprefix tcl # Check the error messages generated by tclsqlite # @@ -711,8 +712,84 @@ do_test tcl-16.103 { set res } {1 {a b *} 2 {a *} 3 {a b *}} +#------------------------------------------------------------------------- +# Test the -type option to [db function]. +# +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_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 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 +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) ); +} {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) ); +} {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) ); +} {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') ); +} {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') ); +} {'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') ); +} {'abc' 'abc' 'abc' X'616263' X'616263'} + +do_test 17.6.1 { + list [catch { db function xyz -return object ret } msg] $msg +} {1 {bad type "object": must be integer, real, text, blob, or any}} + +do_test 17.6.2 { + list [catch { db function xyz -return ret } msg] $msg +} {1 {option requires an argument: -return}} + +do_test 17.6.3 { + list [catch { db function xyz -n object ret } msg] $msg +} {1 {bad option "-n": must be -argcount, -deterministic or -returntype}} finish_test +