Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
Comment: | Merge in thread::cancel support |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | trunk |
Files: | files | file ages | folders |
SHA1: |
f23bc2edae6bb42a4ca28a6b7e6b37b6 |
User & Date: | dgp 2011-11-01 15:07:50 |
Context
2011-11-18
| ||
01:17 | Update all remaining versions to 2.7b1. For [thread::cancel], avoid creating a new Tcl_Obj when the default script cancellation result is desired. Stop using -debug:full as it causes an error with the MSVC10 compiler. check-in: d893efb569 user: mistachkin tags: trunk | |
2011-11-01
| ||
15:07 | Merge in thread::cancel support check-in: f23bc2edae user: dgp tags: trunk | |
15:07 | Merge in bug fixes and finalization support check-in: 6067508840 user: dgp tags: trunk | |
2011-10-28
| ||
15:33 | Test suite tolerate the existence of the [thread::cancel] command Closed-Leaf check-in: ed8e983fc8 user: dgp tags: tip285 | |
Changes
Changes to doc/thread.man.
︙ | ︙ | |||
164 165 166 167 168 169 170 171 172 173 174 175 176 177 | invoked the [cmd thread::errorproc] command. The [arg procname] is called like this: [example { myerrorproc thread_id errorInfo }] [call [cmd thread::unwind]] Use of this command is deprecated in favour of more advanced thread reservation system implemented with [cmd thread::preserve] and [cmd thread::release] commands. Support for [cmd thread::unwind] command will dissapear in some future major release of the extension. [para] | > > > > > > > > > > > > > > > > | 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 | invoked the [cmd thread::errorproc] command. The [arg procname] is called like this: [example { myerrorproc thread_id errorInfo }] [call [cmd thread::cancel] [opt -unwind] [arg id] [opt result]] This command requires Tcl version 8.6 or higher. [para] Cancels the script being evaluated in the thread given by the [arg id] parameter. Without the [option -unwind] switch the evaluation stack for the interpreter is unwound until an enclosing catch command is found or there are no further invocations of the interpreter left on the call stack. With the [option -unwind] switch the evaluation stack for the interpreter is unwound without regard to any intervening catch command until there are no further invocations of the interpreter left on the call stack. If [arg result] is present, it will be used as the error message string; otherwise, a default error message string will be used. [call [cmd thread::unwind]] Use of this command is deprecated in favour of more advanced thread reservation system implemented with [cmd thread::preserve] and [cmd thread::release] commands. Support for [cmd thread::unwind] command will dissapear in some future major release of the extension. [para] |
︙ | ︙ |
Changes to generic/threadCmd.c.
︙ | ︙ | |||
21 22 23 24 25 26 27 28 29 30 31 32 33 34 | #include "tclThread.h" #ifdef NS_AOLSERVER # include "aolstub.cpp" #endif /* * Access to the list of threads and to the thread send results * (defined below) is guarded by this mutex. */ TCL_DECLARE_MUTEX(threadMutex) | > > > > > > > > > > | 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 | #include "tclThread.h" #ifdef NS_AOLSERVER # include "aolstub.cpp" #endif /* * Check if this is Tcl 8.6 or higher. In that case, we will have the TIP * #285 APIs (i.e. asynchronous script cancellation) available. */ #if (TCL_MAJOR_VERSION > 8) || \ ((TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION >= 6)) # define TCL_TIP285 #endif /* * Access to the list of threads and to the thread send results * (defined below) is guarded by this mutex. */ TCL_DECLARE_MUTEX(threadMutex) |
︙ | ︙ | |||
327 328 329 330 331 332 333 334 335 336 337 338 339 340 | static void ErrorNoSuchThread _ANSI_ARGS_((Tcl_Interp *interp, Tcl_ThreadId thrId)); static void ThreadCutChannel _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Channel channel)); /* * Functions implementing Tcl commands */ static Tcl_ObjCmdProc ThreadCreateObjCmd; static Tcl_ObjCmdProc ThreadReserveObjCmd; static Tcl_ObjCmdProc ThreadReleaseObjCmd; | > > > > > > > > | 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 | static void ErrorNoSuchThread _ANSI_ARGS_((Tcl_Interp *interp, Tcl_ThreadId thrId)); static void ThreadCutChannel _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Channel channel)); #ifdef TCL_TIP285 static int ThreadCancel _ANSI_ARGS_((Tcl_Interp *interp, Tcl_ThreadId thrId, const char *result, int flags)); #endif /* * Functions implementing Tcl commands */ static Tcl_ObjCmdProc ThreadCreateObjCmd; static Tcl_ObjCmdProc ThreadReserveObjCmd; static Tcl_ObjCmdProc ThreadReleaseObjCmd; |
︙ | ︙ | |||
348 349 350 351 352 353 354 355 356 357 358 359 360 361 | static Tcl_ObjCmdProc ThreadExistsObjCmd; static Tcl_ObjCmdProc ThreadConfigureObjCmd; static Tcl_ObjCmdProc ThreadErrorProcObjCmd; static Tcl_ObjCmdProc ThreadJoinObjCmd; static Tcl_ObjCmdProc ThreadTransferObjCmd; static Tcl_ObjCmdProc ThreadDetachObjCmd; static Tcl_ObjCmdProc ThreadAttachObjCmd; static int ThreadInit(interp) Tcl_Interp *interp; /* The current Tcl interpreter */ { Tcl_Obj *boolObjPtr; const char *msg; | > > > > | 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 | static Tcl_ObjCmdProc ThreadExistsObjCmd; static Tcl_ObjCmdProc ThreadConfigureObjCmd; static Tcl_ObjCmdProc ThreadErrorProcObjCmd; static Tcl_ObjCmdProc ThreadJoinObjCmd; static Tcl_ObjCmdProc ThreadTransferObjCmd; static Tcl_ObjCmdProc ThreadDetachObjCmd; static Tcl_ObjCmdProc ThreadAttachObjCmd; #ifdef TCL_TIP285 static Tcl_ObjCmdProc ThreadCancelObjCmd; #endif static int ThreadInit(interp) Tcl_Interp *interp; /* The current Tcl interpreter */ { Tcl_Obj *boolObjPtr; const char *msg; |
︙ | ︙ | |||
392 393 394 395 396 397 398 399 400 401 402 403 404 405 | TCL_CMD(interp, THREAD_CMD_PREFIX"errorproc", ThreadErrorProcObjCmd); TCL_CMD(interp, THREAD_CMD_PREFIX"preserve", ThreadReserveObjCmd); TCL_CMD(interp, THREAD_CMD_PREFIX"release", ThreadReleaseObjCmd); TCL_CMD(interp, THREAD_CMD_PREFIX"join", ThreadJoinObjCmd); TCL_CMD(interp, THREAD_CMD_PREFIX"transfer", ThreadTransferObjCmd); TCL_CMD(interp, THREAD_CMD_PREFIX"detach", ThreadDetachObjCmd); TCL_CMD(interp, THREAD_CMD_PREFIX"attach", ThreadAttachObjCmd); /* * Add shared variable commands */ Sv_Init(interp); | > > > > > > > > > > > > > > > > > > > | 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 | TCL_CMD(interp, THREAD_CMD_PREFIX"errorproc", ThreadErrorProcObjCmd); TCL_CMD(interp, THREAD_CMD_PREFIX"preserve", ThreadReserveObjCmd); TCL_CMD(interp, THREAD_CMD_PREFIX"release", ThreadReleaseObjCmd); TCL_CMD(interp, THREAD_CMD_PREFIX"join", ThreadJoinObjCmd); TCL_CMD(interp, THREAD_CMD_PREFIX"transfer", ThreadTransferObjCmd); TCL_CMD(interp, THREAD_CMD_PREFIX"detach", ThreadDetachObjCmd); TCL_CMD(interp, THREAD_CMD_PREFIX"attach", ThreadAttachObjCmd); #ifdef TCL_TIP285 { /* * This package may have been compiled against Tcl 8.6 or higher; * however, what if it is being loaded by Tcl 8.5 or lower? Perform * a version check now to stop using from trying to use the TIP #285 * functionality if it is not present. */ int major, minor; Tcl_GetVersion(&major, &minor, NULL, NULL); if (major > 8 || (major == 8 && minor >= 6)) { TCL_CMD(interp, THREAD_CMD_PREFIX"cancel", ThreadCancelObjCmd); } } #endif /* * Add shared variable commands */ Sv_Init(interp); |
︙ | ︙ | |||
1416 1417 1418 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428 1429 | return TCL_ERROR; } } return TCL_OK; } /* *---------------------------------------------------------------------- * * ThreadSendEval -- * * Evaluates Tcl script passed from source to target thread. * | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1457 1458 1459 1460 1461 1462 1463 1464 1465 1466 1467 1468 1469 1470 1471 1472 1473 1474 1475 1476 1477 1478 1479 1480 1481 1482 1483 1484 1485 1486 1487 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513 1514 1515 1516 1517 1518 1519 1520 1521 1522 1523 1524 1525 1526 1527 1528 | return TCL_ERROR; } } return TCL_OK; } #ifdef TCL_TIP285 /* *---------------------------------------------------------------------- * * ThreadCancelObjCmd -- * * This procedure is invoked to process the "thread::cancel" Tcl * command. See the user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ static int ThreadCancelObjCmd(dummy, interp, objc, objv) ClientData dummy; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int objc; /* Number of arguments. */ Tcl_Obj *const objv[]; /* Argument objects. */ { Tcl_ThreadId thrId; int ii, flags; const char *result; if ((objc < 2) || (objc > 4)) { Tcl_WrongNumArgs(interp, 1, objv, "?-unwind? id ?result?"); return TCL_ERROR; } flags = 0; ii = 1; if ((objc == 3) || (objc == 4)) { if (OPT_CMP(Tcl_GetString(objv[ii]), "-unwind")) { flags |= TCL_CANCEL_UNWIND; ii++; } } if (ThreadGetId(interp, objv[ii], &thrId) != TCL_OK) { return TCL_ERROR; } ii++; if (ii < objc) { result = Tcl_GetString(objv[ii]); } else { result = NULL; } return ThreadCancel(interp, thrId, result, flags); } #endif /* *---------------------------------------------------------------------- * * ThreadSendEval -- * * Evaluates Tcl script passed from source to target thread. * |
︙ | ︙ | |||
2031 2032 2033 2034 2035 2036 2037 2038 2039 2040 2041 2042 2043 2044 | if (tsdPtr->threadId == thrId) { return tsdPtr; } } return NULL; } /* *---------------------------------------------------------------------- * * ThreadJoin -- * * Wait for the exit of a different thread. | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 2130 2131 2132 2133 2134 2135 2136 2137 2138 2139 2140 2141 2142 2143 2144 2145 2146 2147 2148 2149 2150 2151 2152 2153 2154 2155 2156 2157 2158 2159 2160 2161 2162 2163 2164 2165 2166 2167 2168 2169 2170 2171 2172 2173 2174 2175 2176 2177 2178 2179 2180 2181 2182 2183 2184 2185 2186 | if (tsdPtr->threadId == thrId) { return tsdPtr; } } return NULL; } #ifdef TCL_TIP285 /* *---------------------------------------------------------------------- * * ThreadCancel -- * * Cancels a script in another thread. * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int ThreadCancel(interp, thrId, result, flags) Tcl_Interp *interp; /* The current interpreter. */ Tcl_ThreadId thrId; /* Thread ID of other interpreter. */ const char *result; /* The error message or NULL for default. */ int flags; /* Flags for Tcl_CancelEval. */ { ThreadSpecificData *tsdPtr = NULL; /* ... of the target thread */ Tcl_MutexLock(&threadMutex); tsdPtr = ThreadExistsInner(thrId); if (tsdPtr == (ThreadSpecificData*)NULL) { Tcl_MutexUnlock(&threadMutex); ErrorNoSuchThread(interp, thrId); return TCL_ERROR; } Tcl_MutexUnlock(&threadMutex); return Tcl_CancelEval(tsdPtr->interp, Tcl_NewStringObj(result, -1), 0, flags); } #endif /* *---------------------------------------------------------------------- * * ThreadJoin -- * * Wait for the exit of a different thread. |
︙ | ︙ |
Changes to tests/thread.test.
︙ | ︙ | |||
37 38 39 40 41 42 43 | } test thread-2.0 {no global thread command} { info commands thread } {} test thread-2.84 {thread subcommands} { | | > > | 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 | } test thread-2.0 {no global thread command} { info commands thread } {} test thread-2.84 {thread subcommands} { set cmds [info commands thread::*] set idx [lsearch -exact $cmds ::thread::cancel] lsort [lreplace $cmds $idx $idx] } {::thread::attach ::thread::broadcast ::thread::cond ::thread::configure ::thread::create ::thread::detach ::thread::errorproc ::thread::eval ::thread::exists ::thread::exit ::thread::id ::thread::join ::thread::mutex ::thread::names ::thread::preserve ::thread::release ::thread::rwmutex ::thread::send ::thread::transfer ::thread::unwind ::thread::wait} test thread-3.0 {thread::names initial thread list} { list [ThreadReap] [llength [thread::names]] } {1 1} test thread-4.0 {thread::create: create server thread} { |
︙ | ︙ |
Changes to win/vc/makefile.vc.
︙ | ︙ | |||
184 185 186 187 188 189 190 | PRJHEADERS = #------------------------------------------------------------------------- # Target names and paths ( shouldn't need changing ) #------------------------------------------------------------------------- BINROOT = . | | | 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 | PRJHEADERS = #------------------------------------------------------------------------- # Target names and paths ( shouldn't need changing ) #------------------------------------------------------------------------- BINROOT = . ROOT = ..\.. PRJIMPLIB = $(OUT_DIR)\$(PROJECT)$(VERSION)$(SUFX).lib PRJLIBNAME = $(PROJECT)$(VERSION)$(SUFX).$(EXT) PRJLIB = $(OUT_DIR)\$(PRJLIBNAME) PRJSTUBLIBNAME = $(STUBPREFIX)$(VERSION).lib PRJSTUBLIB = $(OUT_DIR)\$(PRJSTUBLIBNAME) |
︙ | ︙ |