diff options
-rw-r--r-- | ChangeLog | 29 | ||||
-rw-r--r-- | changes | 40 | ||||
-rw-r--r-- | doc/http.n | 6 | ||||
-rw-r--r-- | generic/tclBasic.c | 6 | ||||
-rw-r--r-- | generic/tclEvent.c | 55 | ||||
-rw-r--r-- | generic/tclExecute.c | 4 | ||||
-rw-r--r-- | generic/tclResult.c | 3 | ||||
-rw-r--r-- | tests/event.test | 65 | ||||
-rw-r--r-- | tests/expr.test | 20 | ||||
-rw-r--r-- | unix/dltest/Makefile.in | 4 |
10 files changed, 204 insertions, 28 deletions
@@ -1,3 +1,32 @@ +2008-03-10 Don Porter <dgp@users.sourceforge.net> + + * changes: Updated for 8.5.2 release. + + * doc/http.n: Revised to indicate that [package require http 2.5.5] + is needed to get all the documented commands ([http::meta]). + + * generic/tclEvent.c (TclDefaultBgErrorHandlerObjCmd): Added error + * tests/event.test (event-5.*): checking to protect against callers + passing invalid return options dictionaries. [Bug 1901113] + + * generic/tclBasic.c (ExprAbsFunc): Revised so that the abs() + * tests/expr.test: function and the [::tcl::mathfunc::abs] + command do not return the value of -0, or equivalent values with + more alarming string reps like -1e-350. [Bug 1893815]. + +2008-03-07 Andreas Kupries <andreask@activestate.com> + + * generic/tclResult.c (ReleaseKeys): Workaround for [Bug + 1904907]. Reset the return option keys to NULL to allow full + re-initialization by GetKeys(). This introduces a memory leak + for the key objects, but gets us around a crash in the + finalization of reflected channels when handling returns, either + at compile- or runtime. In both cases we access the keys after + they have been released by their thread exit handler. A proper + fix is entangled with the untangling of the finalization + ordering and attendant issues. For now we choose the lesser + evil. + 2008-03-07 Don Porter <dgp@users.sourceforge.net> * generic/tclExecute.c (Tcl_ExprObj): Revised expression bytecode @@ -1,6 +1,6 @@ Recent user-visible changes to Tcl: -RCS: @(#) $Id: changes,v 1.116.2.9 2008/03/07 22:05:01 dgp Exp $ +RCS: @(#) $Id: changes,v 1.116.2.10 2008/03/10 19:33:12 dgp Exp $ 1. No more [command1] [command2] construct for grouping multiple commands on a single command line. @@ -7129,3 +7129,41 @@ Several documentation and release notes improvements Several documentation and release notes improvements --- Released 8.5.1, February 5, 2008 --- See ChangeLog for details --- + +2008-02-06 (enhancement) [clock format] performance (kenny) + +2008-02-12 (bug fix)[1891827] compiled [switch -nocase] error (fellows) + +2008-02-22 (bug fix)[1818565] missing state array in http::status (thoyts) +=> http 2.5.4 + +2008-02-26 (bug fix)[1868845] corrected [eof] ordering (thoyts) + +2008-02-26 (new feature) [http::meta] command (thoyts) +=> http 2.5.5 + +2008-02-26 (bug fix)[1902436] fixed regexps ending in \* (hobbs) + +2008-02-27 (bug fix)[1862555,1902423] [clock] range & l10n (kenny) + +2008-02-28 (bug fix) [return -level 0] memory leak (porter) + +2008-02-28 (bug fix) [format %llx $big] memory leak (porter) + +2008-02-28 (bug fix) expression parser error message memory leak (porter) + +2008-02-28 (bug fix) memory leak when enter trace modifies command (porter) + +2008-02-29 (enhancement) Consumer refcounting for Tcl_SetReturnOptions() +and Tcl_AddObjToErrorInfo() (spjuth,porter) + *** POTENTIAL INCOMPATIBILITY *** + +2008-03-07 (bug fix)[1899164] Avoid expr and script bytecode confusion (porter) + +2008-03-07 (bug fix)[1904907] finalize crash in Tcl_GetReturnOptions (kupries) + +2008-03-10 (bug fix)[1893815] expr {abs(-1e-350)} => -0.0 (porter) + +2008-03-10 (bug fix)[1901113] crash in [tcl::Bgerror {} {}] (madden,porter) + +--- Released 8.5.2, March 14, 2008 --- See ChangeLog for details --- @@ -6,16 +6,16 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: http.n,v 1.24.2.3 2008/03/07 22:05:01 dgp Exp $ +'\" RCS: @(#) $Id: http.n,v 1.24.2.4 2008/03/10 19:33:12 dgp Exp $ '\" .so man.macros -.TH "http" n 2.5 http "Tcl Bundled Packages" +.TH "http" n 2.5.5 http "Tcl Bundled Packages" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME http \- Client-side implementation of the HTTP/1.0 protocol .SH SYNOPSIS -\fBpackage require http ?2.5?\fR +\fBpackage require http ?2.5.5?\fR .\" See Also -useragent option documentation in body! .sp \fB::http::config \fI?options?\fR diff --git a/generic/tclBasic.c b/generic/tclBasic.c index c7daa32..430f8bc 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -14,7 +14,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclBasic.c,v 1.244.2.23 2008/03/07 22:05:02 dgp Exp $ + * RCS: @(#) $Id: tclBasic.c,v 1.244.2.24 2008/03/10 19:33:12 dgp Exp $ */ #include "tclInt.h" @@ -5963,7 +5963,7 @@ ExprAbsFunc( if (type == TCL_NUMBER_LONG) { long l = *((const long *) ptr); - if (l < (long)0) { + if (l <= (long)0) { if (l == LONG_MIN) { TclBNInitBignumFromLong(&big, l); goto tooLarge; @@ -5977,7 +5977,7 @@ ExprAbsFunc( if (type == TCL_NUMBER_DOUBLE) { double d = *((const double *) ptr); - if (d < 0.0) { + if (d <= 0.0) { Tcl_SetObjResult(interp, Tcl_NewDoubleObj(-d)); } else { Tcl_SetObjResult(interp, objv[1]); diff --git a/generic/tclEvent.c b/generic/tclEvent.c index 2471b72..cb488f0 100644 --- a/generic/tclEvent.c +++ b/generic/tclEvent.c @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclEvent.c,v 1.72.2.5 2008/03/07 22:05:04 dgp Exp $ + * RCS: @(#) $Id: tclEvent.c,v 1.72.2.6 2008/03/10 19:33:12 dgp Exp $ */ #include "tclInt.h" @@ -317,30 +317,57 @@ TclDefaultBgErrorHandlerObjCmd( return TCL_ERROR; } - /* Construct the bgerror command */ - TclNewLiteralStringObj(tempObjv[0], "bgerror"); - Tcl_IncrRefCount(tempObjv[0]); - /* - * Determine error message argument. Check the return options in case - * a non-error exception brought us here. + * Check for a valid return options dictionary. */ TclNewLiteralStringObj(keyPtr, "-level"); Tcl_IncrRefCount(keyPtr); Tcl_DictObjGet(NULL, objv[2], keyPtr, &valuePtr); Tcl_DecrRefCount(keyPtr); - Tcl_GetIntFromObj(NULL, valuePtr, &level); + if (valuePtr == NULL) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "missing return option \"-level\"", -1)); + return TCL_ERROR; + } + if (Tcl_GetIntFromObj(interp, valuePtr, &level) == TCL_ERROR) { + return TCL_ERROR; + } + TclNewLiteralStringObj(keyPtr, "-code"); + Tcl_IncrRefCount(keyPtr); + Tcl_DictObjGet(NULL, objv[2], keyPtr, &valuePtr); + Tcl_DecrRefCount(keyPtr); + if (valuePtr == NULL) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "missing return option \"-code\"", -1)); + return TCL_ERROR; + } + if (Tcl_GetIntFromObj(interp, valuePtr, &code) == TCL_ERROR) { + return TCL_ERROR; + } + if (level != 0) { /* We're handling a TCL_RETURN exception */ code = TCL_RETURN; - } else { - TclNewLiteralStringObj(keyPtr, "-code"); - Tcl_IncrRefCount(keyPtr); - Tcl_DictObjGet(NULL, objv[2], keyPtr, &valuePtr); - Tcl_DecrRefCount(keyPtr); - Tcl_GetIntFromObj(NULL, valuePtr, &code); } + if (code == TCL_OK) { + /* + * Somehow we got to exception handling with no exception. + * (Pass TCL_OK to TclBackgroundException()?) + * Just return without doing anything. + */ + return TCL_OK; + } + + /* Construct the bgerror command */ + TclNewLiteralStringObj(tempObjv[0], "bgerror"); + Tcl_IncrRefCount(tempObjv[0]); + + /* + * Determine error message argument. Check the return options in case + * a non-error exception brought us here. + */ + switch (code) { case TCL_ERROR: tempObjv[1] = objv[1]; diff --git a/generic/tclExecute.c b/generic/tclExecute.c index a990c54..ff308f0 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -13,7 +13,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclExecute.c,v 1.285.2.30 2008/03/07 22:05:04 dgp Exp $ + * RCS: @(#) $Id: tclExecute.c,v 1.285.2.31 2008/03/10 19:33:12 dgp Exp $ */ #include "tclInt.h" @@ -1309,7 +1309,7 @@ Tcl_ExprObj( * * Part of the Tcl object type implementation for Tcl expression * bytecode. We do not copy the bytecode intrep. Instead, we - * return with setting copyPtr->typePtr, so the copy is a plain + * return without setting copyPtr->typePtr, so the copy is a plain * string copy of the expression value, and if it is to be used * as a compiled expression, it will just need a recompile. * diff --git a/generic/tclResult.c b/generic/tclResult.c index 355cf92..9c695ba 100644 --- a/generic/tclResult.c +++ b/generic/tclResult.c @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclResult.c,v 1.36.2.6 2008/03/07 22:05:06 dgp Exp $ + * RCS: @(#) $Id: tclResult.c,v 1.36.2.7 2008/03/10 19:33:13 dgp Exp $ */ #include "tclInt.h" @@ -1161,6 +1161,7 @@ ReleaseKeys( for (i = KEY_CODE; i < KEY_LAST; i++) { Tcl_DecrRefCount(keys[i]); + keys[i] = NULL; } } diff --git a/tests/event.test b/tests/event.test index 4cae5ac..7f8e980 100644 --- a/tests/event.test +++ b/tests/event.test @@ -9,7 +9,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: event.test,v 1.24.2.1 2007/09/07 20:20:55 dgp Exp $ +# RCS: @(#) $Id: event.test,v 1.24.2.2 2008/03/10 19:33:13 dgp Exp $ package require tcltest 2 namespace import -force ::tcltest::* @@ -205,6 +205,69 @@ test event-5.3 {HandleBgErrors: [Bug 1670155]} -setup { rename demo {} rename trial {} } -result {} +test event-5.3 {Default [interp bgerror] handler} -body { + ::tcl::Bgerror +} -returnCodes error -match glob -result {*msg options*} +test event-5.4 {Default [interp bgerror] handler} -body { + ::tcl::Bgerror {} +} -returnCodes error -match glob -result {*msg options*} +test event-5.5 {Default [interp bgerror] handler} -body { + ::tcl::Bgerror {} {} {} +} -returnCodes error -match glob -result {*msg options*} +test event-5.6 {Default [interp bgerror] handler} -body { + ::tcl::Bgerror {} {} +} -returnCodes error -match glob -result {*-level*} +test event-5.7 {Default [interp bgerror] handler} -body { + ::tcl::Bgerror {} {-level foo} +} -returnCodes error -match glob -result {*expected integer*} +test event-5.8 {Default [interp bgerror] handler} -body { + ::tcl::Bgerror {} {-level 0} +} -returnCodes error -match glob -result {*-code*} +test event-5.9 {Default [interp bgerror] handler} -body { + ::tcl::Bgerror {} {-level 0 -code ok} +} -returnCodes error -match glob -result {*expected integer*} +test event-5.10 {Default [interp bgerror] handler} { + proc bgerror {m} {append ::res $m} + set ::res {} + ::tcl::Bgerror {} {-level 0 -code 0} + rename bgerror {} + set ::res +} {} +test event-5.11 {Default [interp bgerror] handler} { + proc bgerror {m} {append ::res $m} + set ::res {} + ::tcl::Bgerror msg {-level 0 -code 1} + rename bgerror {} + set ::res +} {msg} +test event-5.12 {Default [interp bgerror] handler} { + proc bgerror {m} {append ::res $m} + set ::res {} + ::tcl::Bgerror msg {-level 0 -code 2} + rename bgerror {} + set ::res +} {command returned bad code: 2} +test event-5.13 {Default [interp bgerror] handler} { + proc bgerror {m} {append ::res $m} + set ::res {} + ::tcl::Bgerror msg {-level 0 -code 3} + rename bgerror {} + set ::res +} {invoked "break" outside of a loop} +test event-5.14 {Default [interp bgerror] handler} { + proc bgerror {m} {append ::res $m} + set ::res {} + ::tcl::Bgerror msg {-level 0 -code 4} + rename bgerror {} + set ::res +} {invoked "continue" outside of a loop} +test event-5.15 {Default [interp bgerror] handler} { + proc bgerror {m} {append ::res $m} + set ::res {} + ::tcl::Bgerror msg {-level 0 -code 5} + rename bgerror {} + set ::res +} {command returned bad code: 5} test event-6.1 {BgErrorDeleteProc procedure} { catch {interp delete foo} diff --git a/tests/expr.test b/tests/expr.test index 0aece0c..1d81085 100644 --- a/tests/expr.test +++ b/tests/expr.test @@ -10,7 +10,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: expr.test,v 1.67.2.2 2007/10/16 03:50:32 dgp Exp $ +# RCS: @(#) $Id: expr.test,v 1.67.2.3 2008/03/10 19:33:13 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2.1 @@ -6342,6 +6342,24 @@ test expr-37.14 {expr edge cases} {wideIs64bit} { test expr-38.1 {abs of smallest 32-bit integer [Bug 1241572]} {wideIs64bit} { expr {abs(-2147483648)} } 2147483648 +test expr-38.2 {abs and -0 [Bug 1893815]} { + expr {abs(-0)} +} 0 +test expr-38.3 {abs and -0 [Bug 1893815]} { + expr {abs(-0.0)} +} 0.0 +test expr-38.4 {abs and -0 [Bug 1893815]} { + expr {abs(-1e-324)} +} 0.0 +test expr-38.5 {abs and -0 [Bug 1893815]} { + ::tcl::mathfunc::abs -0 +} 0 +test expr-38.6 {abs and -0 [Bug 1893815]} { + ::tcl::mathfunc::abs -0.0 +} 0.0 +test expr-38.7 {abs and -0 [Bug 1893815]} { + ::tcl::mathfunc::abs -1e-324 +} 0.0 testConstraint testexprlongobj [llength [info commands testexprlongobj]] testConstraint testexprdoubleobj [llength [info commands testexprdoubleobj]] diff --git a/unix/dltest/Makefile.in b/unix/dltest/Makefile.in index 53a45a9..eab63a1 100644 --- a/unix/dltest/Makefile.in +++ b/unix/dltest/Makefile.in @@ -1,7 +1,7 @@ # This Makefile is used to create several test cases for Tcl's load # command. It also illustrates how to take advantage of configuration # exported by Tcl to set up Makefiles for shared libraries. -# RCS: @(#) $Id: Makefile.in,v 1.20 2006/12/17 03:47:09 das Exp $ +# RCS: @(#) $Id: Makefile.in,v 1.20.2.1 2008/03/10 19:33:14 dgp Exp $ CC = @CC@ LIBS = @TCL_BUILD_STUB_LIB_SPEC@ @TCL_LIBS@ @@ -99,4 +99,4 @@ clean: fi distclean: clean - rm -f Makefile + rm -f Makefile
\ No newline at end of file |