From 9cd2909333f98f2b80729361b1492be6b8da5b6c Mon Sep 17 00:00:00 2001
From: Miguel Sofer <miguel.sofer@gmail.com>
Date: Wed, 22 Sep 2004 15:48:21 +0000
Subject: 	* generic/tclExecute.c (INST_START_CMD): 	*
 tests/proc.test (7.2-3): fix for [Bug 729692] was incorrect 	whenever a
 loop exception was returned.

---
 ChangeLog            |  6 ++++++
 generic/tclExecute.c |  5 +++--
 tests/proc.test      | 32 +++++++++++++++++++++++++++++++-
 unix/tclUnixInit.c   |  5 +++--
 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;
 
-- 
cgit v0.12