Patch from [Bug: 231259]

4 files changed, 43 insertions, 8 deletions

diff --git a/ChangeLog b/ChangeLog
index c12cd13..11ec9bd 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,11 @@
+2001-05-07  Miguel Sofer  <msofer@users.sourceforge.net>
+
+	* generic/tclInt.h
+	* generic/tclNamesp.c: invalidate all bytecodes in a namespace if
+	a new command shadows a bytecoded command.
+	* tests/namespace.test
+	Patched from [Bug: 231259] 
+
 2001-05-15  Donal K. Fellows  <fellowsd@cs.man.ac.uk>
 
 	* doc/console.n: Created.  It seems very odd to me that the
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 34a995d..752395f 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -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: tclInt.h,v 1.52 2001/04/27 22:11:51 kennykb Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.53 2001/05/15 14:19:13 msofer Exp $
  */
 
 #ifndef _TCLINT
@@ -184,11 +184,13 @@ typedef struct Namespace {
 				  * namespace has already cached a Command *
 				  * pointer; this causes all its cached
 				  * Command* pointers to be invalidated. */
-    int resolverEpoch;		 /* Incremented whenever the name resolution
-				  * rules change for this namespace; this
-				  * invalidates all byte codes compiled in
-				  * the namespace, causing the code to be
-				  * recompiled under the new rules. */
+    int resolverEpoch;		 /* Incremented whenever (a) the name resolution
+				  * rules change for this namespace or (b) a 
+				  * newly added command shadows a command that
+				  * is compiled to bytecodes.
+				  * This invalidates all byte codes compiled
+				  * in the namespace, causing the code to be
+				  * recompiled under the new rules.*/
     Tcl_ResolveCmdProc *cmdResProc;
 				 /* If non-null, this procedure overrides
 				  * the usual command resolution mechanism
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index 8945e52..577a139 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -19,7 +19,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclNamesp.c,v 1.22 2001/04/25 09:44:49 dkf Exp $
+ * RCS: @(#) $Id: tclNamesp.c,v 1.23 2001/05/15 14:19:13 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -2283,6 +2283,17 @@ TclResetShadowedCmdRefs(interp, newCmdPtr)
             hPtr = Tcl_FindHashEntry(&shadowNsPtr->cmdTable, cmdName);
             if (hPtr != NULL) {
                 nsPtr->cmdRefEpoch++;
+
+		/* 
+		 * If the shadowed command was compiled to bytecodes, we
+		 * invalidate all the bytecodes in nsPtr, to force a new
+		 * compilation. We use the resolverEpoch to signal the need
+		 * for a fresh compilation of every bytecode.
+		 */
+
+		if ((((Command *) hPtr)->compileProc) != NULL) {
+		    nsPtr->resolverEpoch++;
+		}
             }
         }
 
diff --git a/tests/namespace.test b/tests/namespace.test
index 75f8fc5..e6b881c 100644
--- a/tests/namespace.test
+++ b/tests/namespace.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: namespace.test,v 1.15 2001/05/03 21:14:57 msofer Exp $
+# RCS: @(#) $Id: namespace.test,v 1.16 2001/05/15 14:19:14 msofer Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -1136,6 +1136,20 @@ test namespace-40.1 {Ignoring namespace proc "unknown"} {
     set l
 } {global global}
 
+test namespace-41.1 {Shadowing byte-compiled commands} {
+    namespace eval ns {
+	proc test {} {
+	    set ::g 0
+	}  
+	lappend ::res [test]
+	proc set {a b} {
+	    ::set a [incr b]
+	}
+	lappend ::res [test]
+    }
+    set res
+} {0 1}
+
 # cleanup
 catch {rename cmd1 {}}
 catch {unset l}