Merge 8.7

1 files changed, 133 insertions, 7 deletions

diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c
index ae1f3bd..73368e4 100644
--- a/generic/tclOOMethod.c
+++ b/generic/tclOOMethod.c
@@ -126,7 +126,7 @@ static const Tcl_MethodType fwdMethodType = {
  */
 
 Tcl_Method
-Tcl_NewInstanceMethod(
+TclNewInstanceMethod(
     TCL_UNUSED(Tcl_Interp *),
     Tcl_Object object,		/* The object that has the method attached to
 				 * it. */
@@ -187,6 +187,50 @@ Tcl_NewInstanceMethod(
     oPtr->epoch++;
     return (Tcl_Method) mPtr;
 }
+Tcl_Method
+Tcl_NewInstanceMethod(
+    TCL_UNUSED(Tcl_Interp *),
+    Tcl_Object object,		/* The object that has the method attached to
+				 * it. */
+    Tcl_Obj *nameObj,		/* The name of the method. May be NULL; if so,
+				 * up to caller to manage storage (e.g., when
+				 * it is a constructor or destructor). */
+    int flags,			/* Whether this is a public method. */
+    const Tcl_MethodType *typePtr,
+				/* The type of method this is, which defines
+				 * how to invoke, delete and clone the
+				 * method. */
+    void *clientData)		/* Some data associated with the particular
+				 * method to be created. */
+{
+    if (typePtr->version > TCL_OO_METHOD_VERSION_1) {
+	Tcl_Panic("%s: Wrong version in typePtr->version, should be TCL_OO_METHOD_VERSION_1", "Tcl_NewInstanceMethod");
+    }
+    return TclNewInstanceMethod(NULL, object, nameObj, flags,
+	    (const Tcl_MethodType *)typePtr, clientData);
+}
+Tcl_Method
+Tcl_NewInstanceMethod2(
+    TCL_UNUSED(Tcl_Interp *),
+    Tcl_Object object,		/* The object that has the method attached to
+				 * it. */
+    Tcl_Obj *nameObj,		/* The name of the method. May be NULL; if so,
+				 * up to caller to manage storage (e.g., when
+				 * it is a constructor or destructor). */
+    int flags,			/* Whether this is a public method. */
+    const Tcl_MethodType2 *typePtr,
+				/* The type of method this is, which defines
+				 * how to invoke, delete and clone the
+				 * method. */
+    void *clientData)		/* Some data associated with the particular
+				 * method to be created. */
+{
+    if (typePtr->version < TCL_OO_METHOD_VERSION_2) {
+	Tcl_Panic("%s: Wrong version in typePtr->version, should be TCL_OO_METHOD_VERSION_2", "Tcl_NewInstanceMethod2");
+    }
+    return TclNewInstanceMethod(NULL, object, nameObj, flags,
+	    (const Tcl_MethodType *)typePtr, clientData);
+}
 
 /*
  * ----------------------------------------------------------------------
@@ -199,7 +243,7 @@ Tcl_NewInstanceMethod(
  */
 
 Tcl_Method
-Tcl_NewMethod(
+TclNewMethod(
     TCL_UNUSED(Tcl_Interp *),
     Tcl_Class cls,		/* The class to attach the method to. */
     Tcl_Obj *nameObj,		/* The name of the object. May be NULL (e.g.,
@@ -255,6 +299,48 @@ Tcl_NewMethod(
 
     return (Tcl_Method) mPtr;
 }
+
+Tcl_Method
+Tcl_NewMethod(
+    TCL_UNUSED(Tcl_Interp *),
+    Tcl_Class cls,		/* The class to attach the method to. */
+    Tcl_Obj *nameObj,		/* The name of the object. May be NULL (e.g.,
+				 * for constructors or destructors); if so, up
+				 * to caller to manage storage. */
+    int flags,			/* Whether this is a public method. */
+    const Tcl_MethodType *typePtr,
+				/* The type of method this is, which defines
+				 * how to invoke, delete and clone the
+				 * method. */
+    void *clientData)		/* Some data associated with the particular
+				 * method to be created. */
+{
+    if (typePtr->version > TCL_OO_METHOD_VERSION_1) {
+	Tcl_Panic("%s: Wrong version in typePtr->version, should be TCL_OO_METHOD_VERSION_1", "Tcl_NewMethod");
+    }
+    return TclNewMethod(NULL, cls, nameObj, flags, typePtr, clientData);
+}
+
+Tcl_Method
+Tcl_NewMethod2(
+    TCL_UNUSED(Tcl_Interp *),
+    Tcl_Class cls,		/* The class to attach the method to. */
+    Tcl_Obj *nameObj,		/* The name of the object. May be NULL (e.g.,
+				 * for constructors or destructors); if so, up
+				 * to caller to manage storage. */
+    int flags,			/* Whether this is a public method. */
+    const Tcl_MethodType2 *typePtr,
+				/* The type of method this is, which defines
+				 * how to invoke, delete and clone the
+				 * method. */
+    void *clientData)		/* Some data associated with the particular
+				 * method to be created. */
+{
+    if (typePtr->version < TCL_OO_METHOD_VERSION_2) {
+	Tcl_Panic("%s: Wrong version in typePtr->version, should be TCL_OO_METHOD_VERSION_2", "Tcl_NewMethod2");
+    }
+    return TclNewMethod(NULL, cls, nameObj, flags, (const Tcl_MethodType *)typePtr, clientData);
+}
 
 /*
  * ----------------------------------------------------------------------
@@ -304,7 +390,7 @@ TclOONewBasicMethod(
     Tcl_Obj *namePtr = Tcl_NewStringObj(dcm->name, -1);
 
     Tcl_IncrRefCount(namePtr);
-    Tcl_NewMethod(interp, (Tcl_Class) clsPtr, namePtr,
+    TclNewMethod(interp, (Tcl_Class) clsPtr, namePtr,
 	    (dcm->isPublic ? PUBLIC_METHOD : 0), &dcm->definition, NULL);
     Tcl_DecrRefCount(namePtr);
 }
@@ -529,7 +615,7 @@ TclOOMakeProcInstanceMethod(
 	}
     }
 
-    return Tcl_NewInstanceMethod(interp, (Tcl_Object) oPtr, nameObj, flags,
+    return TclNewInstanceMethod(interp, (Tcl_Object) oPtr, nameObj, flags,
 	    typePtr, clientData);
 }
 
@@ -642,7 +728,7 @@ TclOOMakeProcMethod(
 	}
     }
 
-    return Tcl_NewMethod(interp, (Tcl_Class) clsPtr, nameObj, flags, typePtr,
+    return TclNewMethod(interp, (Tcl_Class) clsPtr, nameObj, flags, typePtr,
 	    clientData);
 }
 
@@ -1402,7 +1488,7 @@ TclOONewForwardInstanceMethod(
     fmPtr = (ForwardMethod *)ckalloc(sizeof(ForwardMethod));
     fmPtr->prefixObj = prefixObj;
     Tcl_IncrRefCount(prefixObj);
-    return (Method *) Tcl_NewInstanceMethod(interp, (Tcl_Object) oPtr,
+    return (Method *) TclNewInstanceMethod(interp, (Tcl_Object) oPtr,
 	    nameObj, flags, &fwdMethodType, fmPtr);
 }
 
@@ -1441,7 +1527,7 @@ TclOONewForwardMethod(
     fmPtr = (ForwardMethod *)ckalloc(sizeof(ForwardMethod));
     fmPtr->prefixObj = prefixObj;
     Tcl_IncrRefCount(prefixObj);
-    return (Method *) Tcl_NewMethod(interp, (Tcl_Class) clsPtr, nameObj,
+    return (Method *) TclNewMethod(interp, (Tcl_Class) clsPtr, nameObj,
 	    flags, &fwdMethodType, fmPtr);
 }
 
@@ -1672,6 +1758,23 @@ Tcl_MethodName(
 }
 
 int
+TclMethodIsType(
+    Tcl_Method method,
+    const Tcl_MethodType *typePtr,
+    void **clientDataPtr)
+{
+    Method *mPtr = (Method *) method;
+
+    if (mPtr->typePtr == typePtr) {
+	if (clientDataPtr != NULL) {
+	    *clientDataPtr = mPtr->clientData;
+	}
+	return 1;
+    }
+    return 0;
+}
+
+int
 Tcl_MethodIsType(
     Tcl_Method method,
     const Tcl_MethodType *typePtr,
@@ -1679,6 +1782,9 @@ Tcl_MethodIsType(
 {
     Method *mPtr = (Method *) method;
 
+    if (typePtr->version > TCL_OO_METHOD_VERSION_1) {
+	Tcl_Panic("%s: Wrong version in typePtr->version, should be TCL_OO_METHOD_VERSION_1", "Tcl_MethodIsType");
+    }
     if (mPtr->typePtr == typePtr) {
 	if (clientDataPtr != NULL) {
 	    *clientDataPtr = mPtr->clientData;
@@ -1689,6 +1795,26 @@ Tcl_MethodIsType(
 }
 
 int
+Tcl_MethodIsType2(
+    Tcl_Method method,
+    const Tcl_MethodType2 *typePtr,
+    void **clientDataPtr)
+{
+    Method *mPtr = (Method *) method;
+
+    if (typePtr->version < TCL_OO_METHOD_VERSION_2) {
+	Tcl_Panic("%s: Wrong version in typePtr->version, should be TCL_OO_METHOD_VERSION_2", "Tcl_MethodIsType2");
+    }
+    if (mPtr->typePtr == (const Tcl_MethodType *)typePtr) {
+	if (clientDataPtr != NULL) {
+	    *clientDataPtr = mPtr->clientData;
+	}
+	return 1;
+    }
+    return 0;
+}
+
+int
 Tcl_MethodIsPublic(
     Tcl_Method method)
 {