summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorMiguel Sofer <miguel.sofer@gmail.com>2004-09-22 15:48:21 (GMT)
committerMiguel Sofer <miguel.sofer@gmail.com>2004-09-22 15:48:21 (GMT)
commit9cd2909333f98f2b80729361b1492be6b8da5b6c (patch)
tree7db172f915c75d1855a3c835d5b9a4989a435d62
parent9668a0e54abfdea9c4249e5ff8fffcb9acc8c96a (diff)
downloadtcl-9cd2909333f98f2b80729361b1492be6b8da5b6c.zip
tcl-9cd2909333f98f2b80729361b1492be6b8da5b6c.tar.gz
tcl-9cd2909333f98f2b80729361b1492be6b8da5b6c.tar.bz2
* generic/tclExecute.c (INST_START_CMD):
* tests/proc.test (7.2-3): fix for [Bug 729692] was incorrect whenever a loop exception was returned.
-rw-r--r--ChangeLog6
-rw-r--r--generic/tclExecute.c5
-rw-r--r--tests/proc.test32
-rw-r--r--unix/tclUnixInit.c5
4 files changed, 43 insertions, 5 deletions
diff --git a/ChangeLog b/ChangeLog
index 2c086e0..a6c805b 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2004-09-22 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclExecute.c (INST_START_CMD):
+ * tests/proc.test (7.2-3): fix for [Bug 729692] was incorrect
+ whenever a loop exception was returned.
+
2004-09-22 Kevin B. Kenny <kennykb@acm.org>
* library/tzdata/America/Montevideo: Updated to reflect
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index b7edcf2..a79ab92 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.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: tclExecute.c,v 1.151 2004/09/21 22:45:41 dgp Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.152 2004/09/22 15:48:22 msofer Exp $
*/
#ifdef STDC_HEADERS
@@ -1335,7 +1335,8 @@ TclExecuteByteCode(interp, codePtr)
bytes = GetSrcInfoForPc(pc, codePtr, &length);
result = Tcl_EvalEx(interp, bytes, length, 0);
if (result != TCL_OK) {
- goto checkForCatch;
+ cleanup = 0;
+ goto processExceptionReturn;
}
opnd = TclGetUInt4AtPtr(pc+1);
objResultPtr = Tcl_GetObjResult(interp);
diff --git a/tests/proc.test b/tests/proc.test
index 988fb0f..bef0948 100644
--- a/tests/proc.test
+++ b/tests/proc.test
@@ -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: proc.test,v 1.16 2004/05/19 12:54:56 dkf Exp $
+# RCS: @(#) $Id: proc.test,v 1.17 2004/09/22 15:48:23 msofer Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -333,6 +333,36 @@ test proc-7.1 {Redefining a compiled cmd: Bug 729692} {
foo
} bar
+test proc-7.2 {Shadowing a compiled cmd: Bug 729692} {
+ namespace eval ugly {}
+ proc ugly::foo {} {
+ proc set args {return bar}
+ set x 1
+ }
+ set res [list [catch {ugly::foo} msg] $msg]
+ namespace delete ugly
+ set res
+} {0 bar}
+
+test proc-7.3 {Returning loop exception from redefined cmd: Bug 729692} {
+ namespace eval ugly {}
+ proc ugly::foo {} {
+ set i 0
+ while { 1 } {
+ if { [incr i] > 3 } {
+ proc continue {} {return -code break}
+ }
+ continue
+ }
+ return $i
+ }
+ set res [list [catch {ugly::foo} msg] $msg]
+ namespace delete ugly
+ set res
+} {0 4}
+
+
+
# cleanup
catch {rename p ""}
catch {rename t ""}
diff --git a/unix/tclUnixInit.c b/unix/tclUnixInit.c
index 86000cc..d0bf322 100644
--- a/unix/tclUnixInit.c
+++ b/unix/tclUnixInit.c
@@ -7,7 +7,7 @@
* Copyright (c) 1999 by Scriptics Corporation.
* All rights reserved.
*
- * RCS: @(#) $Id: tclUnixInit.c,v 1.47 2004/06/23 03:49:59 dgp Exp $
+ * RCS: @(#) $Id: tclUnixInit.c,v 1.48 2004/09/22 15:48:23 msofer Exp $
*/
#if defined(HAVE_CFBUNDLE)
@@ -423,7 +423,8 @@ CONST char *path; /* Path to the executable in native
* overwrite pathv[0] since that might produce a relative path.
*/
- if (0 && path != NULL) {
+ //if (0 && path != NULL) {
+ if (path != NULL) {
int i, origc;
CONST char **origv;