From 024b92cb1e7bd2653beee2d010f1baf39010cacc Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 10 Jul 2012 18:28:48 +0000 Subject: [Bug 3541646] Don't panic on triggerPipe overrun --- ChangeLog | 4 ++++ unix/tclUnixNotfy.c | 10 +++++----- 2 files changed, 9 insertions(+), 5 deletions(-) diff --git a/ChangeLog b/ChangeLog index 8b8e49a..704fd06 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,7 @@ +2012-07-10 Jan Nijtmans + + * unix/tclUnixNotfy.c: [Bug 3541646] Don't panic on triggerPipe overrun + 2012-07-10 Donal K. Fellows * win/tclWinSock.c (InitializeHostName): Corrected logic that diff --git a/unix/tclUnixNotfy.c b/unix/tclUnixNotfy.c index 904c9db..42cc7be 100644 --- a/unix/tclUnixNotfy.c +++ b/unix/tclUnixNotfy.c @@ -340,7 +340,7 @@ Tcl_FinalizeNotifier( */ if (write(triggerPipe, "q", 1) != 1) { - Tcl_Panic("Tcl_FinalizeNotifier: unable to write q to triggerPipe"); + Tcl_Panic("Tcl_FinalizeNotifier: unable to write q to triggerPipe"); } close(triggerPipe); while(triggerPipe >= 0) { @@ -879,8 +879,8 @@ Tcl_WaitForEvent( waitingListPtr = tsdPtr; tsdPtr->onList = 1; - if (write(triggerPipe, "", 1) != 1) { - Tcl_Panic("Tcl_WaitForEvent: unable to write to triggerPipe"); + if ((write(triggerPipe, "", 1) == -1) && (errno != EAGAIN)) { + Tcl_Panic("Tcl_WaitForEvent: unable to write to triggerPipe"); } } @@ -942,8 +942,8 @@ Tcl_WaitForEvent( } tsdPtr->nextPtr = tsdPtr->prevPtr = NULL; tsdPtr->onList = 0; - if (write(triggerPipe, "", 1) != 1) { - Tcl_Panic("Tcl_WaitForEvent: unable to write to triggerPipe"); + if ((write(triggerPipe, "", 1) == -1) && (errno != EAGAIN)) { + Tcl_Panic("Tcl_WaitForEvent: unable to write to triggerPipe"); } } -- cgit v0.12 From c31e9810372c9b7fb8b61dd0840ed8f87ecf79f0 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 11 Jul 2012 19:24:12 +0000 Subject: [Bug #3362446]: registry keys command fails with 8.5/8.6. Follow Microsofts example better in order to prevent problems when using HKEY_PERFORMANCE_DATA. Forgot one important '%' --- ChangeLog | 6 ++++++ win/tclWinPipe.c | 2 +- win/tclWinReg.c | 2 +- 3 files changed, 8 insertions(+), 2 deletions(-) diff --git a/ChangeLog b/ChangeLog index 704fd06..aecbf9c 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,9 @@ +2012-07-11 Jan Nijtmans + + * win/tclWinReg.c: [Bug #3362446]: registry keys command fails + with 8.5/8.6. Follow Microsofts example better in order to prevent + problems when using HKEY_PERFORMANCE_DATA. + 2012-07-10 Jan Nijtmans * unix/tclUnixNotfy.c: [Bug 3541646] Don't panic on triggerPipe overrun diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c index 9a529d2..b6764d4 100644 --- a/win/tclWinPipe.c +++ b/win/tclWinPipe.c @@ -1707,7 +1707,7 @@ TclpCreateCommandChannel( * unique, in case channels share handles (stdin/stdout). */ - sprintf(channelName, "file" TCL_I_MODIFIER "x", (size_t)infoPtr); + sprintf(channelName, "file%" TCL_I_MODIFIER "x", (size_t)infoPtr); infoPtr->channel = Tcl_CreateChannel(&pipeChannelType, channelName, (ClientData) infoPtr, infoPtr->validMask); diff --git a/win/tclWinReg.c b/win/tclWinReg.c index 343a22f..a6ce2ce 100644 --- a/win/tclWinReg.c +++ b/win/tclWinReg.c @@ -794,7 +794,7 @@ GetValue( * HKEY_PERFORMANCE_DATA */ - length *= 2; + length = Tcl_DStringLength(&data) * (regWinProcs->useWide ? 1 : 2); Tcl_DStringSetLength(&data, (int) length * (regWinProcs->useWide ? 2 : 1)); result = (*regWinProcs->regQueryValueExProc)(key, (char *) nativeValue, NULL, &type, (BYTE *) Tcl_DStringValue(&data), &length); -- cgit v0.12 From 5cb86aa574bf8ab539797a9b908bb87db6e5b91e Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 16 Jul 2012 08:03:17 +0000 Subject: Make registry 1.3 package (and possibly others) dynamically loadable in Tcl 8.4 Reverted. No good reason to partially hack 8.5 features into (only one patch release of) 8.4. If you need to support Tcl 8.4, just don't use [tcl::pkgconfig]. If you're set on moving to [tcl::pkgconfig], then that's an 8.5 features and you're choosing to drop 8.4 support. --- ChangeLog | 5 +++++ library/init.tcl | 58 +++++++++++++++++++++++++++++++++++++------------------- tests/init.test | 9 ++++++--- 3 files changed, 50 insertions(+), 22 deletions(-) diff --git a/ChangeLog b/ChangeLog index de29b61..8ad896e 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,8 @@ +2012-07-16 Jan Nijtmans + + * library/init.tcl: Make registry 1.3 package (and possibly others) + * tests/init.test: dynamically loadable in Tcl 8.4. + 2012-07-05 Don Porter * unix/tclUnixPipe.c: [Bug 1189293] Make "<<" binary safe. diff --git a/library/init.tcl b/library/init.tcl index f2f85e1..4c4b6db 100644 --- a/library/init.tcl +++ b/library/init.tcl @@ -66,7 +66,7 @@ namespace eval tcl { } } } - + # Windows specific end of initialization if {(![interp issafe]) && $tcl_platform(platform) eq "windows"} { @@ -187,7 +187,7 @@ proc unknown args { # may get modified if caught errors occur below. The variables will # be restored just before re-executing the missing command. - # Safety check in case something unsets the variables + # Safety check in case something unsets the variables # ::errorInfo or ::errorCode. [Bug 1063707] if {![info exists errorCode]} { set errorCode "" @@ -222,7 +222,7 @@ proc unknown args { if {$code == 1} { # # Compute stack trace contribution from the [uplevel]. - # Note the dependence on how Tcl_AddErrorInfo, etc. + # Note the dependence on how Tcl_AddErrorInfo, etc. # construct the stack trace. # set cinfo $args @@ -340,7 +340,7 @@ proc unknown args { # library file to create the procedure. Returns 1 if it successfully # loaded the procedure, 0 otherwise. # -# Arguments: +# Arguments: # cmd - Name of the command to find and load. # namespace (optional) The namespace where the command is being used - must be # a canonical namespace as returned [namespace current] @@ -364,7 +364,7 @@ proc auto_load {cmd {namespace {}}} { # info commands $name # Unfortunately, if the name has glob-magic chars in it like * # or [], it may not match. For our purposes here, a better - # route is to use + # route is to use # namespace which -command $name if {[namespace which -command $name] ne ""} { return 1 @@ -395,7 +395,7 @@ proc auto_load {cmd {namespace {}}} { # of available commands. Returns 1 if the index is loaded, and 0 if # the index is already loaded and up to date. # -# Arguments: +# Arguments: # None. proc auto_load_index {} { @@ -424,7 +424,7 @@ proc auto_load_index {} { eval [read $f] } elseif {$id eq "# Tcl autoload index file: each line identifies a Tcl"} { while {[gets $f line] >= 0} { - if {[string index $line 0] eq "#" + if {[string index $line 0] eq "#" || ([llength $line] != 2)} { continue } @@ -484,7 +484,7 @@ proc auto_qualify {cmd namespace} { return [list [string range $cmd 2 end]] } } - + # Potentially returning 2 elements to try : # (if the current namespace is not the global one) @@ -542,13 +542,13 @@ proc auto_import {pattern} { # auto_execok -- # -# Returns string that indicates name of program to execute if +# Returns string that indicates name of program to execute if # name corresponds to a shell builtin or an executable in the -# Windows search path, or "" otherwise. Builds an associative -# array auto_execs that caches information about previous checks, +# Windows search path, or "" otherwise. Builds an associative +# array auto_execs that caches information about previous checks, # for speed. # -# Arguments: +# Arguments: # name - Name of a command. if {$tcl_platform(platform) eq "windows"} { @@ -603,7 +603,7 @@ proc auto_execok name { set path "[file dirname [info nameof]];.;" if {[info exists env(WINDIR)]} { - set windir $env(WINDIR) + set windir $env(WINDIR) } if {[info exists windir]} { if {$tcl_platform(os) eq "Windows NT"} { @@ -668,13 +668,13 @@ proc auto_execok name { # This procedure is called by Tcl's core when attempts to call the # filesystem's copydirectory function fail. The semantics of the call # are that 'dest' does not yet exist, i.e. dest should become the exact -# image of src. If dest does exist, we throw an error. -# +# image of src. If dest does exist, we throw an error. +# # Note that making changes to this procedure can change the results # of running Tcl's tests. # -# Arguments: -# action - "renaming" or "copying" +# Arguments: +# action - "renaming" or "copying" # src - source directory # dest - destination directory proc tcl::CopyDirectory {action src dest} { @@ -729,12 +729,12 @@ proc tcl::CopyDirectory {action src dest} { # Have to be careful to capture both visible and hidden files. # We will also be more generous to the file system and not # assume the hidden and non-hidden lists are non-overlapping. - # + # # On Unix 'hidden' files begin with '.'. On other platforms # or filesystems hidden files may have other interpretations. set filelist [concat [glob -nocomplain -directory $src *] \ [glob -nocomplain -directory $src -types hidden *]] - + foreach s [lsort -unique $filelist] { if {([file tail $s] ne ".") && ([file tail $s] ne "..")} { file copy $s [file join $dest [file tail $s]] @@ -742,3 +742,23 @@ proc tcl::CopyDirectory {action src dest} { } return } + +# ::tcl::pkgconfig -- +# +# This procedure is undocumented. It is meant to make the dde +# and registry packages distributed with Tcl 8.6 and the Thread +# 2.7 package (and possibly others) dynamically loadable in Tcl 8.4. +# +# Arguments: +# action - "get" +# key - "debug" or "threaded" +proc tcl::pkgconfig {{action {}} {key {}} args} { + if {$action eq "get"} { + if {$key eq "debug"} { + return [info exists ::tcl_platform(debug)] + } elseif {$key eq "threaded"} { + return [info exists ::tcl_platform(threaded)] + } + } + error {invalid command name "::tcl::pkgconfig"} +} diff --git a/tests/init.test b/tests/init.test index 79142c4..c46ba48 100644 --- a/tests/init.test +++ b/tests/init.test @@ -117,13 +117,11 @@ test init-2.6 {load setLogCmd from safe:: - stage 1} { rename ::safe::setLogCmd {} ; # should not fail } {} -test init-2.7 {oad setLogCmd from safe:: - stage 2} { +test init-2.7 {load setLogCmd from safe:: - stage 2} { namespace eval safe setLogCmd rename ::safe::setLogCmd {} ; # should not fail } {} - - test init-2.8 {load tcl::HistAdd} -setup { auto_reset catch {rename ::tcl::HistAdd {}} @@ -134,6 +132,11 @@ test init-2.8 {load tcl::HistAdd} -setup { rename ::tcl::HistAdd {} ; } -result {1 {wrong # args: should be "tcl:::HistAdd command ?exec?"}} +test init-2.9 {undocumented tcl::pkgconfig} -setup { +} -body { + list [catch {::tcl::pkgconfig} error] $error + } -cleanup { +} -result {1 {invalid command name "::tcl::pkgconfig"}} test init-3.0 {random stuff in the auto_index, should still work} { set auto_index(foo:::bar::blah) { -- cgit v0.12