summaryrefslogtreecommitdiffstats
path: root/generic/tclOO.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclOO.c')
-rw-r--r--generic/tclOO.c109
1 files changed, 56 insertions, 53 deletions
diff --git a/generic/tclOO.c b/generic/tclOO.c
index 8710a89..e31008a 100644
--- a/generic/tclOO.c
+++ b/generic/tclOO.c
@@ -77,13 +77,10 @@ static inline void InitClassPath(Tcl_Interp * interp, Class *clsPtr);
static void InitClassSystemRoots(Tcl_Interp *interp,
Foundation *fPtr);
static int InitFoundation(Tcl_Interp *interp);
-static void KillFoundation(ClientData clientData,
- Tcl_Interp *interp);
+static Tcl_InterpDeleteProc KillFoundation;
static void MyDeleted(ClientData clientData);
static void ObjectNamespaceDeleted(ClientData clientData);
-static void ObjectRenamedTrace(ClientData clientData,
- Tcl_Interp *interp, const char *oldName,
- const char *newName, int flags);
+static Tcl_CommandTraceProc ObjectRenamedTrace;
static inline void RemoveClass(Class **list, int num, int idx);
static inline void RemoveObject(Object **list, int num, int idx);
static inline void SquelchCachedName(Object *oPtr);
@@ -136,12 +133,15 @@ static const Tcl_MethodType classConstructor = {
};
/*
- * Scripted parts of TclOO. First, the master script (cannot be outside this
+ * Scripted parts of TclOO. First, the main script (cannot be outside this
* file).
*/
static const char *initScript =
+#ifndef TCL_NO_DEPRECATED
"package ifneeded TclOO " TCLOO_PATCHLEVEL " {# Already present, OK?};"
+#endif
+"package ifneeded tcl::oo " TCLOO_PATCHLEVEL " {# Already present, OK?};"
"namespace eval ::oo { variable version " TCLOO_VERSION " };"
"namespace eval ::oo { variable patchlevel " TCLOO_PATCHLEVEL " };";
/* "tcl_findLibrary tcloo $oo::version $oo::version" */
@@ -260,8 +260,12 @@ TclOOInit(
return TCL_ERROR;
}
- return Tcl_PkgProvideEx(interp, "TclOO", TCLOO_PATCHLEVEL,
- (ClientData) &tclOOStubs);
+#ifndef TCL_NO_DEPRECATED
+ Tcl_PkgProvideEx(interp, "TclOO", TCLOO_PATCHLEVEL,
+ (void *) &tclOOStubs);
+#endif
+ return Tcl_PkgProvideEx(interp, "tcl::oo", TCLOO_PATCHLEVEL,
+ (void *) &tclOOStubs);
}
/*
@@ -299,8 +303,8 @@ InitFoundation(
{
static Tcl_ThreadDataKey tsdKey;
ThreadLocalData *tsdPtr =
- Tcl_GetThreadData(&tsdKey, sizeof(ThreadLocalData));
- Foundation *fPtr = ckalloc(sizeof(Foundation));
+ (ThreadLocalData *)Tcl_GetThreadData(&tsdKey, sizeof(ThreadLocalData));
+ Foundation *fPtr = (Foundation *)ckalloc(sizeof(Foundation));
Tcl_Obj *namePtr;
Tcl_DString buffer;
Command *cmdPtr;
@@ -534,7 +538,7 @@ static void
DeletedDefineNamespace(
ClientData clientData)
{
- Foundation *fPtr = clientData;
+ Foundation *fPtr = (Foundation *)clientData;
fPtr->defineNs = NULL;
}
@@ -543,7 +547,7 @@ static void
DeletedObjdefNamespace(
ClientData clientData)
{
- Foundation *fPtr = clientData;
+ Foundation *fPtr = (Foundation *)clientData;
fPtr->objdefNs = NULL;
}
@@ -552,7 +556,7 @@ static void
DeletedHelpersNamespace(
ClientData clientData)
{
- Foundation *fPtr = clientData;
+ Foundation *fPtr = (Foundation *)clientData;
fPtr->helpersNs = NULL;
}
@@ -570,10 +574,9 @@ DeletedHelpersNamespace(
static void
KillFoundation(
- ClientData clientData, /* Pointer to the OO system foundation
- * structure. */
- Tcl_Interp *interp) /* The interpreter containing the OO system
- * foundation. */
+ TCL_UNUSED(void *),
+ Tcl_Interp *interp) /* The interpreter containing the OO system
+ * foundation. */
{
Foundation *fPtr = GetFoundation(interp);
@@ -625,7 +628,7 @@ AllocObject(
CommandTrace *tracePtr;
int creationEpoch;
- oPtr = ckalloc(sizeof(Object));
+ oPtr = (Object *)ckalloc(sizeof(Object));
memset(oPtr, 0, sizeof(Object));
/*
@@ -736,7 +739,7 @@ AllocObject(
cmdPtr = (Command *) oPtr->command;
cmdPtr->nreProc = PublicNRObjectCmd;
- cmdPtr->tracePtr = tracePtr = ckalloc(sizeof(CommandTrace));
+ cmdPtr->tracePtr = tracePtr = (CommandTrace *)ckalloc(sizeof(CommandTrace));
tracePtr->traceProc = ObjectRenamedTrace;
tracePtr->clientData = oPtr;
tracePtr->flags = TCL_TRACE_RENAME|TCL_TRACE_DELETE;
@@ -790,7 +793,7 @@ MyDeleted(
ClientData clientData) /* Reference to the object whose [my] has been
* squelched. */
{
- Object *oPtr = clientData;
+ Object *oPtr = (Object *)clientData;
oPtr->myCommand = NULL;
}
@@ -799,7 +802,7 @@ static void
MyClassDeleted(
ClientData clientData)
{
- Object *oPtr = clientData;
+ Object *oPtr = (Object *)clientData;
oPtr->myclassCommand = NULL;
}
@@ -819,12 +822,12 @@ MyClassDeleted(
static void
ObjectRenamedTrace(
ClientData clientData, /* The object being deleted. */
- Tcl_Interp *interp, /* The interpreter containing the object. */
- const char *oldName, /* What the object was (last) called. */
- const char *newName, /* What it's getting renamed to. (unused) */
+ TCL_UNUSED(Tcl_Interp *),
+ TCL_UNUSED(const char *) /*oldName*/,
+ TCL_UNUSED(const char *) /*newName*/,
int flags) /* Why was the object deleted? */
{
- Object *oPtr = clientData;
+ Object *oPtr = (Object *)clientData;
/*
* If this is a rename and not a delete of the object, we just flush the
@@ -1134,7 +1137,7 @@ ObjectNamespaceDeleted(
ClientData clientData) /* Pointer to the class whose namespace is
* being deleted. */
{
- Object *oPtr = clientData;
+ Object *oPtr = (Object *)clientData;
Foundation *fPtr = oPtr->fPtr;
FOREACH_HASH_DECLS;
Class *mixinPtr;
@@ -1205,7 +1208,7 @@ ObjectNamespaceDeleted(
* freed memory.
*/
- if (((Command *) oPtr->command)->flags && CMD_IS_DELETED) {
+ if (((Command *) oPtr->command)->flags && CMD_DYING) {
/*
* Something has already started the command deletion process. We can
* go ahead and clean up the the namespace,
@@ -1441,9 +1444,9 @@ TclOOAddToInstances(
if (clsPtr->instances.num >= clsPtr->instances.size) {
clsPtr->instances.size += ALLOC_CHUNK;
if (clsPtr->instances.size == ALLOC_CHUNK) {
- clsPtr->instances.list = ckalloc(sizeof(Object *) * ALLOC_CHUNK);
+ clsPtr->instances.list = (Object **)ckalloc(sizeof(Object *) * ALLOC_CHUNK);
} else {
- clsPtr->instances.list = ckrealloc(clsPtr->instances.list,
+ clsPtr->instances.list = (Object **)ckrealloc(clsPtr->instances.list,
sizeof(Object *) * clsPtr->instances.size);
}
}
@@ -1540,9 +1543,9 @@ TclOOAddToSubclasses(
if (superPtr->subclasses.num >= superPtr->subclasses.size) {
superPtr->subclasses.size += ALLOC_CHUNK;
if (superPtr->subclasses.size == ALLOC_CHUNK) {
- superPtr->subclasses.list = ckalloc(sizeof(Class *) * ALLOC_CHUNK);
+ superPtr->subclasses.list = (Class **)ckalloc(sizeof(Class *) * ALLOC_CHUNK);
} else {
- superPtr->subclasses.list = ckrealloc(superPtr->subclasses.list,
+ superPtr->subclasses.list = (Class **)ckrealloc(superPtr->subclasses.list,
sizeof(Class *) * superPtr->subclasses.size);
}
}
@@ -1605,9 +1608,9 @@ TclOOAddToMixinSubs(
if (superPtr->mixinSubs.num >= superPtr->mixinSubs.size) {
superPtr->mixinSubs.size += ALLOC_CHUNK;
if (superPtr->mixinSubs.size == ALLOC_CHUNK) {
- superPtr->mixinSubs.list = ckalloc(sizeof(Class *) * ALLOC_CHUNK);
+ superPtr->mixinSubs.list = (Class **)ckalloc(sizeof(Class *) * ALLOC_CHUNK);
} else {
- superPtr->mixinSubs.list = ckrealloc(superPtr->mixinSubs.list,
+ superPtr->mixinSubs.list = (Class **)ckrealloc(superPtr->mixinSubs.list,
sizeof(Class *) * superPtr->mixinSubs.size);
}
}
@@ -1653,7 +1656,7 @@ TclOOAllocClass(
* representation. */
{
Foundation *fPtr = GetFoundation(interp);
- Class *clsPtr = ckalloc(sizeof(Class));
+ Class *clsPtr = (Class *)ckalloc(sizeof(Class));
memset(clsPtr, 0, sizeof(Class));
clsPtr->thisPtr = useThisObj;
@@ -1670,7 +1673,7 @@ TclOOAllocClass(
*/
clsPtr->superclasses.num = 1;
- clsPtr->superclasses.list = ckalloc(sizeof(Class *));
+ clsPtr->superclasses.list = (Class **)ckalloc(sizeof(Class *));
clsPtr->superclasses.list[0] = fPtr->objectCls;
AddRef(fPtr->objectCls->thisPtr);
@@ -1898,10 +1901,10 @@ FinalizeAlloc(
Tcl_Interp *interp,
int result)
{
- CallContext *contextPtr = data[0];
- Object *oPtr = data[1];
- Tcl_InterpState state = data[2];
- Tcl_Object *objectPtr = data[3];
+ CallContext *contextPtr = (CallContext *)data[0];
+ Object *oPtr = (Object *)data[1];
+ Tcl_InterpState state = (Tcl_InterpState)data[2];
+ Tcl_Object *objectPtr = (Tcl_Object *)data[3];
/*
* Ensure an error if the object was deleted in the constructor. Don't
@@ -2121,11 +2124,11 @@ Tcl_CopyObjectInstance(
TclOODecrRefCount(superPtr->thisPtr);
}
if (cls2Ptr->superclasses.num) {
- cls2Ptr->superclasses.list = ckrealloc(cls2Ptr->superclasses.list,
+ cls2Ptr->superclasses.list = (Class **) ckrealloc(cls2Ptr->superclasses.list,
sizeof(Class *) * clsPtr->superclasses.num);
} else {
cls2Ptr->superclasses.list =
- ckalloc(sizeof(Class *) * clsPtr->superclasses.num);
+ (Class **)ckalloc(sizeof(Class *) * clsPtr->superclasses.num);
}
memcpy(cls2Ptr->superclasses.list, clsPtr->superclasses.list,
sizeof(Class *) * clsPtr->superclasses.num);
@@ -2419,7 +2422,7 @@ Tcl_ClassSetMetadata(
if (metadata == NULL) {
return;
}
- clsPtr->metadataPtr = ckalloc(sizeof(Tcl_HashTable));
+ clsPtr->metadataPtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable));
Tcl_InitHashTable(clsPtr->metadataPtr, TCL_ONE_WORD_KEYS);
}
@@ -2499,7 +2502,7 @@ Tcl_ObjectSetMetadata(
if (metadata == NULL) {
return;
}
- oPtr->metadataPtr = ckalloc(sizeof(Tcl_HashTable));
+ oPtr->metadataPtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable));
Tcl_InitHashTable(oPtr->metadataPtr, TCL_ONE_WORD_KEYS);
}
@@ -2558,7 +2561,7 @@ PublicNRObjectCmd(
int objc,
Tcl_Obj *const *objv)
{
- return TclOOObjectCmdCore(clientData, interp, objc, objv, PUBLIC_METHOD,
+ return TclOOObjectCmdCore((Object *)clientData, interp, objc, objv, PUBLIC_METHOD,
NULL);
}
@@ -2579,7 +2582,7 @@ PrivateNRObjectCmd(
int objc,
Tcl_Obj *const *objv)
{
- return TclOOObjectCmdCore(clientData, interp, objc, objv, 0, NULL);
+ return TclOOObjectCmdCore((Object *)clientData, interp, objc, objv, 0, NULL);
}
int
@@ -2640,7 +2643,7 @@ MyClassNRObjCmd(
int objc,
Tcl_Obj *const *objv)
{
- Object *oPtr = clientData;
+ Object *oPtr = (Object *)clientData;
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "methodName ?arg ...?");
@@ -2699,7 +2702,7 @@ TclOOObjectCmdCore(
*/
if (framePtr->isProcCallFrame & FRAME_IS_METHOD) {
- CallContext *callerContextPtr = framePtr->clientData;
+ CallContext *callerContextPtr = (CallContext *)framePtr->clientData;
Method *callerMethodPtr =
callerContextPtr->callPtr->chain[callerContextPtr->index].mPtr;
@@ -2808,7 +2811,7 @@ TclOOObjectCmdCore(
static int
FinalizeObjectCall(
ClientData data[],
- Tcl_Interp *interp,
+ TCL_UNUSED(Tcl_Interp *),
int result)
{
/*
@@ -2816,7 +2819,7 @@ FinalizeObjectCall(
* structure.
*/
- TclOODeleteContext(data[0]);
+ TclOODeleteContext((CallContext *)data[0]);
return result;
}
@@ -2969,10 +2972,10 @@ TclNRObjectContextInvokeNext(
static int
FinalizeNext(
ClientData data[],
- Tcl_Interp *interp,
+ TCL_UNUSED(Tcl_Interp *),
int result)
{
- CallContext *contextPtr = data[0];
+ CallContext *contextPtr = (CallContext *)data[0];
/*
* Restore the call chain context index as we've finished the inner invoke
@@ -3013,7 +3016,7 @@ Tcl_GetObjectFromObj(
goto notAnObject;
}
}
- return cmdPtr->objClientData;
+ return (Tcl_Object)cmdPtr->objClientData;
notAnObject:
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
@@ -3086,7 +3089,7 @@ TclOOObjectName(
if (oPtr->cachedNameObj) {
return oPtr->cachedNameObj;
}
- namePtr = Tcl_NewObj();
+ TclNewObj(namePtr);
Tcl_GetCommandFullName(interp, oPtr->command, namePtr);
Tcl_IncrRefCount(namePtr);
oPtr->cachedNameObj = namePtr;
generated by cgit v0.12 at 2024-11-16 04:48:49 (GMT)