summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--generic/tclOO.c16
-rw-r--r--generic/tclOODefineCmds.c6
-rw-r--r--generic/tclOOInt.h11
-rw-r--r--generic/tclOOMethod.c81
-rw-r--r--generic/tclStringObj.c2
-rw-r--r--unix/dltest/pkgooa.c6
6 files changed, 98 insertions, 24 deletions
diff --git a/generic/tclOO.c b/generic/tclOO.c
index bdceec4..5051659 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);
/*
@@ -2246,7 +2246,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;
@@ -2255,10 +2255,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;
@@ -2275,7 +2275,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;
@@ -2284,11 +2284,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/tclOODefineCmds.c b/generic/tclOODefineCmds.c
index 42c6637..686fd00 100644
--- a/generic/tclOODefineCmds.c
+++ b/generic/tclOODefineCmds.c
@@ -2286,12 +2286,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 9488271..0ff4adf 100644
--- a/generic/tclOOInt.h
+++ b/generic/tclOOInt.h
@@ -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 63e5e5a..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. */
@@ -188,6 +188,28 @@ Tcl_NewInstanceMethod(
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
@@ -206,7 +228,7 @@ Tcl_NewInstanceMethod2(
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 Tcl_NewInstanceMethod(NULL, object, nameObj, flags,
+ return TclNewInstanceMethod(NULL, object, nameObj, flags,
(const Tcl_MethodType *)typePtr, clientData);
}
@@ -221,7 +243,7 @@ Tcl_NewInstanceMethod2(
*/
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.,
@@ -279,6 +301,27 @@ Tcl_NewMethod(
}
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. */
@@ -296,7 +339,7 @@ Tcl_NewMethod2(
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 Tcl_NewMethod(NULL, cls, nameObj, flags, (const Tcl_MethodType *)typePtr, clientData);
+ return TclNewMethod(NULL, cls, nameObj, flags, (const Tcl_MethodType *)typePtr, clientData);
}
/*
@@ -347,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);
}
@@ -572,7 +615,7 @@ TclOOMakeProcInstanceMethod(
}
}
- return Tcl_NewInstanceMethod(interp, (Tcl_Object) oPtr, nameObj, flags,
+ return TclNewInstanceMethod(interp, (Tcl_Object) oPtr, nameObj, flags,
typePtr, clientData);
}
@@ -685,7 +728,7 @@ TclOOMakeProcMethod(
}
}
- return Tcl_NewMethod(interp, (Tcl_Class) clsPtr, nameObj, flags, typePtr,
+ return TclNewMethod(interp, (Tcl_Class) clsPtr, nameObj, flags, typePtr,
clientData);
}
@@ -1445,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);
}
@@ -1484,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);
}
@@ -1715,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,
@@ -1722,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;
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index 13d91d9..86b3937 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -564,7 +564,7 @@ Tcl_NewUnicodeObj(
String *stringPtr = (String *)ckalloc((offsetof(String, unicode)
+ sizeof(unsigned short)) + numChars * sizeof(unsigned short));
- memcpy(stringPtr->unicode, unicode, numChars);
+ memcpy(stringPtr->unicode, unicode, numChars * sizeof(unsigned short));
stringPtr->unicode[numChars] = 0;
stringPtr->numChars = numChars;
diff --git a/unix/dltest/pkgooa.c b/unix/dltest/pkgooa.c
index 369d894..ec9fbfd 100644
--- a/unix/dltest/pkgooa.c
+++ b/unix/dltest/pkgooa.c
@@ -115,7 +115,7 @@ Pkgooa_Init(
return TCL_ERROR;
}
if (tclStubsPtr == NULL) {
- Tcl_AppendResult(interp, "Tcl stubs are not inialized, "
+ Tcl_AppendResult(interp, "Tcl stubs are not initialized, "
"did you compile using -DUSE_TCL_STUBS? ");
return TCL_ERROR;
}
@@ -123,11 +123,11 @@ Pkgooa_Init(
return TCL_ERROR;
}
if (tclOOStubsPtr == NULL) {
- Tcl_AppendResult(interp, "TclOO stubs are not inialized");
+ Tcl_AppendResult(interp, "TclOO stubs are not initialized");
return TCL_ERROR;
}
if (tclOOIntStubsPtr == NULL) {
- Tcl_AppendResult(interp, "TclOO internal stubs are not inialized");
+ Tcl_AppendResult(interp, "TclOO internal stubs are not initialized");
return TCL_ERROR;
}
generated by cgit v0.12 at 2025-11-03 21:28:57 (GMT)