* generic/tclCmdIL.c (InfoBodyCmd): made [info body] return a

	string if the body has been bytecompiled.
	* generic/tclBasic.c (Tcl_EvalObjEx): added pedantic check for
	originating proc body of bytecompiled code, #def'd out as the
	change for [info body] should make it unnecessary

	* tests/set.test: added test for complex array elem name compiling
	* generic/tclCompCmds.c (TclCompileSetCmd): Fixed parsing of array
	elements during compiling, and slightly optimised same [Bug: 3889]

5 files changed, 61 insertions, 27 deletions

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 9691459..9968614 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -12,7 +12,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclBasic.c,v 1.23 1999/12/12 02:26:40 hobbs Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.24 2000/01/21 02:25:25 hobbs Exp $
  */
 
 #include "tclInt.h"
@@ -2642,6 +2642,13 @@ Tcl_EvalObjEx(interp, objPtr, flags)
      *
      * Precompiled objects, however, are immutable and therefore
      * they are not recompiled, even if the epoch has changed.
+     *
+     * To be pedantically correct, we should also check that the
+     * originating procPtr is the same as the current context procPtr
+     * (assuming one exists at all - none for global level).  This
+     * code is #def'ed out because [info body] was changed to never
+     * return a bytecode type object, which should obviate us from
+     * the extra checks here.
      */
 
     if (iPtr->varFramePtr != NULL) {
@@ -2655,6 +2662,10 @@ Tcl_EvalObjEx(interp, objPtr, flags)
 	
 	if (((Interp *) *codePtr->interpHandle != iPtr)
 	        || (codePtr->compileEpoch != iPtr->compileEpoch)
+#ifdef CHECK_PROC_ORIGINATION	/* [Bug: 3412 Pedantic] */
+		|| (codePtr->procPtr != NULL && !(iPtr->varFramePtr &&
+			iPtr->varFramePtr->procPtr == codePtr->procPtr))
+#endif
 	        || (codePtr->nsPtr != namespacePtr)
 	        || (codePtr->nsEpoch != namespacePtr->resolverEpoch)) {
             if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) {
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index 731bac0..c928224 100644
--- a/generic/tclCmdAH.c
+++ b/generic/tclCmdAH.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: tclCmdAH.c,v 1.11 1999/12/12 02:26:41 hobbs Exp $
+ * RCS: @(#) $Id: tclCmdAH.c,v 1.12 2000/01/21 02:25:26 hobbs Exp $
  */
 
 #include "tclInt.h"
@@ -257,7 +257,7 @@ Tcl_CatchObjCmd(dummy, interp, objc, objv)
     if (objc == 3) {
 	varNamePtr = objv[2];
     }
-    
+
     result = Tcl_EvalObjEx(interp, objv[1], 0);
     
     if (objc == 3) {
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index 4fe4f4a..4240f84 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -14,7 +14,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclCmdIL.c,v 1.21 2000/01/13 20:33:10 ericm Exp $
+ * RCS: @(#) $Id: tclCmdIL.c,v 1.22 2000/01/21 02:25:26 hobbs Exp $
  */
 
 #include "tclInt.h"
@@ -563,9 +563,12 @@ InfoBodyCmd(dummy, interp, objc, objv)
     }
 
     /*
-     * we need to check if the body from this procedure had been generated
-     * from a precompiled body. If that is the case, then the bodyPtr's
-     * string representation is bogus, since sources are not available.
+     * We should not return a bytecompiled body.  If it is precompiled,
+     * then the bodyPtr's string representation is bogus, since sources
+     * are not available.  If it was just a bytecompiled body, then it
+     * is likely to not be of any use to the caller, as it was compiled
+     * for a separate procedure context [Bug: 3412], and noone else can
+     * reasonably use it.
      * In order to make sure that later manipulations of the object do not
      * invalidate the internal representation, we make a copy of the string
      * representation and return that one, instead.
@@ -574,11 +577,7 @@ InfoBodyCmd(dummy, interp, objc, objv)
     bodyPtr = procPtr->bodyPtr;
     resultPtr = bodyPtr;
     if (bodyPtr->typePtr == &tclByteCodeType) {
-        ByteCode *codePtr = (ByteCode *) bodyPtr->internalRep.otherValuePtr;
-
-        if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) {
-            resultPtr = Tcl_NewStringObj(bodyPtr->bytes, bodyPtr->length);
-        }
+	resultPtr = Tcl_NewStringObj(bodyPtr->bytes, bodyPtr->length);
     }
     
     Tcl_SetObjResult(interp, resultPtr);
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 5577bf1..75fa02e 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -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: tclCompCmds.c,v 1.4 1999/10/29 03:04:00 hobbs Exp $
+ * RCS: @(#) $Id: tclCompCmds.c,v 1.5 2000/01/21 02:25:26 hobbs Exp $
  */
 
 #include "tclInt.h"
@@ -1579,7 +1579,7 @@ TclCompileSetCmd(interp, parsePtr, envPtr)
     register char *p;
     char *name, *elName;
     int nameChars, elNameChars;
-    register int i;
+    register int i, n;
     int isAssignment, simpleVarName, localIndex, numWords;
     int maxDepth = 0;
     int code = TCL_OK;
@@ -1647,17 +1647,41 @@ TclCompileSetCmd(interp, parsePtr, envPtr)
 		break;
 	    }
 	}
-    } else if ((varTokenPtr->numComponents == 4)
+    } else if (((n = varTokenPtr->numComponents) > 1)
 	    && (varTokenPtr[1].type == TCL_TOKEN_TEXT)
-	    && (varTokenPtr[1].start[varTokenPtr[1].size-1] == '(')
-	    && (varTokenPtr[4].type == TCL_TOKEN_TEXT)
-	    && (varTokenPtr[4].size == 1)
-	    && (varTokenPtr[4].start[0] == ')')) {
-	simpleVarName = 1;
-	name = varTokenPtr[1].start;
-	nameChars = varTokenPtr[1].size - 1;
-	elName = varTokenPtr[2].start;
-	elNameChars = varTokenPtr[2].size;
+            && (varTokenPtr[n].type == TCL_TOKEN_TEXT)
+            && (varTokenPtr[n].start[varTokenPtr[n].size - 1] == ')')) {
+        simpleVarName = 0;
+
+        /*
+	 * Check for parentheses inside first token
+	 */
+        for (i = 0, p = varTokenPtr[1].start; 
+	     i < varTokenPtr[1].size; i++, p++) {
+            if (*p == '(') {
+                simpleVarName = 1;
+                break;
+            }
+        }
+        if (simpleVarName) {
+            name = varTokenPtr[1].start;
+            nameChars = p - varTokenPtr[1].start;
+            elName = p + 1;
+            elNameChars = (varTokenPtr[n].start - p) + varTokenPtr[n].size - 2;
+
+            /*
+             * If elName contains any double quotes ("), we can't inline
+             * compile the element script using the replace '()' by '"'
+             * technique below.
+             */
+
+            for (i = 0, p = elName;  i < elNameChars;  i++, p++) {
+                if (*p == '"') {
+                    simpleVarName = 0;
+                    break;
+                }
+            }
+        }
     }
 
     if (simpleVarName) {
diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c
index 89453f5..c70dd0b 100644
--- a/generic/tclEncoding.c
+++ b/generic/tclEncoding.c
@@ -8,7 +8,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclEncoding.c,v 1.4 1999/12/12 22:46:41 hobbs Exp $
+ * RCS: @(#) $Id: tclEncoding.c,v 1.5 2000/01/21 02:25:26 hobbs Exp $
  */
 
 #include "tclInt.h"
@@ -738,9 +738,9 @@ Tcl_CreateEncoding(typePtr)
     encodingPtr->nullSize	= typePtr->nullSize;
     encodingPtr->clientData	= typePtr->clientData;
     if (typePtr->nullSize == 1) {
-	encodingPtr->lengthProc = strlen;
+	encodingPtr->lengthProc = (LengthProc *) strlen;
     } else {
-	encodingPtr->lengthProc = unilen;
+	encodingPtr->lengthProc = (LengthProc *) unilen;
     }
     encodingPtr->refCount	= 1;
     encodingPtr->hPtr		= hPtr;