From e5ced1c96d6213766cd6263eddcab12ba1a916a9 Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 17 Apr 2012 13:49:46 +0000 Subject: Restore the tcl_platform(threaded) variable. --- ChangeLog | 7 ------- generic/tclBasic.c | 11 +++++++++++ tests/platform.test | 2 ++ 3 files changed, 13 insertions(+), 7 deletions(-) diff --git a/ChangeLog b/ChangeLog index 668108b..96f8d1e 100644 --- a/ChangeLog +++ b/ChangeLog @@ -34,13 +34,6 @@ * library/dde/pkgIndex.tcl Use [::tcl::pkgconfig get debug] instead * library/reg/pkgIndex.tcl of [info exists ::tcl_platform(debug)] - ***POTENTIAL INCOMPATIBILITY*** - The variables $tcl_platform(debug) and $tcl_platform(threaded) no - longer exist. They don't belong in the tcl_platform array, were never - documented, disturbed the platform-1.1 test, $tcl_platform(debug) was - only available on Windows anyway, and TIP #59 provides a much better - alternative. - 2012-04-10 Donal K. Fellows * generic/tcl.h (TCL_DEPRECATED_API): [Bug 2458976]: Added macro that diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 21fb2e2..e09ea1e 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -928,6 +928,17 @@ Tcl_CreateInterp(void) TclPrecTraceProc, NULL); TclpSetVariables(interp); +#ifdef TCL_THREADS + /* + * The existence of the "threaded" element of the tcl_platform array + * indicates that this particular Tcl shell has been compiled with threads + * turned on. Using "info exists tcl_platform(threaded)" a Tcl script can + * introspect on the interpreter level of thread safety. + */ + + Tcl_SetVar2(interp, "tcl_platform", "threaded", "1", TCL_GLOBAL_ONLY); +#endif + /* * Register Tcl's version number. * TIP #268: Full patchlevel instead of just major.minor diff --git a/tests/platform.test b/tests/platform.test index 33c96ba..8cb8dcd 100644 --- a/tests/platform.test +++ b/tests/platform.test @@ -18,6 +18,8 @@ testConstraint testWinCPUID [llength [info commands testwincpuid]] test platform-1.1 {TclpSetVariables: tcl_platform} { interp create i + i eval {catch {unset tcl_platform(debug)}} + i eval {catch {unset tcl_platform(threaded)}} set result [i eval {lsort [array names tcl_platform]}] interp delete i set result -- cgit v0.12