SQLite

**
*************************************************************************
**
** 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.8 2008/08/28 13:55:10 danielk1977 Exp $
*/

#include "sqliteInt.h"
#include <tcl.h>

#if SQLITE_THREADSAFE && defined(TCL_THREADS)

struct EvalEvent {
  Tcl_Event base;          /* Base class of type Tcl_Event */
  char *zScript;           /* The script to execute. */
  Tcl_Interp *interp;      /* The interpreter to execute it in. */
};

static Tcl_ObjCmdProc sqlthread_proc;
static Tcl_ObjCmdProc clock_seconds_proc;
int Sqlitetest1_Init(Tcl_Interp *);

/*
** Handler for events of type EvalEvent.
*/
static int tclScriptEvent(Tcl_Event *evPtr, int flags){
  int rc;

  Tcl_Obj *pRes;
  Tcl_Obj *pList;
  int rc;

  SqlThread *p = (SqlThread *)pSqlThread;

  interp = Tcl_CreateInterp();
  Tcl_CreateObjCommand(interp, "clock_seconds", clock_seconds_proc, 0, 0);
  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);

  memcpy(pNew->zScript, zScript, nScript+1);
  pNew->parent = Tcl_GetCurrentThread();
  pNew->interp = interp;

  rc = Tcl_CreateThread(&x, tclScriptThread, (void *)pNew, nStack, flags);
  if( rc!=TCL_OK ){
    Tcl_AppendResult(interp, "Error in Tcl_CreateThread()", 0);
    ckfree((char *)pNew);
    return TCL_ERROR;
  }

  return TCL_OK;
}

/*

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

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

/*
** The [clock_seconds] command. This is more or less the same as the
** regular tcl [clock seconds], except that it is available in testfixture
** when linked against both Tcl 8.4 and 8.5. Because [clock seconds] is
** implemented as a script in Tcl 8.5, it is not usually available to
** testfixture.
*/ 
static int clock_seconds_proc(
  ClientData clientData,
  Tcl_Interp *interp,
  int objc,
  Tcl_Obj *CONST objv[]
){
  Tcl_Time now;
  Tcl_GetTime(&now);
  Tcl_SetObjResult(interp, Tcl_NewIntObj(now.sec));
  return TCL_OK;
}

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

#    May you share freely, never taking more than you give.
#
#***********************************************************************
#
#   This file contains tests that attempt to break the pcache module
#   by bombarding it with simultaneous requests from multiple threads.
#     
# $Id: thread003.test,v 1.3 2008/08/28 13:55:10 danielk1977 Exp $

set testdir [file dirname $argv0]

source $testdir/tester.tcl
source $testdir/thread_common.tcl
if {[info commands sqlthread] eq ""} {
  finish_test

# failure may eventually occur.
#
set nSecond 30
puts "Starting thread003.2 (should run for ~$nSecond seconds)"
do_test thread003.2 {
  foreach zFile {test.db test2.db} {
    set SCRIPT [format {

      set iEnd [expr {[clock_seconds] + %d}]
      set ::DB [sqlthread open %s]
  
      # Set the cache size to 15 pages per cache. 30 available globally.
      execsql { PRAGMA cache_size = 15 }
  
      while {[clock_seconds] < $iEnd} {
        set iQuery [expr {int(rand()*5000)}]
        execsql " SELECT * FROM t1 WHERE a = $iQuery "
      }
  
      sqlite3_close $::DB
      expr 1
    } $nSecond $zFile]

# opportunity for a thread-related bug to present itself.
#
set nSecond 30
puts "Starting thread003.3 (should run for ~$nSecond seconds)"
do_test thread003.3 {
  foreach zFile {test.db test2.db} {
    set SCRIPT [format {
      set iStart [clock_seconds]
      set iEnd [expr {[clock_seconds] + %d}]
      set ::DB [sqlthread open %s]
  
      # Set the cache size to 15 pages per cache. 30 available globally.
      execsql { PRAGMA cache_size = 15 }
  
      while {[clock_seconds] < $iEnd} {
        set iQuery [expr {int(rand()*5000)}]
        execsql "SELECT * FROM t1 WHERE a = $iQuery"
        execsql "UPDATE t1 SET b = randomblob(200) 
                 WHERE a < $iQuery AND a > $iQuery + 20
        "
      }
  

# The other thread does not have a database connection, but calls
# sqlite3_release_memory() over and over again.
#
set nSecond 30
puts "Starting thread003.3 (should run for ~$nSecond seconds)"
do_test thread003.4 {
  thread_spawn finished(1) $thread_procs [format {
    set iEnd [expr {[clock_seconds] + %d}]
    set ::DB [sqlthread open test.db]

    # Set the cache size to 15 pages per cache. 30 available globally.
    execsql { PRAGMA cache_size = 15 }

    while {[clock_seconds] < $iEnd} {
      set iQuery [expr {int(rand()*5000)}]
      execsql "SELECT * FROM t1 WHERE a = $iQuery"
    }

    sqlite3_close $::DB
    expr 1
  } $nSecond] 
  thread_spawn finished(2) [format {
    set iEnd [expr {[clock_seconds] + %d}]

    while {[clock_seconds] < $iEnd} {
      sqlite3_release_memory 1000
    }
  } $nSecond]
  
  foreach ii {1 2} {
    if {![info exists finished($ii)]} {
      vwait finished($ii)