* generic/tclCompile.c: [Bug 2933089]: A literal sharing problem with

	* generic/tclCompile.h: 'info frame' affects not only 8.6 but 8.5 as
	* generic/tclExecute.h: well. Backported the fix done in 8.6, without
	* tests/info.test: changes. New testcase info-39.1.

3 files changed, 101 insertions, 3 deletions

diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 5f4a5a2..0e0333f 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.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: tclCompile.c,v 1.146.2.12 2009/08/26 02:26:14 dgp Exp $
+ * RCS: @(#) $Id: tclCompile.c,v 1.146.2.13 2010/02/02 20:51:46 andreas_kupries Exp $
  */
 
 #include "tclInt.h"
@@ -1003,6 +1003,8 @@ TclInitCompileEnv(
 	TclStackFree(interp, ctxPtr);
     }
 
+    envPtr->extCmdMapPtr->start = envPtr->line;
+
     /*
      * Initialize the data about invisible continuation lines as empty,
      * i.e. not used. The caller (TclSetByteCodeFromAny) will set this up, if
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index a86e8f1..cb036c5 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -9,7 +9,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclCompile.h,v 1.90.2.7 2009/08/25 21:01:05 andreas_kupries Exp $
+ * RCS: @(#) $Id: tclCompile.h,v 1.90.2.8 2010/02/02 20:51:47 andreas_kupries Exp $
  */
 
 #ifndef _TCLCOMPILATION
@@ -139,6 +139,10 @@ typedef struct ECL {
 
 typedef struct ExtCmdLoc {
     int type;			/* Context type. */
+    int start;                  /* Starting line for compiled script. Needed
+				 * for the extended recompile check in
+				 * TclCompEvalObj. */
+
     Tcl_Obj *path;		/* Path of the sourced file the command is
 				 * in. */
     ECL *loc;			/* Command word locations (lines). */
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 7974db5..cf26e87 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -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: tclExecute.c,v 1.369.2.12 2009/07/14 16:33:12 andreas_kupries Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.369.2.13 2010/02/02 20:51:47 andreas_kupries Exp $
  */
 
 #include "tclInt.h"
@@ -1441,6 +1441,98 @@ TclCompEvalObj(
 	}
 
 	/*
+	 * #280.
+	 * Literal sharing fix. This part of the fix is not required by 8.4
+	 * because it eval-directs any literals, so just saving the argument
+	 * locations per command in bytecode is enough, embedded 'eval'
+	 * commands, etc. get the correct information.
+	 *
+	 * It had be backported for 8.5 because we can force the separate
+	 * compiling of a literal (in a proc body) by putting it into a control
+	 * command with dynamic pieces, and then such literal may be shared
+	 * and require their line-information to be reset, as for 8.6, as
+	 * described below.
+	 *
+	 * In 8.6 all the embedded script are compiled, and the resulting
+	 * bytecode stored in the literal. Now the shared literal has bytecode
+	 * with location data for _one_ particular location this literal is
+	 * found at. If we get executed from a different location the bytecode
+	 * has to be recompiled to get the correct locations. Not doing this
+	 * will execute the saved bytecode with data for a different location,
+	 * causing 'info frame' to point to the wrong place in the sources.
+	 *
+	 * Future optimizations ...
+	 * (1) Save the location data (ExtCmdLoc) keyed by start line. In that
+	 *     case we recompile once per location of the literal, but not
+	 *     continously, because the moment we have all locations we do not
+	 *     need to recompile any longer.
+	 *
+	 * (2) Alternative: Do not recompile, tell the execution engine the
+	 *     offset between saved starting line and actual one. Then modify
+	 *     the users to adjust the locations they have by this offset.
+	 *
+	 * (3) Alternative 2: Do not fully recompile, adjust just the location
+	 *     information.
+	 */
+
+	{
+	    Tcl_HashEntry *hePtr =
+		    Tcl_FindHashEntry(iPtr->lineBCPtr, (char *) codePtr);
+
+	    if (hePtr) {
+		ExtCmdLoc *eclPtr = Tcl_GetHashValue(hePtr);
+		int redo = 0;
+
+		if (invoker) {
+		    CmdFrame *ctxPtr = TclStackAlloc(interp,sizeof(CmdFrame));
+		    *ctxPtr = *invoker;
+
+		    if (invoker->type == TCL_LOCATION_BC) {
+			/*
+			 * Note: Type BC => ctx.data.eval.path    is not used.
+			 *		    ctx.data.tebc.codePtr used instead
+			 */
+
+			TclGetSrcInfoForPc(ctxPtr);
+			if (ctxPtr->type == TCL_LOCATION_SOURCE) {
+			    /*
+			     * The reference made by 'TclGetSrcInfoForPc' is
+			     * dead.
+			     */
+
+			    Tcl_DecrRefCount(ctxPtr->data.eval.path);
+			    ctxPtr->data.eval.path = NULL;
+			}
+		    }
+
+		    if (word < ctxPtr->nline) {
+			/*
+			 * Note: We do not care if the line[word] is -1. This
+			 * is a difference and requires a recompile (location
+			 * changed from absolute to relative, literal is used
+			 * fixed and through variable)
+			 *
+			 * Example:
+			 * test info-32.0 using literal of info-24.8
+			 *     (dict with ... vs           set body ...).
+			 */
+
+			redo = ((eclPtr->type == TCL_LOCATION_SOURCE)
+				    && (eclPtr->start != ctxPtr->line[word]))
+				|| ((eclPtr->type == TCL_LOCATION_BC)
+				    && (ctxPtr->type == TCL_LOCATION_SOURCE));
+		    }
+
+		    TclStackFree(interp, ctxPtr);
+		}
+
+		if (redo) {
+		    goto recompileObj;
+		}
+	    }
+	}
+
+	/*
 	 * Increment the code's ref count while it is being executed. If
 	 * afterwards no references to it remain, free the code.
 	 */