In the TCL interface, user-defined functions preserve the datatype returned

by the Tcl procedure. (CVS 2453)

FossilOrigin-Name: 99dcba1fb1fdaa2b8bc85046b00c14f6af596e8f

diff --git a/manifest b/manifest
index 0e4c9fd7278ced27e4e428db5a26155a72f479f3..5eebe868ae258c4948f0f3bec8f273fc35bb891e 100644 (file)
--- a/manifest
+++ b/manifest
@@ -1,5 +1,5 @@
-C Make\ssure\sall\sdata\sstructures\shave\s8-byte\salignment\s-\snecessary\sfor\sthe\nsparc\sarchitecture\sand\shelpful\son\sother\s64-bit\splatforms.\s\sTicket\s#1232.\nAlso\supdate\ssome\scomments\sin\sbuild.c.\s(CVS\s2452)
-D 2005-05-03T12:30:34
+C In\sthe\sTCL\sinterface,\suser-defined\sfunctions\spreserve\sthe\sdatatype\sreturned\nby\sthe\sTcl\sprocedure.\s(CVS\s2453)
+D 2005-05-05T10:30:30
 F Makefile.in 5c00d0037104de2a50ac7647a5f12769795957a3
 F Makefile.linux-gcc 06be33b2a9ad4f005a5f42b22c4a19dab3cbb5c7
 F README 9c4e2d6706bdcc3efdd773ce752a8cdab4f90028
@@ -63,7 +63,7 @@ F src/shell.c 25b3217d7c64e6497225439d261a253a23efff26
 F src/sqlite.h.in 3675e3ada207e09b9d52a0463561325df4ac26b5
 F src/sqliteInt.h 7123b9d5632d7eaab90cf595c83c89521ea1c3b6
 F src/table.c 25b3ff2b39b7d87e8d4a5da0713d68dfc06cbee9
-F src/tclsqlite.c d56821995513b2d68fa8c4a66ec2fbdfe615d8b7
+F src/tclsqlite.c ebdf626f28b2025ac9dac5bce7a206d059c27690
 F src/test1.c 4ad7ffe5a74fd99d4f73f6fd28ba27f403b3adba
 F src/test2.c 7f0ef466706ac01414e1136b96e5d8a65cb97545
 F src/test3.c 683e1e3819152ffd35da2f201e507228921148d0
@@ -193,7 +193,7 @@ F test/subquery.test 6274cce7617bc7f625490759cbe4f0c0eef24895
 F test/subselect.test 3f3f7a940dc3195c3139f4d530385cb54665d614
 F test/table.test e87fb2211b97c6a3a367fbc116e8572091b53160
 F test/tableapi.test 6a66d58b37d46dc0f2b3c7d4bd2617d209399bd1
-F test/tclsqlite.test 7112be2a9d0d70c8767b9b2c748bf39d407a6aba
+F test/tclsqlite.test 7593733310c1d89f0b63c84fb155104ad948135c
 F test/temptable.test c71eeffe8af807f76eafdc5a39824639a1e301df
 F test/tester.tcl 69c0dc1accaf0ff26bff62b33e13590a4ecba17d
 F test/thread1.test 776c9e459b75ba905193b351926ac4019b049f35
@@ -279,7 +279,7 @@ F www/tclsqlite.tcl 425be741b8ae664f55cb1ef2371aab0a75109cf9
 F www/vdbe.tcl 87a31ace769f20d3627a64fa1fade7fed47b90d0
 F www/version3.tcl a99cf5f6d8bd4d5537584a2b342f0fb9fa601d8b
 F www/whentouse.tcl 528299b8316726dbcc5548e9aa0648c8b1bd055b
-P 535523e1be692adc940d256a7b3d23c62a4cc947
-R a72ac68975ae652f87834c74a143990a
+P d9418851cebc1605d8d62aad7987c0d61a905e81
+R cc12eb94118d09818ed72970e80aadcb
 U drh
-Z bc2beeb96490a6d1f455c1c7be0e1755
+Z a8e499380f6d4d0850b3a88c9fa43f3f

diff --git a/manifest.uuid b/manifest.uuid
index 5647fba6663f13b591de5bce64748d7148c06bf2..3538ed1a840380a2f3e96de007e649611dc61b76 100644 (file)
--- a/manifest.uuid
+++ b/manifest.uuid
@@ -1 +1 @@
-d9418851cebc1605d8d62aad7987c0d61a905e81
\ No newline at end of file
+99dcba1fb1fdaa2b8bc85046b00c14f6af596e8f
\ No newline at end of file

diff --git a/src/tclsqlite.c b/src/tclsqlite.c
index 3f76bdae6ddf0fdb9b5c767d3f389f04a319b596..bc23cc9b4b6b105d46d0aacb5df25d0869c5b568 100644 (file)
--- a/src/tclsqlite.c
+++ b/src/tclsqlite.c
@@ -11,7 +11,7 @@
 *************************************************************************
 ** A TCL Interface to SQLite
 **
-** $Id: tclsqlite.c,v 1.123 2005/04/28 19:03:37 drh Exp $
+** $Id: tclsqlite.c,v 1.124 2005/05/05 10:30:30 drh Exp $
 */
 #ifndef NO_TCL     /* Omit this whole file if TCL is unavailable */
 
@@ -271,12 +271,33 @@ static void tclSqlFunc(sqlite3_context *context, int argc, sqlite3_value**argv){
       Tcl_DStringAppendElement(&cmd, sqlite3_value_text(argv[i]));
     }
   }
-  rc = Tcl_Eval(p->interp, Tcl_DStringValue(&cmd));
-  if( rc ){
+  rc = Tcl_EvalEx(p->interp, Tcl_DStringValue(&cmd), Tcl_DStringLength(&cmd),
+                  TCL_EVAL_DIRECT);
+  if( rc && rc!=TCL_RETURN ){
     sqlite3_result_error(context, Tcl_GetStringResult(p->interp), -1); 
   }else{
-    sqlite3_result_text(context, Tcl_GetStringResult(p->interp), -1, 
-        SQLITE_TRANSIENT);
+    Tcl_Obj *pVar = Tcl_GetObjResult(p->interp);
+    int n;
+    u8 *data;
+    char *zType = pVar->typePtr ? pVar->typePtr->name : "";
+    char c = zType[0];
+    if( c=='b' && strcmp(zType,"bytearray")==0 ){
+      data = Tcl_GetByteArrayFromObj(pVar, &n);
+      sqlite3_result_blob(context, data, n, SQLITE_TRANSIENT);
+      Tcl_IncrRefCount(pVar);
+    }else if( (c=='b' && strcmp(zType,"boolean")==0) ||
+          (c=='i' && strcmp(zType,"int")==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{
+      data = Tcl_GetStringFromObj(pVar, &n);
+      sqlite3_result_text(context, data, n, SQLITE_TRANSIENT);
+      Tcl_IncrRefCount(pVar);
+    }
   }
 }
 

diff --git a/test/tclsqlite.test b/test/tclsqlite.test
index 69c995254b9171607d199d31faecb02e84402213..b98dfa1ae19b9732139f19486e133ba0879c8421 100644 (file)
--- 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.39 2005/04/03 23:54:45 danielk1977 Exp $
+# $Id: tclsqlite.test,v 1.40 2005/05/05 10:30:30 drh Exp $
 
 set testdir [file dirname $argv0]
 source $testdir/tester.tcl
@@ -318,4 +318,20 @@ do_test tcl-8.3 {
   db eval {SELECT * FROM t1 WHERE b IS NULL}
 } {30 {}}
 
+# Test the return type of user-defined functions
+#
+do_test tcl-9.1 {
+  db function ret_str {return "hi"}
+  execsql {SELECT typeof(ret_str())}
+} {text}
+do_test tcl-9.2 {
+  db function ret_dbl {return [expr {[clock seconds]*0.5}]}
+  execsql {SELECT typeof(ret_dbl())}
+} {real}
+do_test tcl-9.3 {
+  db function ret_int {clock seconds}
+  execsql {SELECT typeof(ret_int())}
+} {integer}
+
+
 finish_test