-C Modify\sthe\sCLI\sso\sthat\sit\swill\signore\swhitespace\sat\sthe\send\sof\slines.\nTicket\s#2631\s(CVS\s4412)
-D 2007-09-07T01:12:32
+C Add\sthe\sbeginning\sof\sthe\sthread-safety\stests.\sThere\sare\smore\sto\scome.\s(CVS\s4413)
+D 2007-09-07T11:29:25
F Makefile.in cbfb898945536a8f9ea8b897e1586dd1fdbcc5db
F Makefile.linux-gcc 65241babba6faf1152bf86574477baab19190499
F README 9c4e2d6706bdcc3efdd773ce752a8cdab4f90028
F ext/icu/icu.c 61a345d8126686aa3487aa8d2d0f68abd655f7a4
F install-sh 9d4de14ab9fb0facae2f48780b874848cbf2f895
F ltmain.sh 56abb507100ed2d4261f6dd1653dec3cf4066387
-F main.mk 236865e8cb89db59b913ee4b28326e67dfda3c53
+F main.mk e38d91102a2f8b70898e2817fe02aa656a02cb58
F mkdll.sh 37fa8a7412e51b5ab2bc6d4276135f022a0feffb
F mkextu.sh 416f9b7089d80e5590a29692c9d9280a10dbad9f
F mkextw.sh 1a866b53637dab137191341cc875575a5ca110fb
F src/sqliteInt.h bb126b074352ef0ee20399883172161baf5eead2
F src/sqliteLimit.h 1bcbbdfa856f8b71b561abb31edb864b0eca1d12
F src/table.c 1aeb9eab57b4235db86fe15a35dec76fb445a9c4
-F src/tclsqlite.c 8c970b4cdc615dfc0726abb470a06d285ed336fb
+F src/tclsqlite.c c3f864a9891aa32b0d65dcda4c50784c047c5a0a
F src/test1.c 738f9b4ab808dcfec1516ef699c416e3f4f1d119
F src/test2.c 77b34303883b9d722c65a6879bb0163a400e3789
F src/test3.c 63e49781476f95e6167b441bf98b93392938a850
F src/test_schema.c 12c9de7661d6294eec2d57afbb52e2af1128084f
F src/test_server.c 1020673fc02ba5bbfa5dc96ded9f54f0f3744d38
F src/test_tclvar.c b2d1115e4d489179d3f029e765211b2ad527ba59
+F src/test_thread.c 489c79089b5ad56f20de932465cb58e8a534d67a
F src/tokenize.c 67e42600ab34f976f2b1288c499ad6c98d652f0e
F src/trigger.c 724a77d54609a33bde90618934fbeddfcc729a10
F src/update.c e89b980b443d44b68bfc0b1746cdb6308e049ac9
F test/tclsqlite.test a868898e3350246be7ea132621dc25f9835b3030
F test/temptable.test c36f3e5a94507abb64f7ba23deeb4e1a8a8c3821
F test/tester.tcl 913a808f05b0aed2fbb16481a423b1a5a118bdf0
+F test/thread001.test 055549cedc3676524616a6773f3683933c8a3b79
F test/thread1.test 776c9e459b75ba905193b351926ac4019b049f35
F test/thread2.test 6d7b30102d600f51b4055ee3a5a19228799049fb
F test/threadtest1.c 6029d9c5567db28e6dc908a0c63099c3ba6c383b
F www/vdbe.tcl 87a31ace769f20d3627a64fa1fade7fed47b90d0
F www/version3.tcl 890248cf7b70e60c383b0e84d77d5132b3ead42b
F www/whentouse.tcl fc46eae081251c3c181bd79c5faef8195d7991a5
-P 4881f7cb37e35dcf5da358464ac858a508128e47
-R ce40876ae34e300aa8df8df02cc80ba8
-U drh
-Z 704732809c269e991b0391352c5618d9
+P f780a17f4b0e679479c2b368d8659a0ee61c343d
+R e4d6e8dadc7d65c050f265cc5a051321
+U danielk1977
+Z 57428b4bd8d43ba4be46844bba20292d
--- /dev/null
+/*
+** 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
+
--- /dev/null
+# 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
+