Modify test_thread.c to use tcl apis for creating threads. (CVS 4415)

FossilOrigin-Name: 9b7bab7fc28201b62159e959651acb980095ad06

diff --git a/manifest b/manifest
index 043cbc4b1548603a0cafaab4236d7b4773b16e01..a1b2e9b9e7685fff7df57dbdb0b9c98ad6bd1924 100644 (file)
--- a/manifest
+++ b/manifest
@@ -1,5 +1,5 @@
-C Fix\sa\ssegfault\sthat\scould\soccur\swhile\sattempting\sto\sadd\snew\spages\nto\sthe\sfreelist\sin\sa\scorrupt\sdatabase.\s(CVS\s4414)
-D 2007-09-07T14:32:07
+C Modify\stest_thread.c\sto\suse\stcl\sapis\sfor\screating\sthreads.\s(CVS\s4415)
+D 2007-09-07T18:40:38
 F Makefile.in cbfb898945536a8f9ea8b897e1586dd1fdbcc5db
 F Makefile.linux-gcc 65241babba6faf1152bf86574477baab19190499
 F README 9c4e2d6706bdcc3efdd773ce752a8cdab4f90028
@@ -156,7 +156,7 @@ F src/test_md5.c 34599caee5b1c73dcf86ca31f55846fab8c19ef7
 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/test_thread.c 35d2b6c83b18cc32961e868a7e784e9eed6c94e9
 F src/tokenize.c 67e42600ab34f976f2b1288c499ad6c98d652f0e
 F src/trigger.c 724a77d54609a33bde90618934fbeddfcc729a10
 F src/update.c e89b980b443d44b68bfc0b1746cdb6308e049ac9
@@ -425,7 +425,7 @@ F test/tableapi.test 036575a98dcce7c92e9f39056839bbad8a715412
 F test/tclsqlite.test a868898e3350246be7ea132621dc25f9835b3030
 F test/temptable.test c36f3e5a94507abb64f7ba23deeb4e1a8a8c3821
 F test/tester.tcl 913a808f05b0aed2fbb16481a423b1a5a118bdf0
-F test/thread001.test 055549cedc3676524616a6773f3683933c8a3b79
+F test/thread001.test 52ea6333672d4b6d11a637be45582a0154a838b5
 F test/thread1.test 776c9e459b75ba905193b351926ac4019b049f35
 F test/thread2.test 6d7b30102d600f51b4055ee3a5a19228799049fb
 F test/threadtest1.c 6029d9c5567db28e6dc908a0c63099c3ba6c383b
@@ -573,7 +573,7 @@ F www/tclsqlite.tcl 8be95ee6dba05eabcd27a9d91331c803f2ce2130
 F www/vdbe.tcl 87a31ace769f20d3627a64fa1fade7fed47b90d0
 F www/version3.tcl 890248cf7b70e60c383b0e84d77d5132b3ead42b
 F www/whentouse.tcl fc46eae081251c3c181bd79c5faef8195d7991a5
-P 753908e8411024abd5c3da1b8c62f70e35f8734d
-R 694839393b8154b22df691b07855d693
-U drh
-Z 118daf76b8bcf6c5ec13879a5aaee9dc
+P c8e85fff7ede68f0b8c8ebfe3df4b26a630abeff
+R 1c41a07b5897b4a4264246e1ebf2d37e
+U danielk1977
+Z b47c168066a48c0e00e09af99f60172e

diff --git a/manifest.uuid b/manifest.uuid
index 569710b85c07db16fffbdbf1bdac4c8420e70579..0cfaf344c98591ecfae7453cacd1b18071a5e304 100644 (file)
--- a/manifest.uuid
+++ b/manifest.uuid
@@ -1 +1 @@
-c8e85fff7ede68f0b8c8ebfe3df4b26a630abeff
\ No newline at end of file
+9b7bab7fc28201b62159e959651acb980095ad06
\ No newline at end of file

diff --git a/src/test_thread.c b/src/test_thread.c
index 14fcfb542463a398e929ad1fd8c9ab495224b3f2..c2c26e1cce20da52cdf044df62cbfc5f542edfcd 100644 (file)
--- a/src/test_thread.c
+++ b/src/test_thread.c
@@ -14,14 +14,14 @@
 ** 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 $
+** $Id: test_thread.c,v 1.2 2007/09/07 18:40:38 danielk1977 Exp $
 */
 
 #include "sqliteInt.h"
-#if defined(OS_UNIX) && SQLITE_THREADSAFE
+
+#if SQLITE_THREADSAFE && defined(TCL_THREADS)
 
 #include <tcl.h>
-#include <pthread.h>
 #include <errno.h>
 #include <unistd.h>
 
@@ -30,26 +30,70 @@
 */
 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 */
+  Tcl_ThreadId parent;     /* Thread id of parent thread */
+  Tcl_Interp *interp;      /* Parent interpreter */
+  char *zScript;           /* The script to execute. */
+  char *zVarname;          /* Varname in parent script */
 };
 
-typedef struct SqlParent SqlParent;
-struct SqlParent {
-  Tcl_Interp *interp;
-  int fd;
+/*
+** A custom Tcl_Event type used by this module. When the event is
+** handled, script zScript is evaluated in interpreter interp. If
+** the evaluation throws an exception (returns TCL_ERROR), then the
+** error is handled by Tcl_BackgroundError(). If no error occurs,
+** the result is simply discarded.
+*/
+typedef struct EvalEvent EvalEvent;
+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;
+int Sqlitetest1_Init(Tcl_Interp *);
 
-static void *tclScriptThread(void *pSqlThread){
-  Tcl_Interp *interp;
-  Tcl_Obj *pRes;
-  Tcl_Obj *pList;
+/*
+** Handler for events of type EvalEvent.
+*/
+static int tclScriptEvent(Tcl_Event *evPtr, int flags){
+  int rc;
+  EvalEvent *p = (EvalEvent *)evPtr;
+  rc = Tcl_Eval(p->interp, p->zScript);
+  if( rc!=TCL_OK ){
+    Tcl_BackgroundError(p->interp);
+  }
+  return 1;
+}
 
+/*
+** Register an EvalEvent to evaluate the script pScript in the
+** parent interpreter/thread of SqlThread p.
+*/
+static void postToParent(SqlThread *p, Tcl_Obj *pScript){
+  EvalEvent *pEvent;
   char *zMsg;
   int nMsg;
+
+  zMsg = Tcl_GetStringFromObj(pScript, &nMsg); 
+  pEvent = (EvalEvent *)ckalloc(sizeof(EvalEvent)+nMsg+1);
+  pEvent->base.nextPtr = 0;
+  pEvent->base.proc = tclScriptEvent;
+  pEvent->zScript = (char *)&pEvent[1];
+  memcpy(pEvent->zScript, zMsg, nMsg+1);
+  pEvent->interp = p->interp;
+
+  Tcl_ThreadQueueEvent(p->parent, (Tcl_Event *)pEvent, TCL_QUEUE_TAIL);
+  Tcl_ThreadAlert(p->parent);
+}
+
+/*
+** The main function for threads created with [sqlthread spawn].
+*/
+static Tcl_ThreadCreateType tclScriptThread(ClientData pSqlThread){
+  Tcl_Interp *interp;
+  Tcl_Obj *pRes;
+  Tcl_Obj *pList;
   int rc;
 
   SqlThread *p = (SqlThread *)pSqlThread;
@@ -62,6 +106,7 @@ static void *tclScriptThread(void *pSqlThread){
   pRes = Tcl_GetObjResult(interp);
   pList = Tcl_NewObj();
   Tcl_IncrRefCount(pList);
+  Tcl_IncrRefCount(pRes);
 
   if( rc==TCL_OK ){
     Tcl_ListObjAppendElement(interp, pList, Tcl_NewStringObj("set", -1));
@@ -71,32 +116,13 @@ static void *tclScriptThread(void *pSqlThread){
   }
   Tcl_ListObjAppendElement(interp, pList, pRes);
 
-  zMsg = Tcl_GetStringFromObj(pList, &nMsg); 
-  write(p->fd, zMsg, nMsg+1);
-  close(p->fd);
-  sqlite3_free(p);
+  postToParent(p, pList);
+
+  ckfree((void *)p);
   Tcl_DecrRefCount(pList);
+  Tcl_DecrRefCount(pRes);
   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);
-    }
-  }
+  return;
 }
 
 /*
@@ -115,62 +141,37 @@ static int sqlthread_spawn(
   int objc,
   Tcl_Obj *CONST objv[]
 ){
-  pthread_t x;
+  Tcl_ThreadId x;
   SqlThread *pNew;
-  SqlParent *pParent;
-  int fds[2];
   int rc;
 
   int nVarname; char *zVarname;
   int nScript; char *zScript;
 
+  /* Parameters for thread creation */
+  const int nStack = TCL_THREAD_STACK_DEFAULT;
+  const int flags = TCL_THREAD_NOFLAGS;
+
   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 = (SqlThread *)ckalloc(sizeof(SqlThread)+nVarname+nScript+2);
   pNew->zVarname = (char *)&pNew[1];
   pNew->zScript = (char *)&pNew->zVarname[nVarname+1];
   memcpy(pNew->zVarname, zVarname, nVarname+1);
   memcpy(pNew->zScript, zScript, nScript+1);
+  pNew->parent = Tcl_GetCurrentThread();
+  pNew->interp = interp;
 
-  pParent = (SqlParent *)sqlite3_malloc(sizeof(SqlParent));
-  if( pParent==0 ){
-    Tcl_AppendResult(interp, "Malloc failure", 0);
+  rc = Tcl_CreateThread(&x, tclScriptThread, (void *)pNew, nStack, flags);
+  if( rc!=TCL_OK ){
+    Tcl_AppendResult(interp, "Error in Tcl_CreateThread()", 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;
 }
 
@@ -185,13 +186,13 @@ static int sqlthread_spawn(
 **
 **     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[]
 ){
+  EvalEvent *pEvent;
   char *zMsg;
   int nMsg;
   SqlThread *p = (SqlThread *)clientData;
@@ -203,11 +204,17 @@ static int sqlthread_parent(
   }
 
   zMsg = Tcl_GetStringFromObj(objv[2], &nMsg);
-  write(p->fd, zMsg, nMsg+1);
+  pEvent = (EvalEvent *)ckalloc(sizeof(EvalEvent)+nMsg+1);
+  pEvent->base.nextPtr = 0;
+  pEvent->base.proc = tclScriptEvent;
+  pEvent->zScript = (char *)&pEvent[1];
+  memcpy(pEvent->zScript, zMsg, nMsg+1);
+  pEvent->interp = p->interp;
+  Tcl_ThreadQueueEvent(p->parent, (Tcl_Event *)pEvent, TCL_QUEUE_TAIL);
+  Tcl_ThreadAlert(p->parent);
 
   return TCL_OK;
 }
-#endif
 
 /*
 ** Dispatch routine for the sub-commands of [sqlthread].
@@ -224,9 +231,7 @@ static int sqlthread_proc(
     int nArg;
     char *zUsage;
   } aSub[] = {
-#if 0
     {"parent", sqlthread_parent, 1, "SCRIPT"},
-#endif
     {"spawn",  sqlthread_spawn,  2, "VARNAME SCRIPT"},
     {0, 0, 0}
   };
@@ -240,7 +245,7 @@ static int sqlthread_proc(
   }
 
   rc = Tcl_GetIndexFromObjStruct(
-       interp, objv[1], aSub, sizeof(aSub[0]), "sub-command", 0, &iIndex
+      interp, objv[1], aSub, sizeof(aSub[0]), "sub-command", 0, &iIndex
   );
   if( rc!=TCL_OK ) return rc;
   pSub = &aSub[iIndex];

diff --git a/test/thread001.test b/test/thread001.test
index aca04e7729245937dfcbe3eceb0d853c359c9e6b..309951426dd37002e66188fce348ada4506aae3f 100644 (file)
--- a/test/thread001.test
+++ b/test/thread001.test
@@ -9,13 +9,16 @@
 #
 #***********************************************************************
 #
-# $Id: thread001.test,v 1.1 2007/09/07 11:29:25 danielk1977 Exp $
+# $Id: thread001.test,v 1.2 2007/09/07 18:40:38 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"
+  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
 }
@@ -64,14 +67,22 @@ set thread_program [format {
     set res
   }
 
+  proc do_test {name script result} {
+    set res [eval $script]
+    if {$res ne $result} {
+      error "$name failed: expected \"$result\" got \"$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"}
+    do_test t1 {
+      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}
 
     # Add another row to the database.
     execsql { INSERT INTO ab SELECT NULL, md5sum(a, b) FROM ab }