/ Check-in [99dcba1f]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:In the TCL interface, user-defined functions preserve the datatype returned by the Tcl procedure. (CVS 2453)
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:99dcba1fb1fdaa2b8bc85046b00c14f6af596e8f
User & Date: drh 2005-05-05 10:30:30
Context
2005-05-05
11:04
Fix a datatype in trigger6.test that changed due to the previous check-in. (CVS 2454) check-in: c2af7d2c user: drh tags: trunk
10:30
In the TCL interface, user-defined functions preserve the datatype returned by the Tcl procedure. (CVS 2453) check-in: 99dcba1f user: drh tags: trunk
2005-05-03
12:30
Make sure all data structures have 8-byte alignment - necessary for the sparc architecture and helpful on other 64-bit platforms. Ticket #1232. Also update some comments in build.c. (CVS 2452) check-in: d9418851 user: drh tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to src/tclsqlite.c.

7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
...
267
268
269
270
271
272
273
274

275
276
277
278







279














280
281
282
283
284
285
286
**    May you do good and not evil.
**    May you find forgiveness for yourself and forgive others.
**    May you share freely, never taking more than you give.
**
*************************************************************************
** A TCL Interface to SQLite
**
** $Id: tclsqlite.c,v 1.123 2005/04/28 19:03:37 drh Exp $
*/
#ifndef NO_TCL     /* Omit this whole file if TCL is unavailable */

#include "sqliteInt.h"
#include "hash.h"
#include "tcl.h"
#include <stdlib.h>
................................................................................
  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]));
    }
  }
  rc = Tcl_Eval(p->interp, Tcl_DStringValue(&cmd));

  if( rc ){
    sqlite3_result_error(context, Tcl_GetStringResult(p->interp), -1); 
  }else{
    sqlite3_result_text(context, Tcl_GetStringResult(p->interp), -1, 







        SQLITE_TRANSIENT);














  }
}

#ifndef SQLITE_OMIT_AUTHORIZATION
/*
** This is the authentication function.  It appends the authentication
** type code and the two arguments to zCmd[] then invokes the result







|







 







|
>
|


<
>
>
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>







7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
...
267
268
269
270
271
272
273
274
275
276
277
278

279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
**    May you do good and not evil.
**    May you find forgiveness for yourself and forgive others.
**    May you share freely, never taking more than you give.
**
*************************************************************************
** A TCL Interface to SQLite
**
** $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 */

#include "sqliteInt.h"
#include "hash.h"
#include "tcl.h"
#include <stdlib.h>
................................................................................
  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]));
    }
  }
  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{

    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);
    }
  }
}

#ifndef SQLITE_OMIT_AUTHORIZATION
/*
** This is the authentication function.  It appends the authentication
** type code and the two arguments to zCmd[] then invokes the result

Changes to test/tclsqlite.test.

11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
...
313
314
315
316
317
318
319
320
















321
# This file implements regression tests for TCL interface to the
# SQLite library. 
#
# Actually, all tests are based on the TCL interface, so the main
# 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 $

set testdir [file dirname $argv0]
source $testdir/tester.tcl

# Check the error messages generated by tclsqlite
#
if {[sqlite3 -has-codec]} {
................................................................................
  db nullvalue NULL
  db nullvalue
} {NULL}
do_test tcl-8.3 {
  db nullvalue {}
  db eval {SELECT * FROM t1 WHERE b IS NULL}
} {30 {}}

















finish_test







|







 








>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>

11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
...
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
# This file implements regression tests for TCL interface to the
# SQLite library. 
#
# Actually, all tests are based on the TCL interface, so the main
# 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 $

set testdir [file dirname $argv0]
source $testdir/tester.tcl

# Check the error messages generated by tclsqlite
#
if {[sqlite3 -has-codec]} {
................................................................................
  db nullvalue NULL
  db nullvalue
} {NULL}
do_test tcl-8.3 {
  db nullvalue {}
  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