Add the "-returntype" option to the "db function" Tcl method.

FossilOrigin-Name: 789a492b68c353e2b763d67d399722b7ab61bfe09b472466df2821f65cab1be9

diff --git a/manifest b/manifest
index 91e378ed90afb45a8a850a29606f8d8e5e61c874..331c3ed6ecdb5fe8b630d27d965bcfd152005196 100644 (file)
--- 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 042a028addd231767697a905c3adf9e0ecbaf263..a8da48124d364a8908b76d4ba7a048bee4b49042 100644 (file)
--- 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 eb3bedf9d4cbae38a516361f6d88dd687628bef3..1b0086c7d532265465f34f3b5a735522a763b2cd 100644 (file)
--- 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 36063bc46d03b5f1862fe13c319b58cb383693c8..4a674a8f2426aabf701c7f2cbacbe65f805fa4b0 100644 (file)
--- 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
+