summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog29
-rw-r--r--changes40
-rw-r--r--doc/http.n6
-rw-r--r--generic/tclBasic.c6
-rw-r--r--generic/tclEvent.c55
-rw-r--r--generic/tclExecute.c4
-rw-r--r--generic/tclResult.c3
-rw-r--r--tests/event.test65
-rw-r--r--tests/expr.test20
-rw-r--r--unix/dltest/Makefile.in4
10 files changed, 204 insertions, 28 deletions
diff --git a/ChangeLog b/ChangeLog
index cce551f..49249bc 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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
diff --git a/changes b/changes
index 552e40d..f8fae37 100644
--- a/changes
+++ b/changes
@@ -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 ---
diff --git a/doc/http.n b/doc/http.n
index f4c2bf9..51b93b8 100644
--- a/doc/http.n
+++ b/doc/http.n
@@ -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