SQLite

  $(TOP)/src/test_config.c \
  $(TOP)/src/test_hexio.c \
  $(TOP)/src/test_malloc.c \
  $(TOP)/src/test_md5.c \
  $(TOP)/src/test_schema.c \
  $(TOP)/src/test_server.c \
  $(TOP)/src/test_tclvar.c \
  $(TOP)/src/test_thread.c \

TESTSRC += $(TOP)/ext/fts2/fts2_tokenizer.c
TESTSRC += $(TOP)/ext/fts3/fts3_tokenizer.c

TESTSRC2 = \
  $(TOP)/src/attach.c $(TOP)/src/btree.c $(TOP)/src/build.c $(TOP)/src/date.c  \
  $(TOP)/src/expr.c $(TOP)/src/func.c $(TOP)/src/insert.c $(TOP)/src/os.c      \

**    May you find forgiveness for yourself and forgive others.
**    May you share freely, never taking more than you give.
**
*************************************************************************
** A TCL Interface to SQLite.  Append this file to sqlite3.c and
** compile the whole thing to build a TCL-enabled version of SQLite.
**
** $Id: tclsqlite.c,v 1.202 2007/09/07 11:29:25 danielk1977 Exp $
*/
#include "tcl.h"
#include <errno.h>

/*
** Some additional include files are needed if this file is not
** appended to the amalgamation.

    extern int Sqlitetestasync_Init(Tcl_Interp*);
    extern int Sqlitetest_autoext_Init(Tcl_Interp*);
    extern int Sqlitetest_hexio_Init(Tcl_Interp*);
    extern int Sqlitetest_malloc_Init(Tcl_Interp*);
    extern int Sqlitetestschema_Init(Tcl_Interp*);
    extern int Sqlitetestsse_Init(Tcl_Interp*);
    extern int Sqlitetesttclvar_Init(Tcl_Interp*);
    extern int SqlitetestThread_Init(Tcl_Interp*);

    Md5_Init(interp);
    Sqliteconfig_Init(interp);
    Sqlitetest1_Init(interp);
    Sqlitetest2_Init(interp);
    Sqlitetest3_Init(interp);
    Sqlitetest4_Init(interp);
    Sqlitetest5_Init(interp);
    Sqlitetest6_Init(interp);
    Sqlitetest7_Init(interp);
    Sqlitetest8_Init(interp);
    Sqlitetest9_Init(interp);
    Sqlitetestasync_Init(interp);
    Sqlitetest_autoext_Init(interp);
    Sqlitetest_hexio_Init(interp);
    Sqlitetest_malloc_Init(interp);
    Sqlitetestschema_Init(interp);
    Sqlitetesttclvar_Init(interp);
    SqlitetestThread_Init(interp);
#ifdef SQLITE_SSE
    Sqlitetestsse_Init(interp);
#endif
  }
#endif
  if( argc>=2 || TCLSH==2 ){
    int i;

/*
** 2007 September 9
**
** 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.
**
*************************************************************************
**
** This file contains the implementation of some Tcl commands used to
** test that sqlite3 database handles may be concurrently accessed by 
** multiple threads. Right now this only works on unix.
**
** $Id: test_thread.c,v 1.1 2007/09/07 11:29:25 danielk1977 Exp $
*/

#include "sqliteInt.h"
#if defined(OS_UNIX) && SQLITE_THREADSAFE

#include <tcl.h>
#include <pthread.h>
#include <errno.h>
#include <unistd.h>

/*
** One of these is allocated for each thread created by [sqlthread spawn].
*/
typedef struct SqlThread SqlThread;
struct SqlThread {
  int fd;            /* The pipe to send commands to the parent */
  char *zScript;     /* The script to execute. */
  char *zVarname;    /* Varname in parent script */
};

typedef struct SqlParent SqlParent;
struct SqlParent {
  Tcl_Interp *interp;
  int fd;
};

static Tcl_ObjCmdProc sqlthread_proc;

static void *tclScriptThread(void *pSqlThread){
  Tcl_Interp *interp;
  Tcl_Obj *pRes;
  Tcl_Obj *pList;

  char *zMsg;
  int nMsg;
  int rc;

  SqlThread *p = (SqlThread *)pSqlThread;

  interp = Tcl_CreateInterp();
  Tcl_CreateObjCommand(interp, "sqlthread", sqlthread_proc, pSqlThread, 0);
  Sqlitetest1_Init(interp);

  rc = Tcl_Eval(interp, p->zScript);
  pRes = Tcl_GetObjResult(interp);
  pList = Tcl_NewObj();
  Tcl_IncrRefCount(pList);

  if( rc==TCL_OK ){
    Tcl_ListObjAppendElement(interp, pList, Tcl_NewStringObj("set", -1));
    Tcl_ListObjAppendElement(interp, pList, Tcl_NewStringObj(p->zVarname, -1));
  }else{
    Tcl_ListObjAppendElement(interp, pList, Tcl_NewStringObj("error", -1));
  }
  Tcl_ListObjAppendElement(interp, pList, pRes);

  zMsg = Tcl_GetStringFromObj(pList, &nMsg); 
  write(p->fd, zMsg, nMsg+1);
  close(p->fd);
  sqlite3_free(p);
  Tcl_DecrRefCount(pList);
  Tcl_DeleteInterp(interp);

  return 0;
}

void pipe_callback(ClientData clientData, int flags){
  SqlParent *p = (SqlParent *)clientData;
  char zBuf[1024];
  int nChar;

  nChar = read(p->fd, zBuf, 1023);
  if( nChar<=0 ){
    /* Other end has been closed */
    Tcl_DeleteFileHandler(p->fd);
    sqlite3_free(p);
  }else{
    zBuf[1023] = '\0';
    if( TCL_OK!=Tcl_Eval(p->interp, zBuf) ){
      Tcl_BackgroundError(p->interp);
    }
  }
}

/*
** sqlthread spawn VARNAME SCRIPT
**
**     Spawn a new thread with it's own Tcl interpreter and run the
**     specified SCRIPT(s) in it. The thread terminates after running
**     the script. The result of the script is stored in the variable
**     VARNAME.
**
**     The caller can wait for the script to terminate using [vwait VARNAME].
*/
static int sqlthread_spawn(
  ClientData clientData,
  Tcl_Interp *interp,
  int objc,
  Tcl_Obj *CONST objv[]
){
  pthread_t x;
  SqlThread *pNew;
  SqlParent *pParent;
  int fds[2];
  int rc;

  int nVarname; char *zVarname;
  int nScript; char *zScript;

  assert(objc==4);

  zVarname = Tcl_GetStringFromObj(objv[2], &nVarname);
  zScript = Tcl_GetStringFromObj(objv[3], &nScript);
  pNew = (SqlThread *)sqlite3_malloc(sizeof(SqlThread)+nVarname+nScript+2);
  if( pNew==0 ){
    Tcl_AppendResult(interp, "Malloc failure", 0);
    return TCL_ERROR;
  }
  pNew->zVarname = (char *)&pNew[1];
  pNew->zScript = (char *)&pNew->zVarname[nVarname+1];
  memcpy(pNew->zVarname, zVarname, nVarname+1);
  memcpy(pNew->zScript, zScript, nScript+1);

  pParent = (SqlParent *)sqlite3_malloc(sizeof(SqlParent));
  if( pParent==0 ){
    Tcl_AppendResult(interp, "Malloc failure", 0);
    sqlite3_free(pNew);
    return TCL_ERROR;
  }

  rc = pipe(fds);
  if( rc!=0 ){
    Tcl_AppendResult(interp, "Error in pipe(): ", strerror(errno), 0);
    sqlite3_free(pNew);
    sqlite3_free(pParent);
    return TCL_ERROR;
  }

  pParent->fd = fds[0];
  pParent->interp = interp;
  Tcl_CreateFileHandler(
      fds[0], TCL_READABLE|TCL_EXCEPTION, pipe_callback, (void *)pParent
  );

  pNew->fd = fds[1];
  rc = pthread_create(&x, 0, tclScriptThread, (void *)pNew);
  if( rc!=0 ){
    Tcl_AppendResult(interp, "Error in pthread_create(): ", strerror(errno), 0);
    Tcl_DeleteFileHandler(fds[0]);
    sqlite3_free(pNew);
    sqlite3_free(pParent);
    close(fds[0]);
    close(fds[1]);
    return TCL_ERROR;
  }

  return TCL_OK;
}

/*
** sqlthread parent SCRIPT
**
**     This can be called by spawned threads only. It sends the specified
**     script back to the parent thread for execution. The result of
**     evaluating the SCRIPT is returned. The parent thread must enter
**     the event loop for this to work - otherwise the caller will
**     block indefinitely.
**
**     NOTE: At the moment, this doesn't work. FIXME.
*/
#if 0
static int sqlthread_parent(
  ClientData clientData,
  Tcl_Interp *interp,
  int objc,
  Tcl_Obj *CONST objv[]
){
  char *zMsg;
  int nMsg;
  SqlThread *p = (SqlThread *)clientData;

  assert(objc==3);
  if( p==0 ){
    Tcl_AppendResult(interp, "no parent thread", 0);
    return TCL_ERROR;
  }

  zMsg = Tcl_GetStringFromObj(objv[2], &nMsg);
  write(p->fd, zMsg, nMsg+1);

  return TCL_OK;
}
#endif

/*
** Dispatch routine for the sub-commands of [sqlthread].
*/
static int sqlthread_proc(
  ClientData clientData,
  Tcl_Interp *interp,
  int objc,
  Tcl_Obj *CONST objv[]
){
  struct SubCommand {
    char *zName;
    Tcl_ObjCmdProc *xProc;
    int nArg;
    char *zUsage;
  } aSub[] = {
#if 0
    {"parent", sqlthread_parent, 1, "SCRIPT"},
#endif
    {"spawn",  sqlthread_spawn,  2, "VARNAME SCRIPT"},
    {0, 0, 0}
  };
  struct SubCommand *pSub;
  int rc;
  int iIndex;

  if( objc<2 ){
    Tcl_WrongNumArgs(interp, 1, objv, "SUB-COMMAND");
    return TCL_ERROR;
  }

  rc = Tcl_GetIndexFromObjStruct(
       interp, objv[1], aSub, sizeof(aSub[0]), "sub-command", 0, &iIndex
  );
  if( rc!=TCL_OK ) return rc;
  pSub = &aSub[iIndex];

  if( objc!=(pSub->nArg+2) ){
    Tcl_WrongNumArgs(interp, 2, objv, pSub->zUsage);
    return TCL_ERROR;
  }

  return pSub->xProc(clientData, interp, objc, objv);
}

/*
** Register commands with the TCL interpreter.
*/
int SqlitetestThread_Init(Tcl_Interp *interp){
  Tcl_CreateObjCommand(interp, "sqlthread", sqlthread_proc, 0, 0);
  return TCL_OK;
}
#else
int SqlitetestThread_Init(Tcl_Interp *interp){
  return TCL_OK;
}
#endif

# 2007 September 7
#
# 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.
#
#***********************************************************************
#
# $Id: thread001.test,v 1.1 2007/09/07 11:29:25 danielk1977 Exp $

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

if {[info commands sqlthread] eq ""} {
  puts "Skipping thread-safety tests - not running a threadsafe unix build"
  finish_test
  return
}

# Set up a database and a schema. The database contains a single
# table with two columns. The first column ("a") is an INTEGER PRIMARY 
# KEY. The second contains the md5sum of all rows in the table with
# a smaller value stored in column "a".
#
do_test thread001.1 {
  execsql {
    CREATE TABLE ab(a INTEGER PRIMARY KEY, b);
    CREATE INDEX ab_i ON ab(b);
    INSERT INTO ab SELECT NULL, md5sum(a, b) FROM ab;
    SELECT count(*) FROM ab;
  }
} {1}
do_test thread001.2 {
  execsql {
    SELECT 
      (SELECT md5sum(a, b) FROM ab WHERE a < (SELECT max(a) FROM ab)) ==
      (SELECT b FROM ab WHERE a = (SELECT max(a) FROM ab))
  }
} {1}
do_test thread001.3 {
  execsql { PRAGMA integrity_check }
} {ok}

set thread_program [format {
  set ::DB %s

  # Execute the supplied SQL using database handle $::DB.
  #
  proc execsql {sql} {
    set res [list]
    set ::STMT [sqlite3_prepare $::DB $sql -1 dummy_tail]
    while {[sqlite3_step $::STMT] eq "SQLITE_ROW"} {
      for {set i 0} {$i < [sqlite3_column_count $::STMT]} {incr i} {
        lappend res [sqlite3_column_text $::STMT 0]
      }
    }
    set rc [sqlite3_finalize $::STMT]
    if {$rc ne "SQLITE_OK"} {
      error [sqlite3_errmsg $::DB]
    }
    set res
  }

  for {set i 0} {$i < 100} {incr i} {
    # Test that the invariant is true.
    set val [execsql {
      SELECT 
        (SELECT md5sum(a, b) FROM ab WHERE a < (SELECT max(a) FROM ab)) ==
        (SELECT b FROM ab WHERE a = (SELECT max(a) FROM ab))
    }]
    if {$val ne "1"} {error "Invariant test failed"}

    # Add another row to the database.
    execsql { INSERT INTO ab SELECT NULL, md5sum(a, b) FROM ab }
  }

  list OK
} [sqlite3_connection_pointer db]]

# Kick off 10 threads:
#
array unset finished
for {set i 0} {$i < 10} {incr i} {
  sqlthread spawn finished($i) $thread_program
}

for {set i 0} {$i < 10} {incr i} {
  if {![info exists finished($i)]} {
    vwait finished($i)
  }
  do_test thread001.4.$i {
    set ::finished($i)
  } OK
}

do_test thread001.5 {
  execsql { SELECT count(*) FROM ab; }
} {1001}
do_test thread001.6 {
  execsql {
    SELECT 
      (SELECT md5sum(a, b) FROM ab WHERE a < (SELECT max(a) FROM ab)) ==
      (SELECT b FROM ab WHERE a = (SELECT max(a) FROM ab))
  }
} {1}
do_test thread001.7 {
  execsql { PRAGMA integrity_check }
} {ok}

# Give the event-handlers a chance to close any open parent-child pipes.
# Otherwise, the test is reported as leaking memory (it has not - it's 
# just that the memory is freed asynchronously).
#
after 250 {set abit 0}
vwait abit

finish_test