Merge 8.7

1 files changed, 37 insertions, 3 deletions

diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c
index 9c49caa..ad14a1a 100644
--- a/generic/tclOOMethod.c
+++ b/generic/tclOOMethod.c
@@ -186,7 +186,11 @@ Tcl_NewInstanceMethod(
     mPtr->declaringObjectPtr = oPtr;
     mPtr->declaringClassPtr = NULL;
     if (flags) {
-	mPtr->flags |= flags & (PUBLIC_METHOD | PRIVATE_METHOD);
+	mPtr->flags |= flags &
+		(PUBLIC_METHOD | PRIVATE_METHOD | TRUE_PRIVATE_METHOD);
+	if (flags & TRUE_PRIVATE_METHOD) {
+	    oPtr->flags |= HAS_PRIVATE_METHODS;
+	}
     }
     oPtr->epoch++;
     return (Tcl_Method) mPtr;
@@ -250,7 +254,11 @@ Tcl_NewMethod(
     mPtr->declaringObjectPtr = NULL;
     mPtr->declaringClassPtr = clsPtr;
     if (flags) {
-	mPtr->flags |= flags & (PUBLIC_METHOD | PRIVATE_METHOD);
+	mPtr->flags |= flags &
+		(PUBLIC_METHOD | PRIVATE_METHOD | TRUE_PRIVATE_METHOD);
+	if (flags & TRUE_PRIVATE_METHOD) {
+	    clsPtr->flags |= HAS_PRIVATE_METHODS;
+	}
     }
 
     return (Tcl_Method) mPtr;
@@ -928,7 +936,7 @@ PushMethodCallFrame(
  *	variables used in methods. The compiled variable resolver is more
  *	important, but both are needed as it is possible to have a variable
  *	that is only referred to in ways that aren't compilable and we can't
- *	force LVT presence. [TIP #320]
+ *	force LVT presence. [TIP #320, #500]
  *
  * ----------------------------------------------------------------------
  */
@@ -986,6 +994,7 @@ ProcedureMethodCompiledVarConnect(
     CallFrame *framePtr = iPtr->varFramePtr;
     CallContext *contextPtr;
     Tcl_Obj *variableObj;
+    PrivateVariableMapping *privateVar;
     Tcl_HashEntry *hPtr;
     int i, isNew, cacheIt, varLen, len;
     const char *match, *varName;
@@ -1019,6 +1028,15 @@ ProcedureMethodCompiledVarConnect(
     varName = TclGetStringFromObj(infoPtr->variableObj, &varLen);
     if (contextPtr->callPtr->chain[contextPtr->index]
 	    .mPtr->declaringClassPtr != NULL) {
+	FOREACH_STRUCT(privateVar, contextPtr->callPtr->chain[contextPtr->index]
+		.mPtr->declaringClassPtr->privateVariables) {
+	    match = TclGetStringFromObj(privateVar->variableObj, &len);
+	    if ((len == varLen) && !memcmp(match, varName, len)) {
+		variableObj = privateVar->fullNameObj;
+		cacheIt = 0;
+		goto gotMatch;
+	    }
+	}
 	FOREACH(variableObj, contextPtr->callPtr->chain[contextPtr->index]
 		.mPtr->declaringClassPtr->variables) {
 	    match = TclGetStringFromObj(variableObj, &len);
@@ -1028,6 +1046,14 @@ ProcedureMethodCompiledVarConnect(
 	    }
 	}
     } else {
+	FOREACH_STRUCT(privateVar, contextPtr->oPtr->privateVariables) {
+	    match = TclGetStringFromObj(privateVar->variableObj, &len);
+	    if ((len == varLen) && !memcmp(match, varName, len)) {
+		variableObj = privateVar->fullNameObj;
+		cacheIt = 1;
+		goto gotMatch;
+	    }
+	}
 	FOREACH(variableObj, contextPtr->oPtr->variables) {
 	    match = TclGetStringFromObj(variableObj, &len);
 	    if ((len == varLen) && !memcmp(match, varName, len)) {
@@ -1314,6 +1340,7 @@ CloneProcedureMethod(
      */
 
     bodyObj = Tcl_DuplicateObj(pmPtr->procPtr->bodyPtr);
+    Tcl_GetString(bodyObj);
     TclFreeIntRep(bodyObj);
 
     /*
@@ -1672,6 +1699,13 @@ Tcl_MethodIsPublic(
 {
     return (((Method *)method)->flags & PUBLIC_METHOD) ? 1 : 0;
 }
+
+int
+Tcl_MethodIsPrivate(
+    Tcl_Method method)
+{
+    return (((Method *)method)->flags & TRUE_PRIVATE_METHOD) ? 1 : 0;
+}
 
 /*
  * Extended method construction for itcl-ng.