summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2003-08-29 17:43:24 (GMT)
committerdgp <dgp@users.sourceforge.net>2003-08-29 17:43:24 (GMT)
commit4d937a98950f548bd24d312258fd069a0c063041 (patch)
tree741057c3b5bda83a236207ecf3a28ff0fe54f15a
parentf13a99eb97ccd3791f0896870344e33eacf3e28c (diff)
downloadtcl-4d937a98950f548bd24d312258fd069a0c063041.zip
tcl-4d937a98950f548bd24d312258fd069a0c063041.tar.gz
tcl-4d937a98950f548bd24d312258fd069a0c063041.tar.bz2
* generic/tclCmdAH.c: Corrected bug in TIP 90 implementation
* tests/cmdMZ.test: where the default -errorcode NONE value was not copied into the return options dictionary. This correction modified one test result.
-rw-r--r--ChangeLog7
-rw-r--r--generic/tclCmdAH.c9
-rw-r--r--tests/cmdMZ.test4
3 files changed, 17 insertions, 3 deletions
diff --git a/ChangeLog b/ChangeLog
index a6f26cd..de252a5 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,10 @@
+2003-08-29 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclCmdAH.c: Corrected bug in TIP 90 implementation
+ * tests/cmdMZ.test: where the default -errorcode NONE value
+ was not copied into the return options dictionary. This correction
+ modified one test result.
+
2003-08-27 David Gravereaux <davygrvy@pobox.com>
* compat/strftime.c (_fmt): Removed syst array intializer that
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index d4788be..5cfe243 100644
--- a/generic/tclCmdAH.c
+++ b/generic/tclCmdAH.c
@@ -11,7 +11,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclCmdAH.c,v 1.33 2003/05/14 22:45:12 dkf Exp $
+ * RCS: @(#) $Id: tclCmdAH.c,v 1.34 2003/08/29 17:43:24 dgp Exp $
*/
#include "tclInt.h"
@@ -301,6 +301,13 @@ Tcl_CatchObjCmd(dummy, interp, objc, objv)
if (result == TCL_ERROR) {
value = NULL;
+ Tcl_DictObjGet(NULL, options, iPtr->returnErrorcodeKey, &value);
+ if (NULL == value) {
+ Tcl_DictObjPut(NULL, options, iPtr->returnErrorcodeKey,
+ Tcl_ObjGetVar2(interp, iPtr->execEnvPtr->errorCode,
+ NULL, TCL_GLOBAL_ONLY));
+ }
+ value = NULL;
Tcl_DictObjGet(NULL, options, iPtr->returnErrorlineKey, &value);
if (NULL == value) {
Tcl_DictObjPut(NULL, options, iPtr->returnErrorlineKey,
diff --git a/tests/cmdMZ.test b/tests/cmdMZ.test
index bcaa690..4609365 100644
--- a/tests/cmdMZ.test
+++ b/tests/cmdMZ.test
@@ -11,7 +11,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: cmdMZ.test,v 1.16 2003/06/25 23:02:11 dkf Exp $
+# RCS: @(#) $Id: cmdMZ.test,v 1.17 2003/08/29 17:43:24 dgp Exp $
if {[catch {package require tcltest 2.0.2}]} {
puts stderr "Skipping tests in [info script]. tcltest 2.0.2 required."
@@ -137,7 +137,7 @@ test cmdMZ-return-2.9 {return option handling} -body {
} -returnCodes 10 -result {}
test cmdMZ-return-2.10 {return option handling} {
list [catch {return -level 0 -code error} -> foo] [dictSort $foo]
-} {1 {-code 1 -errorinfo {
+} {1 {-code 1 -errorcode NONE -errorinfo {
while executing
"return -level 0 -code error"} -errorline 1 -level 0}}
test cmdMZ-return-2.11 {return option handling} {