diff options
| author | Miguel Sofer <miguel.sofer@gmail.com> | 2004-09-22 15:48:21 (GMT) |
|---|---|---|
| committer | Miguel Sofer <miguel.sofer@gmail.com> | 2004-09-22 15:48:21 (GMT) |
| commit | 9cd2909333f98f2b80729361b1492be6b8da5b6c (patch) | |
| tree | 7db172f915c75d1855a3c835d5b9a4989a435d62 | |
| parent | 9668a0e54abfdea9c4249e5ff8fffcb9acc8c96a (diff) | |
| download | tcl-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-- | ChangeLog | 6 | ||||
| -rw-r--r-- | generic/tclExecute.c | 5 | ||||
| -rw-r--r-- | tests/proc.test | 32 | ||||
| -rw-r--r-- | unix/tclUnixInit.c | 5 |
4 files changed, 43 insertions, 5 deletions
@@ -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; |