SQLite

/*
** 2001 September 15
**
** The author disclaims copyright to this source code.  In place of
** a legal notice, here is a blessing:
**
**    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

# 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