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.4 2007/09/10 10:53:02 danielk1977 Exp $
*/

#include "sqliteInt.h"

#if SQLITE_THREADSAFE && defined(TCL_THREADS)

#include <tcl.h>

}

static int xBusy(void *pArg, int nBusy){
  sqlite3_sleep(50);
  return 1;             /* Try again... */
}

/*
** sqlthread open
**
**     Open a database handle and return the string representation of
**     the pointer value.
*/
static int sqlthread_open(
  ClientData clientData,
  Tcl_Interp *interp,
  int objc,
  Tcl_Obj *CONST objv[]
){
  int sqlite3TestMakePointerStr(Tcl_Interp *interp, char *zPtr, void *p);

  
  if( sqlite3TestMakePointerStr(interp, zBuf, db) ) return TCL_ERROR;
  Tcl_AppendResult(interp, zBuf, 0);

  return TCL_OK;
}


/*
** sqlthread open
**
**     Return the current thread-id (Tcl_GetCurrentThread()) cast to
**     an integer.
*/
static int sqlthread_id(
  ClientData clientData,
  Tcl_Interp *interp,
  int objc,
  Tcl_Obj *CONST objv[]
){
  Tcl_ThreadId id = Tcl_GetCurrentThread();
  Tcl_SetObjResult(interp, Tcl_NewIntObj((int)id));
  return TCL_OK;
}


/*
** 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[] = {
    {"parent", sqlthread_parent, 1, "SCRIPT"},
    {"spawn",  sqlthread_spawn,  2, "VARNAME SCRIPT"},
    {"open",   sqlthread_open,   1, "DBNAME"},
    {"id",     sqlthread_id,     0, ""},
    {0, 0, 0}
  };
  struct SubCommand *pSub;
  int rc;
  int iIndex;

  if( objc<2 ){

#
#    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 runs all tests.
#
# $Id: quick.test,v 1.63 2007/09/10 10:53:02 danielk1977 Exp $

proc lshift {lvar} {
  upvar $lvar l
  set ret [lindex $l 0]
  set l [lrange $l 1 end]
  return $ret
}

  misc7.test
  misuse.test
  quick.test
  soak.test
  speed1.test
  speed2.test
  sqllimits1.test

  thread001.test
  thread002.test

  incrvacuum_ioerr.test
  autovacuum_crash.test
  btree8.test
  utf16.test
  shared_err.test
  vtab_err.test

# 2007 September 10
#
# 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 test attempts to deadlock SQLite in shared-cache mode.
#     
#
# $Id: thread002.test,v 1.1 2007/09/10 10:53:02 danielk1977 Exp $

set testdir [file dirname $argv0]

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

db close
sqlite3_enable_shared_cache 1

set ::NTHREAD 10

do_test thread002.1 {
  # Create 3 databases with identical schemas:
  for {set ii 0} {$ii < 3} {incr ii} {
    file delete -force test${ii}.db
    sqlite3 db test${ii}.db
    execsql {
      CREATE TABLE t1(k, v);
      CREATE INDEX t1_i ON t1(v);
      INSERT INTO t1(v) VALUES(1.0);
    }
    db close
  }
} {}

set thread_program {
  set ::DB [sqlite3_open test.db]
  for {set ii 1} {$ii <= 3} {incr ii} {
    set T [lindex $order [expr $ii-1]]
    execsql "ATTACH 'test${T}.db' AS aux${ii}"
  }

  for {set ii 0} {$ii < 100} {incr ii} {
    execsql { SELECT * FROM aux1.t1 }
    execsql { INSERT INTO aux1.t1(v) SELECT sum(v) FROM aux2.t1 }
  
    execsql { SELECT * FROM aux2.t1 }
    execsql { INSERT INTO aux2.t1(v) SELECT sum(v) FROM aux3.t1 }
  
    execsql { SELECT * FROM aux3.t1 }
    execsql { INSERT INTO aux3.t1(v) SELECT sum(v) FROM aux1.t1 }

    execsql { CREATE TABLE aux1.t2(a,b) }
    execsql { DROP TABLE aux1.t2 }

    # if {($ii%10)==0} {puts -nonewline . ; flush stdout}
    puts -nonewline . ; flush stdout
  }

  sqlite3_close $::DB
  list OK
}

set order_list [list {0 1 2} {0 2 1} {1 0 2} {1 2 0} {2 0 1} {2 1 0}]

array unset finished
for {set ii 0} {$ii < $::NTHREAD} {incr ii} {
  set order [lindex $order_list [expr $ii%6]]
  thread_spawn finished($ii) $thread_procs "set order {$order}" $thread_program
}

# Wait for all threads to finish,  then check they all returned "OK".
#
for {set i 0} {$i < $::NTHREAD} {incr i} {
  if {![info exists finished($i)]} {
    vwait finished($i)
  }
  do_test thread001.2.$i {
    set ::finished($i)
  } OK
}

# Check all three databases are Ok.
for {set ii 0} {$ii < 3} {incr ii} {
  do_test thread002.3.$ii {
    sqlite3 db test${ii}.db
    set res [list                         \
      [execsql {SELECT count(*) FROM t1}] \
      [execsql {PRAGMA integrity_check}]  \
    ]
    db close
    set res
  } [list [expr 1 + $::NTHREAD*100] ok]
}

finish_test

# 2007 September 10
#
# 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: thread_common.tcl,v 1.2 2007/09/10 10:53:02 danielk1977 Exp $

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

if {[info commands sqlthread] eq ""} {
  puts -nonewline "Skipping thread-safety tests - "
  puts            " not running a threadsafe sqlite/tcl build"
  puts -nonewline "Both SQLITE_THREADSAFE and TCL_THREADS must be defined when"
  puts            " building testfixture"
  finish_test
  return
}



# The following script is sourced by every thread spawned using 
# [sqlthread spawn]:
set thread_procs {

  # Execute the supplied SQL using database handle $::DB.
  #
  proc execsql {sql} {

    set rc SQLITE_LOCKED
    while {$rc eq "SQLITE_LOCKED" 
        || $rc eq "SQLITE_BUSY" 
        || $rc eq "SQLITE_SCHEMA"} {
      set res [list]

      set err [catch {
        set ::STMT [sqlite3_prepare_v2 $::DB $sql -1 dummy_tail]
      } msg]

      if {$err == 0} {
        while {[set rc [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]
      } else {
        if {[string first (6) $msg]} {
          set rc SQLITE_LOCKED
        } else {
          set rc SQLITE_ERROR
        }
      }

      if {[string first locked [sqlite3_errmsg $::DB]]>=0} {
        set rc SQLITE_LOCKED
      }

      if {$rc eq "SQLITE_LOCKED" || $rc eq "SQLITE_BUSY"} {
 #puts -nonewline "([sqlthread id] $rc)"
 #flush stdout
        after 20
      }
    }

    if {$rc ne "SQLITE_OK"} {
      error "$rc - [sqlite3_errmsg $::DB]"
    }