summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/tclExecute.c6
-rw-r--r--generic/tclOO.c16
-rw-r--r--generic/tclOO.decls14
-rw-r--r--generic/tclOO.h29
-rw-r--r--generic/tclOOCall.c6
-rw-r--r--generic/tclOODecls.h23
-rw-r--r--generic/tclOODefineCmds.c6
-rw-r--r--generic/tclOOInt.h21
-rw-r--r--generic/tclOOMethod.c140
-rw-r--r--generic/tclOOStubInit.c3
10 files changed, 235 insertions, 29 deletions
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index c8d2869..6221c19 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -4579,7 +4579,11 @@ TEBCresume(
Method *const mPtr =
contextPtr->callPtr->chain[newDepth].mPtr;
- return mPtr->typePtr->callProc(mPtr->clientData, interp,
+ if (mPtr->typePtr->version < TCL_OO_METHOD_VERSION_2) {
+ return mPtr->typePtr->callProc(mPtr->clientData, interp,
+ (Tcl_ObjectContext) contextPtr, opnd, objv);
+ }
+ return ((Tcl_MethodCallProc2 *)(void *)(mPtr->typePtr->callProc))(mPtr->clientData, interp,
(Tcl_ObjectContext) contextPtr, opnd, objv);
}
diff --git a/generic/tclOO.c b/generic/tclOO.c
index bc90335..5385f08 100644
--- a/generic/tclOO.c
+++ b/generic/tclOO.c
@@ -391,9 +391,9 @@ InitFoundation(
*/
TclNewLiteralStringObj(namePtr, "new");
- Tcl_NewInstanceMethod(interp, (Tcl_Object) fPtr->classCls->thisPtr,
+ TclNewInstanceMethod(interp, (Tcl_Object) fPtr->classCls->thisPtr,
namePtr /* keeps ref */, 0 /* private */, NULL, NULL);
- fPtr->classCls->constructorPtr = (Method *) Tcl_NewMethod(interp,
+ fPtr->classCls->constructorPtr = (Method *) TclNewMethod(interp,
(Tcl_Class) fPtr->classCls, NULL, 0, &classConstructor, NULL);
/*
@@ -2252,7 +2252,7 @@ CloneObjectMethod(
Tcl_Obj *namePtr)
{
if (mPtr->typePtr == NULL) {
- Tcl_NewInstanceMethod(interp, (Tcl_Object) oPtr, namePtr,
+ TclNewInstanceMethod(interp, (Tcl_Object) oPtr, namePtr,
mPtr->flags & PUBLIC_METHOD, NULL, NULL);
} else if (mPtr->typePtr->cloneProc) {
ClientData newClientData;
@@ -2261,10 +2261,10 @@ CloneObjectMethod(
&newClientData) != TCL_OK) {
return TCL_ERROR;
}
- Tcl_NewInstanceMethod(interp, (Tcl_Object) oPtr, namePtr,
+ TclNewInstanceMethod(interp, (Tcl_Object) oPtr, namePtr,
mPtr->flags & PUBLIC_METHOD, mPtr->typePtr, newClientData);
} else {
- Tcl_NewInstanceMethod(interp, (Tcl_Object) oPtr, namePtr,
+ TclNewInstanceMethod(interp, (Tcl_Object) oPtr, namePtr,
mPtr->flags & PUBLIC_METHOD, mPtr->typePtr, mPtr->clientData);
}
return TCL_OK;
@@ -2281,7 +2281,7 @@ CloneClassMethod(
Method *m2Ptr;
if (mPtr->typePtr == NULL) {
- m2Ptr = (Method *) Tcl_NewMethod(interp, (Tcl_Class) clsPtr,
+ m2Ptr = (Method *) TclNewMethod(interp, (Tcl_Class) clsPtr,
namePtr, mPtr->flags & PUBLIC_METHOD, NULL, NULL);
} else if (mPtr->typePtr->cloneProc) {
ClientData newClientData;
@@ -2290,11 +2290,11 @@ CloneClassMethod(
&newClientData) != TCL_OK) {
return TCL_ERROR;
}
- m2Ptr = (Method *) Tcl_NewMethod(interp, (Tcl_Class) clsPtr,
+ m2Ptr = (Method *) TclNewMethod(interp, (Tcl_Class) clsPtr,
namePtr, mPtr->flags & PUBLIC_METHOD, mPtr->typePtr,
newClientData);
} else {
- m2Ptr = (Method *) Tcl_NewMethod(interp, (Tcl_Class) clsPtr,
+ m2Ptr = (Method *) TclNewMethod(interp, (Tcl_Class) clsPtr,
namePtr, mPtr->flags & PUBLIC_METHOD, mPtr->typePtr,
mPtr->clientData);
}
diff --git a/generic/tclOO.decls b/generic/tclOO.decls
index 5a1cff2..d9adb4d 100644
--- a/generic/tclOO.decls
+++ b/generic/tclOO.decls
@@ -135,6 +135,20 @@ declare 30 {
declare 31 {
Tcl_Obj *Tcl_GetObjectClassName(Tcl_Interp *interp, Tcl_Object object)
}
+declare 32 {
+ int Tcl_MethodIsType2(Tcl_Method method, const Tcl_MethodType2 *typePtr,
+ void **clientDataPtr)
+}
+declare 33 {
+ Tcl_Method Tcl_NewInstanceMethod2(Tcl_Interp *interp, Tcl_Object object,
+ Tcl_Obj *nameObj, int flags, const Tcl_MethodType2 *typePtr,
+ void *clientData)
+}
+declare 34 {
+ Tcl_Method Tcl_NewMethod2(Tcl_Interp *interp, Tcl_Class cls,
+ Tcl_Obj *nameObj, int flags, const Tcl_MethodType2 *typePtr,
+ void *clientData)
+}
######################################################################
# Private API, exposed to support advanced OO systems that plug in on top of
diff --git a/generic/tclOO.h b/generic/tclOO.h
index 4a3398f..6f18491 100644
--- a/generic/tclOO.h
+++ b/generic/tclOO.h
@@ -24,8 +24,8 @@
* win/tclooConfig.sh
*/
-#define TCLOO_VERSION "1.2.0"
-#define TCLOO_PATCHLEVEL TCLOO_VERSION
+#define TCLOO_VERSION "1.3"
+#define TCLOO_PATCHLEVEL TCLOO_VERSION ".0"
#include "tcl.h"
@@ -40,7 +40,7 @@ extern "C" {
extern const char *TclOOInitializeStubs(
Tcl_Interp *, const char *version);
#define Tcl_OOInitStubs(interp) \
- TclOOInitializeStubs((interp), TCLOO_VERSION)
+ TclOOInitializeStubs((interp), TCLOO_PATCHLEVEL)
#ifndef USE_TCL_STUBS
# define TclOOInitializeStubs(interp, version) (TCLOO_PATCHLEVEL)
#endif
@@ -62,6 +62,8 @@ typedef struct Tcl_ObjectContext_ *Tcl_ObjectContext;
typedef int (Tcl_MethodCallProc)(void *clientData, Tcl_Interp *interp,
Tcl_ObjectContext objectContext, int objc, Tcl_Obj *const *objv);
+typedef int (Tcl_MethodCallProc2)(void *clientData, Tcl_Interp *interp,
+ Tcl_ObjectContext objectContext, size_t objc, Tcl_Obj *const *objv);
typedef void (Tcl_MethodDeleteProc)(void *clientData);
typedef int (Tcl_CloneProc)(Tcl_Interp *interp, void *oldClientData,
void **newClientData);
@@ -77,7 +79,7 @@ typedef int (Tcl_ObjectMapMethodNameProc)(Tcl_Interp *interp,
typedef struct {
int version; /* Structure version field. Always to be equal
- * to TCL_OO_METHOD_VERSION_CURRENT in
+ * to TCL_OO_METHOD_VERSION_(1|CURRENT) in
* declarations. */
const char *name; /* Name of this type of method, mostly for
* debugging purposes. */
@@ -92,12 +94,31 @@ typedef struct {
* be copied directly. */
} Tcl_MethodType;
+typedef struct {
+ int version; /* Structure version field. Always to be equal
+ * to TCL_OO_METHOD_VERSION_2 in
+ * declarations. */
+ const char *name; /* Name of this type of method, mostly for
+ * debugging purposes. */
+ Tcl_MethodCallProc2 *callProc;
+ /* How to invoke this method. */
+ Tcl_MethodDeleteProc *deleteProc;
+ /* How to delete this method's type-specific
+ * data, or NULL if the type-specific data
+ * does not need deleting. */
+ Tcl_CloneProc *cloneProc; /* How to copy this method's type-specific
+ * data, or NULL if the type-specific data can
+ * be copied directly. */
+} Tcl_MethodType2;
+
/*
* The correct value for the version field of the Tcl_MethodType structure.
* This allows new versions of the structure to be introduced without breaking
* binary compatibility.
*/
+#define TCL_OO_METHOD_VERSION_1 1
+#define TCL_OO_METHOD_VERSION_2 2
#define TCL_OO_METHOD_VERSION_CURRENT 1
/*
diff --git a/generic/tclOOCall.c b/generic/tclOOCall.c
index 3bd96a2..6e834cb 100644
--- a/generic/tclOOCall.c
+++ b/generic/tclOOCall.c
@@ -369,7 +369,11 @@ TclOOInvokeContext(
* Run the method implementation.
*/
- return mPtr->typePtr->callProc(mPtr->clientData, interp,
+ if (mPtr->typePtr->version < TCL_OO_METHOD_VERSION_2) {
+ return (mPtr->typePtr->callProc)(mPtr->clientData, interp,
+ (Tcl_ObjectContext) contextPtr, objc, objv);
+ }
+ return ((Tcl_MethodCallProc2 *)(void *)(mPtr->typePtr->callProc))(mPtr->clientData, interp,
(Tcl_ObjectContext) contextPtr, objc, objv);
}
diff --git a/generic/tclOODecls.h b/generic/tclOODecls.h
index 3e31bc9..7cfa039 100644
--- a/generic/tclOODecls.h
+++ b/generic/tclOODecls.h
@@ -123,6 +123,20 @@ TCLAPI Tcl_Class Tcl_GetClassOfObject(Tcl_Object object);
/* 31 */
TCLAPI Tcl_Obj * Tcl_GetObjectClassName(Tcl_Interp *interp,
Tcl_Object object);
+/* 32 */
+TCLAPI int Tcl_MethodIsType2(Tcl_Method method,
+ const Tcl_MethodType2 *typePtr,
+ void **clientDataPtr);
+/* 33 */
+TCLAPI Tcl_Method Tcl_NewInstanceMethod2(Tcl_Interp *interp,
+ Tcl_Object object, Tcl_Obj *nameObj,
+ int flags, const Tcl_MethodType2 *typePtr,
+ void *clientData);
+/* 34 */
+TCLAPI Tcl_Method Tcl_NewMethod2(Tcl_Interp *interp, Tcl_Class cls,
+ Tcl_Obj *nameObj, int flags,
+ const Tcl_MethodType2 *typePtr,
+ void *clientData);
typedef struct {
const struct TclOOIntStubs *tclOOIntStubs;
@@ -164,6 +178,9 @@ typedef struct TclOOStubs {
int (*tcl_MethodIsPrivate) (Tcl_Method method); /* 29 */
Tcl_Class (*tcl_GetClassOfObject) (Tcl_Object object); /* 30 */
Tcl_Obj * (*tcl_GetObjectClassName) (Tcl_Interp *interp, Tcl_Object object); /* 31 */
+ int (*tcl_MethodIsType2) (Tcl_Method method, const Tcl_MethodType2 *typePtr, void **clientDataPtr); /* 32 */
+ Tcl_Method (*tcl_NewInstanceMethod2) (Tcl_Interp *interp, Tcl_Object object, Tcl_Obj *nameObj, int flags, const Tcl_MethodType2 *typePtr, void *clientData); /* 33 */
+ Tcl_Method (*tcl_NewMethod2) (Tcl_Interp *interp, Tcl_Class cls, Tcl_Obj *nameObj, int flags, const Tcl_MethodType2 *typePtr, void *clientData); /* 34 */
} TclOOStubs;
extern const TclOOStubs *tclOOStubsPtr;
@@ -242,6 +259,12 @@ extern const TclOOStubs *tclOOStubsPtr;
(tclOOStubsPtr->tcl_GetClassOfObject) /* 30 */
#define Tcl_GetObjectClassName \
(tclOOStubsPtr->tcl_GetObjectClassName) /* 31 */
+#define Tcl_MethodIsType2 \
+ (tclOOStubsPtr->tcl_MethodIsType2) /* 32 */
+#define Tcl_NewInstanceMethod2 \
+ (tclOOStubsPtr->tcl_NewInstanceMethod2) /* 33 */
+#define Tcl_NewMethod2 \
+ (tclOOStubsPtr->tcl_NewMethod2) /* 34 */
#endif /* defined(USE_TCLOO_STUBS) */
diff --git a/generic/tclOODefineCmds.c b/generic/tclOODefineCmds.c
index 42c9796..63aca58 100644
--- a/generic/tclOODefineCmds.c
+++ b/generic/tclOODefineCmds.c
@@ -2288,12 +2288,12 @@ TclOODefineSlots(
if (slotObject == NULL) {
continue;
}
- Tcl_NewInstanceMethod(fPtr->interp, slotObject, getName, 0,
+ TclNewInstanceMethod(fPtr->interp, slotObject, getName, 0,
&slotInfoPtr->getterType, NULL);
- Tcl_NewInstanceMethod(fPtr->interp, slotObject, setName, 0,
+ TclNewInstanceMethod(fPtr->interp, slotObject, setName, 0,
&slotInfoPtr->setterType, NULL);
if (slotInfoPtr->resolverType.callProc) {
- Tcl_NewInstanceMethod(fPtr->interp, slotObject, resolveName, 0,
+ TclNewInstanceMethod(fPtr->interp, slotObject, resolveName, 0,
&slotInfoPtr->resolverType, NULL);
}
}
diff --git a/generic/tclOOInt.h b/generic/tclOOInt.h
index 6f0945b..2ef4752 100644
--- a/generic/tclOOInt.h
+++ b/generic/tclOOInt.h
@@ -235,14 +235,14 @@ typedef struct Object {
* other spots). */
#define FORCE_UNKNOWN 0x10000 /* States that we are *really* looking up the
* unknown method handler at that point. */
-#define HAS_PRIVATE_METHODS 0x20000
- /* Object/class has (or had) private methods,
- * and so shouldn't be cached so
- * aggressively. */
-#define DONT_DELETE 0x40000 /* Inhibit deletion of this object. Used
+#define DONT_DELETE 0x20000 /* Inhibit deletion of this object. Used
* during fundamental object type mutation to
* make sure that the object actually survives
* to the end of the operation. */
+#define HAS_PRIVATE_METHODS 0x40000
+ /* Object/class has (or had) private methods,
+ * and so shouldn't be cached so
+ * aggressively. */
/*
* And the definition of a class. Note that every class also has an associated
@@ -492,6 +492,17 @@ MODULE_SCOPE void TclOOAddToMixinSubs(Class *subPtr, Class *mixinPtr);
MODULE_SCOPE void TclOOAddToSubclasses(Class *subPtr, Class *superPtr);
MODULE_SCOPE Class * TclOOAllocClass(Tcl_Interp *interp,
Object *useThisObj);
+MODULE_SCOPE int TclMethodIsType(Tcl_Method method,
+ const Tcl_MethodType *typePtr,
+ void **clientDataPtr);
+MODULE_SCOPE Tcl_Method TclNewInstanceMethod(Tcl_Interp *interp,
+ Tcl_Object object, Tcl_Obj *nameObj,
+ int flags, const Tcl_MethodType *typePtr,
+ void *clientData);
+MODULE_SCOPE Tcl_Method TclNewMethod(Tcl_Interp *interp, Tcl_Class cls,
+ Tcl_Obj *nameObj, int flags,
+ const Tcl_MethodType *typePtr,
+ void *clientData);
MODULE_SCOPE int TclNRNewObjectInstance(Tcl_Interp *interp,
Tcl_Class cls, const char *nameStr,
const char *nsNameStr, int objc,
diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c
index a63ae07..70f9503 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);
}
@@ -1403,7 +1489,7 @@ TclOONewForwardInstanceMethod(
fmPtr = (ForwardMethod *)Tcl_Alloc(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);
}
@@ -1442,7 +1528,7 @@ TclOONewForwardMethod(
fmPtr = (ForwardMethod *)Tcl_Alloc(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);
}
@@ -1674,6 +1760,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,
@@ -1681,6 +1784,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;
@@ -1691,6 +1797,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)
{
diff --git a/generic/tclOOStubInit.c b/generic/tclOOStubInit.c
index b9034f0..7b653cb 100644
--- a/generic/tclOOStubInit.c
+++ b/generic/tclOOStubInit.c
@@ -76,6 +76,9 @@ const TclOOStubs tclOOStubs = {
Tcl_MethodIsPrivate, /* 29 */
Tcl_GetClassOfObject, /* 30 */
Tcl_GetObjectClassName, /* 31 */
+ Tcl_MethodIsType2, /* 32 */
+ Tcl_NewInstanceMethod2, /* 33 */
+ Tcl_NewMethod2, /* 34 */
};
/* !END!: Do not edit above this line. */
generated by cgit v0.12 at 2024-10-28 04:20:19 (GMT)