From: danielk1977 Date: Fri, 7 Sep 2007 18:40:38 +0000 (+0000) Subject: Modify test_thread.c to use tcl apis for creating threads. (CVS 4415) X-Git-Tag: version-3.6.10~1762 X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=570f7e25058bb853f0d556b911b766560c13de30;p=thirdparty%2Fsqlite.git Modify test_thread.c to use tcl apis for creating threads. (CVS 4415) FossilOrigin-Name: 9b7bab7fc28201b62159e959651acb980095ad06 --- diff --git a/manifest b/manifest index 043cbc4b15..a1b2e9b9e7 100644 --- 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 569710b85c..0cfaf344c9 100644 --- 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 14fcfb5424..c2c26e1cce 100644 --- 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 -#include #include #include @@ -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 aca04e7729..309951426d 100644 --- 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 }