diff options
Diffstat (limited to 'generic/tclOO.c')
| -rw-r--r-- | generic/tclOO.c | 377 |
1 files changed, 200 insertions, 177 deletions
diff --git a/generic/tclOO.c b/generic/tclOO.c index 1376d4e..461fc54 100644 --- a/generic/tclOO.c +++ b/generic/tclOO.c @@ -17,7 +17,7 @@ #include "tclOOInt.h" /* - * Commands in oo::define. + * Commands in oo::define and oo::objdefine. */ static const struct { @@ -67,8 +67,6 @@ static int CloneClassMethod(Tcl_Interp *interp, Class *clsPtr, Method **newMPtrPtr); static int CloneObjectMethod(Tcl_Interp *interp, Object *oPtr, Method *mPtr, Tcl_Obj *namePtr); -static void DeletedDefineNamespace(void *clientData); -static void DeletedObjdefNamespace(void *clientData); static void DeletedHelpersNamespace(void *clientData); static Tcl_NRPostProc FinalizeAlloc; static Tcl_NRPostProc FinalizeNext; @@ -120,6 +118,9 @@ static const DeclaredClassMethod objMethods[] = { DCM("new", 1, TclOO_Class_New), DCM("createWithNamespace", 0, TclOO_Class_CreateNs), {NULL, 0, {0, NULL, NULL, NULL, NULL}} +}, cfgMethods[] = { + DCM("configure", 1, TclOO_Configurable_Configure), + {NULL, 0, {0, NULL, NULL, NULL, NULL}} }; /* @@ -288,6 +289,37 @@ TclOOGetFoundation( /* * ---------------------------------------------------------------------- * + * CreateCmdInNS -- + * + * Create a command in a namespace. Supports setting various + * implementation functions, but not a deletion callback or a clientData; + * it's suitable for use-cases in this file, no more. + * + * ---------------------------------------------------------------------- + */ +static inline void +CreateCmdInNS( + Tcl_Interp *interp, + Tcl_Namespace *namespacePtr, + const char *name, + Tcl_ObjCmdProc *cmdProc, + Tcl_ObjCmdProc *nreProc, + CompileProc *compileProc) +{ + Command *cmdPtr; + + if (cmdProc == NULL && nreProc == NULL) { + Tcl_Panic("must supply at least one implementation function"); + } + cmdPtr = (Command *) TclCreateObjCommandInNs(interp, name, + namespacePtr, cmdProc, NULL, NULL); + cmdPtr->nreProc = nreProc; + cmdPtr->compileProc = compileProc; +} + +/* + * ---------------------------------------------------------------------- + * * InitFoundation -- * * Set up the core of the OO core class system. This is a structure @@ -302,12 +334,11 @@ InitFoundation( Tcl_Interp *interp) { static Tcl_ThreadDataKey tsdKey; - ThreadLocalData *tsdPtr = - (ThreadLocalData *)Tcl_GetThreadData(&tsdKey, sizeof(ThreadLocalData)); - Foundation *fPtr = (Foundation *)Tcl_Alloc(sizeof(Foundation)); + ThreadLocalData *tsdPtr = (ThreadLocalData *) + Tcl_GetThreadData(&tsdKey, sizeof(ThreadLocalData)); + Foundation *fPtr = (Foundation *) Tcl_Alloc(sizeof(Foundation)); + Tcl_Namespace *define, *objdef; Tcl_Obj *namePtr; - Tcl_DString buffer; - Command *cmdPtr; size_t i; /* @@ -321,49 +352,45 @@ InitFoundation( fPtr->interp = interp; fPtr->ooNs = Tcl_CreateNamespace(interp, "::oo", fPtr, NULL); Tcl_Export(interp, fPtr->ooNs, "[a-z]*", 1); - fPtr->defineNs = Tcl_CreateNamespace(interp, "::oo::define", fPtr, - DeletedDefineNamespace); - fPtr->objdefNs = Tcl_CreateNamespace(interp, "::oo::objdefine", fPtr, - DeletedObjdefNamespace); + define = Tcl_CreateNamespace(interp, "::oo::define", fPtr, NULL); + objdef = Tcl_CreateNamespace(interp, "::oo::objdefine", fPtr, NULL); fPtr->helpersNs = Tcl_CreateNamespace(interp, "::oo::Helpers", fPtr, DeletedHelpersNamespace); Tcl_CreateNamespace(interp, "::oo::configuresupport", NULL, NULL); fPtr->epoch = 1; fPtr->tsdPtr = tsdPtr; + TclNewLiteralStringObj(fPtr->unknownMethodNameObj, "unknown"); TclNewLiteralStringObj(fPtr->constructorName, "<constructor>"); TclNewLiteralStringObj(fPtr->destructorName, "<destructor>"); TclNewLiteralStringObj(fPtr->clonedName, "<cloned>"); TclNewLiteralStringObj(fPtr->defineName, "::oo::define"); + TclNewLiteralStringObj(fPtr->myName, "my"); Tcl_IncrRefCount(fPtr->unknownMethodNameObj); Tcl_IncrRefCount(fPtr->constructorName); Tcl_IncrRefCount(fPtr->destructorName); Tcl_IncrRefCount(fPtr->clonedName); Tcl_IncrRefCount(fPtr->defineName); - Tcl_CreateObjCommand(interp, "::oo::UnknownDefinition", + Tcl_IncrRefCount(fPtr->myName); + + TclCreateObjCommandInNs(interp, "UnknownDefinition", fPtr->ooNs, TclOOUnknownDefinition, NULL, NULL); TclNewLiteralStringObj(namePtr, "::oo::UnknownDefinition"); - Tcl_SetNamespaceUnknownHandler(interp, fPtr->defineNs, namePtr); - Tcl_SetNamespaceUnknownHandler(interp, fPtr->objdefNs, namePtr); + Tcl_SetNamespaceUnknownHandler(interp, define, namePtr); + Tcl_SetNamespaceUnknownHandler(interp, objdef, namePtr); + Tcl_BounceRefCount(namePtr); /* * Create the subcommands in the oo::define and oo::objdefine spaces. */ - Tcl_DStringInit(&buffer); for (i = 0 ; defineCmds[i].name ; i++) { - TclDStringAppendLiteral(&buffer, "::oo::define::"); - Tcl_DStringAppend(&buffer, defineCmds[i].name, -1); - Tcl_CreateObjCommand(interp, Tcl_DStringValue(&buffer), + TclCreateObjCommandInNs(interp, defineCmds[i].name, define, defineCmds[i].objProc, INT2PTR(defineCmds[i].flag), NULL); - Tcl_DStringFree(&buffer); } for (i = 0 ; objdefCmds[i].name ; i++) { - TclDStringAppendLiteral(&buffer, "::oo::objdefine::"); - Tcl_DStringAppend(&buffer, objdefCmds[i].name, -1); - Tcl_CreateObjCommand(interp, Tcl_DStringValue(&buffer), + TclCreateObjCommandInNs(interp, objdefCmds[i].name, objdef, objdefCmds[i].objProc, INT2PTR(objdefCmds[i].flag), NULL); - Tcl_DStringFree(&buffer); } Tcl_CallWhenDeleted(interp, KillFoundation, NULL); @@ -379,10 +406,10 @@ InitFoundation( */ for (i = 0 ; objMethods[i].name ; i++) { - TclOONewBasicMethod(interp, fPtr->objectCls, &objMethods[i]); + TclOONewBasicMethod(fPtr->objectCls, &objMethods[i]); } for (i = 0 ; clsMethods[i].name ; i++) { - TclOONewBasicMethod(interp, fPtr->classCls, &clsMethods[i]); + TclOONewBasicMethod(fPtr->classCls, &clsMethods[i]); } /* @@ -394,7 +421,8 @@ InitFoundation( TclNewLiteralStringObj(namePtr, "new"); TclNewInstanceMethod(interp, (Tcl_Object) fPtr->classCls->thisPtr, namePtr /* keeps ref */, 0 /* private */, NULL, NULL); - fPtr->classCls->constructorPtr = (Method *) TclNewMethod(interp, + Tcl_BounceRefCount(namePtr); + fPtr->classCls->constructorPtr = (Method *) TclNewMethod( (Tcl_Class) fPtr->classCls, NULL, 0, &classConstructor, NULL); /* @@ -402,20 +430,17 @@ InitFoundation( * ensemble. */ - cmdPtr = (Command *) Tcl_NRCreateCommand(interp, "::oo::Helpers::next", - NULL, TclOONextObjCmd, NULL, NULL); - cmdPtr->compileProc = TclCompileObjectNextCmd; - cmdPtr = (Command *) Tcl_NRCreateCommand(interp, "::oo::Helpers::nextto", - NULL, TclOONextToObjCmd, NULL, NULL); - cmdPtr->compileProc = TclCompileObjectNextToCmd; - cmdPtr = (Command *) Tcl_CreateObjCommand(interp, "::oo::Helpers::self", - TclOOSelfObjCmd, NULL, NULL); - cmdPtr->compileProc = TclCompileObjectSelfCmd; - Tcl_CreateObjCommand(interp, "::oo::define", TclOODefineObjCmd, NULL, - NULL); - Tcl_CreateObjCommand(interp, "::oo::objdefine", TclOOObjDefObjCmd, NULL, - NULL); - Tcl_CreateObjCommand(interp, "::oo::copy", TclOOCopyObjectCmd, NULL,NULL); + CreateCmdInNS(interp, fPtr->helpersNs, "next", + NULL, TclOONextObjCmd, TclCompileObjectNextCmd); + CreateCmdInNS(interp, fPtr->helpersNs, "nextto", + NULL, TclOONextToObjCmd, TclCompileObjectNextToCmd); + CreateCmdInNS(interp, fPtr->helpersNs, "self", + TclOOSelfObjCmd, NULL, TclCompileObjectSelfCmd); + + CreateCmdInNS(interp, fPtr->ooNs, "define", TclOODefineObjCmd, NULL, NULL); + CreateCmdInNS(interp, fPtr->ooNs, "objdefine", TclOOObjDefObjCmd, NULL, NULL); + CreateCmdInNS(interp, fPtr->ooNs, "copy", TclOOCopyObjectCmd, NULL, NULL); + TclOOInitInfo(interp); /* @@ -427,6 +452,28 @@ InitFoundation( } /* + * Make the configurable class and install its standard defined method. + */ + + Tcl_Object cfgCls = Tcl_NewObjectInstance(interp, + (Tcl_Class) fPtr->classCls, + "::oo::configuresupport::configurable", NULL, -1, NULL, 0); + for (i = 0 ; cfgMethods[i].name ; i++) { + TclOONewBasicMethod(((Object *) cfgCls)->classPtr, &cfgMethods[i]); + } + + /* + * Don't have handles to these namespaces, so use Tcl_CreateObjCommand. + */ + + Tcl_CreateObjCommand(interp, + "::oo::configuresupport::configurableobject::property", + TclOODefinePropertyCmd, (void *) 1, NULL); + Tcl_CreateObjCommand(interp, + "::oo::configuresupport::configurableclass::property", + TclOODefinePropertyCmd, (void *) 0, NULL); + + /* * Evaluate the remaining definitions, which are a compiled-in Tcl script. */ @@ -457,11 +504,11 @@ InitClassSystemRoots( fPtr->objectCls = &fakeCls; /* referenced in TclOOAllocClass to increment the refCount. */ fakeCls.thisPtr = &fakeObject; - fakeObject.refCount = 0; /* Do not increment an uninitialized value. */ + fakeObject.refCount = 0; // Do not increment an uninitialized value. fPtr->objectCls = TclOOAllocClass(interp, - AllocObject(interp, "object", (Namespace *)fPtr->ooNs, NULL)); - /* Corresponding TclOODecrRefCount in KillFoudation */ + AllocObject(interp, "object", (Namespace *) fPtr->ooNs, NULL)); + // Corresponding TclOODecrRefCount in KillFoundation AddRef(fPtr->objectCls->thisPtr); /* @@ -485,8 +532,8 @@ InitClassSystemRoots( Tcl_IncrRefCount(defNsName); fPtr->classCls = TclOOAllocClass(interp, - AllocObject(interp, "class", (Namespace *)fPtr->ooNs, NULL)); - /* Corresponding TclOODecrRefCount in KillFoudation */ + AllocObject(interp, "class", (Namespace *) fPtr->ooNs, NULL)); + // Corresponding TclOODecrRefCount in KillFoundation AddRef(fPtr->classCls->thisPtr); /* @@ -527,37 +574,19 @@ InitClassSystemRoots( /* * ---------------------------------------------------------------------- * - * DeletedDefineNamespace, DeletedObjdefNamespace, DeletedHelpersNamespace -- + * DeletedHelpersNamespace -- * - * Simple helpers used to clear fields of the foundation when they no + * Simple helper used to clear fields of the foundation when they no * longer hold useful information. * * ---------------------------------------------------------------------- */ static void -DeletedDefineNamespace( - void *clientData) -{ - Foundation *fPtr = (Foundation *)clientData; - - fPtr->defineNs = NULL; -} - -static void -DeletedObjdefNamespace( - void *clientData) -{ - Foundation *fPtr = (Foundation *)clientData; - - fPtr->objdefNs = NULL; -} - -static void DeletedHelpersNamespace( void *clientData) { - Foundation *fPtr = (Foundation *)clientData; + Foundation *fPtr = (Foundation *) clientData; fPtr->helpersNs = NULL; } @@ -576,8 +605,8 @@ DeletedHelpersNamespace( static void KillFoundation( TCL_UNUSED(void *), - Tcl_Interp *interp) /* The interpreter containing the OO system - * foundation. */ + Tcl_Interp *interp) /* The interpreter containing the OO system + * foundation. */ { Foundation *fPtr = GetFoundation(interp); @@ -586,10 +615,17 @@ KillFoundation( TclDecrRefCount(fPtr->destructorName); TclDecrRefCount(fPtr->clonedName); TclDecrRefCount(fPtr->defineName); + TclDecrRefCount(fPtr->myName); TclOODecrRefCount(fPtr->objectCls->thisPtr); TclOODecrRefCount(fPtr->classCls->thisPtr); Tcl_Free(fPtr); + + /* + * Don't leave the interpreter field pointing to freed data. + */ + + ((Interp *) interp)->objectFoundation = NULL; } /* @@ -604,6 +640,10 @@ KillFoundation( * call TclOOAddToSubclasses() to add it to the right class's list of * subclasses. * + * Returns: + * Pointer to the object structure created, or NULL if a specific + * namespace was asked for but couldn't be created. + * * ---------------------------------------------------------------------- */ @@ -629,7 +669,7 @@ AllocObject( CommandTrace *tracePtr; size_t creationEpoch; - oPtr = (Object *)Tcl_Alloc(sizeof(Object)); + oPtr = (Object *) Tcl_Alloc(sizeof(Object)); memset(oPtr, 0, sizeof(Object)); /* @@ -646,17 +686,23 @@ AllocObject( if (nsNameStr != NULL) { oPtr->namespacePtr = Tcl_CreateNamespace(interp, nsNameStr, oPtr, NULL); - if (oPtr->namespacePtr != NULL) { - creationEpoch = ++fPtr->tsdPtr->nsCount; - goto configNamespace; + if (oPtr->namespacePtr == NULL) { + /* + * Couldn't make the specific namespace. Report as an error. + * [Bug 154f0982f2] + */ + Tcl_Free(oPtr); + return NULL; } - Tcl_ResetResult(interp); + creationEpoch = ++fPtr->tsdPtr->nsCount; + goto configNamespace; } while (1) { char objName[10 + TCL_INTEGER_SPACE]; - snprintf(objName, sizeof(objName), "::oo::Obj%" TCL_Z_MODIFIER "u", ++fPtr->tsdPtr->nsCount); + snprintf(objName, sizeof(objName), "::oo::Obj%" TCL_Z_MODIFIER "u", + ++fPtr->tsdPtr->nsCount); oPtr->namespacePtr = Tcl_CreateNamespace(interp, objName, oPtr, NULL); if (oPtr->namespacePtr != NULL) { creationEpoch = fPtr->tsdPtr->nsCount; @@ -725,13 +771,13 @@ AllocObject( if (!nameStr) { nameStr = oPtr->namespacePtr->name; - nsPtr = (Namespace *)oPtr->namespacePtr; + nsPtr = (Namespace *) oPtr->namespacePtr; if (nsPtr->parentPtr != NULL) { nsPtr = nsPtr->parentPtr; } } oPtr->command = TclCreateObjCommandInNs(interp, nameStr, - (Tcl_Namespace *)nsPtr, TclOOPublicObjectCmd, oPtr, NULL); + (Tcl_Namespace *) nsPtr, TclOOPublicObjectCmd, oPtr, NULL); /* * Add the NRE command and trace directly. While this breaks a number of @@ -740,7 +786,8 @@ AllocObject( cmdPtr = (Command *) oPtr->command; cmdPtr->nreProc = PublicNRObjectCmd; - cmdPtr->tracePtr = tracePtr = (CommandTrace *)Tcl_Alloc(sizeof(CommandTrace)); + cmdPtr->tracePtr = tracePtr = (CommandTrace *) + Tcl_Alloc(sizeof(CommandTrace)); tracePtr->traceProc = ObjectRenamedTrace; tracePtr->clientData = oPtr; tracePtr->flags = TCL_TRACE_RENAME|TCL_TRACE_DELETE; @@ -791,10 +838,10 @@ SquelchCachedName( static void MyDeleted( - void *clientData) /* Reference to the object whose [my] has been + void *clientData) /* Reference to the object whose [my] has been * squelched. */ { - Object *oPtr = (Object *)clientData; + Object *oPtr = (Object *) clientData; oPtr->myCommand = NULL; } @@ -803,7 +850,7 @@ static void MyClassDeleted( void *clientData) { - Object *oPtr = (Object *)clientData; + Object *oPtr = (Object *) clientData; oPtr->myclassCommand = NULL; } @@ -822,13 +869,13 @@ MyClassDeleted( static void ObjectRenamedTrace( - void *clientData, /* The object being deleted. */ + void *clientData, /* The object being deleted. */ TCL_UNUSED(Tcl_Interp *), TCL_UNUSED(const char *) /*oldName*/, TCL_UNUSED(const char *) /*newName*/, int flags) /* Why was the object deleted? */ { - Object *oPtr = (Object *)clientData; + Object *oPtr = (Object *) clientData; /* * If this is a rename and not a delete of the object, we just flush the @@ -966,7 +1013,7 @@ TclOOReleaseClassContents( Class *clsPtr = oPtr->classPtr, *tmpClsPtr; Method *mPtr; Foundation *fPtr = oPtr->fPtr; - Tcl_Obj *variableObj, *propertyObj; + Tcl_Obj *variableObj; PrivateVariableMapping *privateVariable; /* @@ -1023,24 +1070,7 @@ TclOOReleaseClassContents( * Squelch the property lists. */ - if (clsPtr->properties.allReadableCache) { - Tcl_DecrRefCount(clsPtr->properties.allReadableCache); - } - if (clsPtr->properties.allWritableCache) { - Tcl_DecrRefCount(clsPtr->properties.allWritableCache); - } - if (clsPtr->properties.readable.num) { - FOREACH(propertyObj, clsPtr->properties.readable) { - Tcl_DecrRefCount(propertyObj); - } - Tcl_Free(clsPtr->properties.readable.list); - } - if (clsPtr->properties.writable.num) { - FOREACH(propertyObj, clsPtr->properties.writable) { - Tcl_DecrRefCount(propertyObj); - } - Tcl_Free(clsPtr->properties.writable.list); - } + TclOOReleasePropertyStorage(&clsPtr->properties); /* * Squelch our filter list. @@ -1135,15 +1165,15 @@ TclOOReleaseClassContents( static void ObjectNamespaceDeleted( - void *clientData) /* Pointer to the class whose namespace is + void *clientData) /* Pointer to the class whose namespace is * being deleted. */ { - Object *oPtr = (Object *)clientData; + Object *oPtr = (Object *) clientData; Foundation *fPtr = oPtr->fPtr; FOREACH_HASH_DECLS; Class *mixinPtr; Method *mPtr; - Tcl_Obj *filterObj, *variableObj, *propertyObj; + Tcl_Obj *filterObj, *variableObj; PrivateVariableMapping *privateVariable; Tcl_Interp *interp = oPtr->fPtr->interp; Tcl_Size i; @@ -1220,14 +1250,14 @@ ObjectNamespaceDeleted( * as well. */ - Tcl_DeleteCommandFromToken(oPtr->fPtr->interp, oPtr->command); + Tcl_DeleteCommandFromToken(interp, oPtr->command); } if (oPtr->myclassCommand) { - Tcl_DeleteCommandFromToken(oPtr->fPtr->interp, oPtr->myclassCommand); + Tcl_DeleteCommandFromToken(interp, oPtr->myclassCommand); } if (oPtr->myCommand) { - Tcl_DeleteCommandFromToken(oPtr->fPtr->interp, oPtr->myCommand); + Tcl_DeleteCommandFromToken(interp, oPtr->myCommand); } /* @@ -1235,7 +1265,7 @@ ObjectNamespaceDeleted( * methods on the object. */ - /* TODO: Should this be protected with a !IsRoot() condition? */ + // TODO: Should this be protected with a !IsRoot() condition? TclOORemoveFromInstances(oPtr, oPtr->selfCls); if (oPtr->mixins.num > 0) { @@ -1300,24 +1330,7 @@ ObjectNamespaceDeleted( * Squelch the property lists. */ - if (oPtr->properties.allReadableCache) { - Tcl_DecrRefCount(oPtr->properties.allReadableCache); - } - if (oPtr->properties.allWritableCache) { - Tcl_DecrRefCount(oPtr->properties.allWritableCache); - } - if (oPtr->properties.readable.num) { - FOREACH(propertyObj, oPtr->properties.readable) { - Tcl_DecrRefCount(propertyObj); - } - Tcl_Free(oPtr->properties.readable.list); - } - if (oPtr->properties.writable.num) { - FOREACH(propertyObj, oPtr->properties.writable) { - Tcl_DecrRefCount(propertyObj); - } - Tcl_Free(oPtr->properties.writable.list); - } + TclOOReleasePropertyStorage(&oPtr->properties); /* * Because an object can be a class that is an instance of itself, the @@ -1344,7 +1357,7 @@ ObjectNamespaceDeleted( * Delete the object structure itself. */ - TclNsDecrRefCount((Namespace *)oPtr->namespacePtr); + TclNsDecrRefCount((Namespace *) oPtr->namespacePtr); oPtr->namespacePtr = NULL; TclOODecrRefCount(oPtr->selfCls->thisPtr); oPtr->selfCls = NULL; @@ -1449,10 +1462,12 @@ TclOOAddToInstances( if (clsPtr->instances.num >= clsPtr->instances.size) { clsPtr->instances.size += ALLOC_CHUNK; if (clsPtr->instances.size == ALLOC_CHUNK) { - clsPtr->instances.list = (Object **)Tcl_Alloc(sizeof(Object *) * ALLOC_CHUNK); + clsPtr->instances.list = (Object **) + Tcl_Alloc(sizeof(Object *) * ALLOC_CHUNK); } else { - clsPtr->instances.list = (Object **)Tcl_Realloc(clsPtr->instances.list, - sizeof(Object *) * clsPtr->instances.size); + clsPtr->instances.list = (Object **) + Tcl_Realloc(clsPtr->instances.list, + sizeof(Object *) * clsPtr->instances.size); } } clsPtr->instances.list[clsPtr->instances.num++] = oPtr; @@ -1550,10 +1565,12 @@ TclOOAddToSubclasses( if (superPtr->subclasses.num >= superPtr->subclasses.size) { superPtr->subclasses.size += ALLOC_CHUNK; if (superPtr->subclasses.size == ALLOC_CHUNK) { - superPtr->subclasses.list = (Class **)Tcl_Alloc(sizeof(Class *) * ALLOC_CHUNK); + superPtr->subclasses.list = (Class **) + Tcl_Alloc(sizeof(Class *) * ALLOC_CHUNK); } else { - superPtr->subclasses.list = (Class **)Tcl_Realloc(superPtr->subclasses.list, - sizeof(Class *) * superPtr->subclasses.size); + superPtr->subclasses.list = (Class **) + Tcl_Realloc(superPtr->subclasses.list, + sizeof(Class *) * superPtr->subclasses.size); } } superPtr->subclasses.list[superPtr->subclasses.num++] = subPtr; @@ -1616,10 +1633,12 @@ TclOOAddToMixinSubs( if (superPtr->mixinSubs.num >= superPtr->mixinSubs.size) { superPtr->mixinSubs.size += ALLOC_CHUNK; if (superPtr->mixinSubs.size == ALLOC_CHUNK) { - superPtr->mixinSubs.list = (Class **)Tcl_Alloc(sizeof(Class *) * ALLOC_CHUNK); + superPtr->mixinSubs.list = (Class **) + Tcl_Alloc(sizeof(Class *) * ALLOC_CHUNK); } else { - superPtr->mixinSubs.list = (Class **)Tcl_Realloc(superPtr->mixinSubs.list, - sizeof(Class *) * superPtr->mixinSubs.size); + superPtr->mixinSubs.list = (Class **) + Tcl_Realloc(superPtr->mixinSubs.list, + sizeof(Class *) * superPtr->mixinSubs.size); } } superPtr->mixinSubs.list[superPtr->mixinSubs.num++] = subPtr; @@ -1664,7 +1683,7 @@ TclOOAllocClass( * representation. */ { Foundation *fPtr = GetFoundation(interp); - Class *clsPtr = (Class *)Tcl_Alloc(sizeof(Class)); + Class *clsPtr = (Class *) Tcl_Alloc(sizeof(Class)); memset(clsPtr, 0, sizeof(Class)); clsPtr->thisPtr = useThisObj; @@ -1681,7 +1700,7 @@ TclOOAllocClass( */ clsPtr->superclasses.num = 1; - clsPtr->superclasses.list = (Class **)Tcl_Alloc(sizeof(Class *)); + clsPtr->superclasses.list = (Class **) Tcl_Alloc(sizeof(Class *)); clsPtr->superclasses.list[0] = fPtr->objectCls; AddRef(fPtr->objectCls->thisPtr); @@ -1718,10 +1737,10 @@ Tcl_NewObjectInstance( const char *nsNameStr, /* Name of namespace to create inside object, * or NULL to ask the code to pick its own * unique name. */ - Tcl_Size objc, /* Number of arguments. Negative value means + Tcl_Size objc, /* Number of arguments. Negative value means * do not call constructor. */ Tcl_Obj *const *objv, /* Argument list. */ - Tcl_Size skip) /* Number of arguments to _not_ pass to the + Tcl_Size skip) /* Number of arguments to _not_ pass to the * constructor. */ { Class *classPtr = (Class *) cls; @@ -1786,10 +1805,10 @@ TclNRNewObjectInstance( const char *nsNameStr, /* Name of namespace to create inside object, * or NULL to ask the code to pick its own * unique name. */ - Tcl_Size objc, /* Number of arguments. Negative value means + Tcl_Size objc, /* Number of arguments. Negative value means * do not call constructor. */ Tcl_Obj *const *objv, /* Argument list. */ - Tcl_Size skip, /* Number of arguments to _not_ pass to the + Tcl_Size skip, /* Number of arguments to _not_ pass to the * constructor. */ Tcl_Object *objectPtr) /* Place to write the object reference upon * successful allocation. */ @@ -1878,6 +1897,9 @@ TclNewObjectInstanceCommon( */ oPtr = AllocObject(interp, simpleName, nsPtr, nsNameStr); + if (oPtr == NULL) { + return NULL; + } oPtr->selfCls = classPtr; AddRef(classPtr->thisPtr); TclOOAddToInstances(oPtr, classPtr); @@ -1909,10 +1931,10 @@ FinalizeAlloc( Tcl_Interp *interp, int result) { - CallContext *contextPtr = (CallContext *)data[0]; - Object *oPtr = (Object *)data[1]; - Tcl_InterpState state = (Tcl_InterpState)data[2]; - Tcl_Object *objectPtr = (Tcl_Object *)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 @@ -2133,11 +2155,12 @@ Tcl_CopyObjectInstance( TclOODecrRefCount(superPtr->thisPtr); } if (cls2Ptr->superclasses.num) { - cls2Ptr->superclasses.list = (Class **)Tcl_Realloc(cls2Ptr->superclasses.list, - sizeof(Class *) * clsPtr->superclasses.num); + cls2Ptr->superclasses.list = (Class **) + Tcl_Realloc(cls2Ptr->superclasses.list, + sizeof(Class *) * clsPtr->superclasses.num); } else { - cls2Ptr->superclasses.list = - (Class **)Tcl_Alloc(sizeof(Class *) * clsPtr->superclasses.num); + cls2Ptr->superclasses.list = (Class **) + Tcl_Alloc(sizeof(Class *) * clsPtr->superclasses.num); } memcpy(cls2Ptr->superclasses.list, clsPtr->superclasses.list, sizeof(Class *) * clsPtr->superclasses.num); @@ -2331,7 +2354,7 @@ CloneClassMethod( Method *m2Ptr; if (mPtr->typePtr == NULL) { - m2Ptr = (Method *) TclNewMethod(interp, (Tcl_Class) clsPtr, + m2Ptr = (Method *) TclNewMethod((Tcl_Class) clsPtr, namePtr, mPtr->flags & PUBLIC_METHOD, NULL, NULL); } else if (mPtr->typePtr->cloneProc) { void *newClientData; @@ -2340,11 +2363,11 @@ CloneClassMethod( &newClientData) != TCL_OK) { return TCL_ERROR; } - m2Ptr = (Method *) TclNewMethod(interp, (Tcl_Class) clsPtr, + m2Ptr = (Method *) TclNewMethod((Tcl_Class) clsPtr, namePtr, mPtr->flags & PUBLIC_METHOD, mPtr->typePtr, newClientData); } else { - m2Ptr = (Method *) TclNewMethod(interp, (Tcl_Class) clsPtr, + m2Ptr = (Method *) TclNewMethod((Tcl_Class) clsPtr, namePtr, mPtr->flags & PUBLIC_METHOD, mPtr->typePtr, mPtr->clientData); } @@ -2431,7 +2454,8 @@ Tcl_ClassSetMetadata( if (metadata == NULL) { return; } - clsPtr->metadataPtr = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable)); + clsPtr->metadataPtr = (Tcl_HashTable *) + Tcl_Alloc(sizeof(Tcl_HashTable)); Tcl_InitHashTable(clsPtr->metadataPtr, TCL_ONE_WORD_KEYS); } @@ -2511,7 +2535,7 @@ Tcl_ObjectSetMetadata( if (metadata == NULL) { return; } - oPtr->metadataPtr = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable)); + oPtr->metadataPtr = (Tcl_HashTable *) Tcl_Alloc(sizeof(Tcl_HashTable)); Tcl_InitHashTable(oPtr->metadataPtr, TCL_ONE_WORD_KEYS); } @@ -2560,7 +2584,7 @@ TclOOPublicObjectCmd( int objc, Tcl_Obj *const *objv) { - return Tcl_NRCallObjProc(interp, PublicNRObjectCmd, clientData,objc,objv); + return Tcl_NRCallObjProc(interp, PublicNRObjectCmd, clientData, objc, objv); } static int @@ -2570,8 +2594,8 @@ PublicNRObjectCmd( int objc, Tcl_Obj *const *objv) { - return TclOOObjectCmdCore((Object *)clientData, interp, objc, objv, PUBLIC_METHOD, - NULL); + return TclOOObjectCmdCore((Object *) clientData, interp, objc, objv, + PUBLIC_METHOD, NULL); } int @@ -2581,7 +2605,7 @@ TclOOPrivateObjectCmd( int objc, Tcl_Obj *const *objv) { - return Tcl_NRCallObjProc(interp, PrivateNRObjectCmd,clientData,objc,objv); + return Tcl_NRCallObjProc(interp, PrivateNRObjectCmd, clientData, objc, objv); } static int @@ -2591,7 +2615,7 @@ PrivateNRObjectCmd( int objc, Tcl_Obj *const *objv) { - return TclOOObjectCmdCore((Object *)clientData, interp, objc, objv, 0, NULL); + return TclOOObjectCmdCore((Object *) clientData, interp, objc, objv, 0, NULL); } int @@ -2607,7 +2631,7 @@ TclOOInvokeObject( * (PRIVATE_METHOD), or a *really* private * context (any other value; conventionally * 0). */ - Tcl_Size objc, /* Number of arguments. */ + Tcl_Size objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* Array of argument objects. It is assumed * that the name of the method to invoke will * be at index 1. */ @@ -2652,7 +2676,7 @@ MyClassNRObjCmd( int objc, Tcl_Obj *const *objv) { - Object *oPtr = (Object *)clientData; + Object *oPtr = (Object *) clientData; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "methodName ?arg ...?"); @@ -2678,7 +2702,7 @@ int TclOOObjectCmdCore( Object *oPtr, /* The object being invoked. */ Tcl_Interp *interp, /* The interpreter containing the object. */ - Tcl_Size objc, /* How many arguments are being passed in. */ + Tcl_Size objc, /* How many arguments are being passed in. */ Tcl_Obj *const *objv, /* The array of arguments. */ int flags, /* Whether this is an invocation through the * public or the private command interface. */ @@ -2711,7 +2735,7 @@ TclOOObjectCmdCore( */ if (framePtr->isProcCallFrame & FRAME_IS_METHOD) { - CallContext *callerContextPtr = (CallContext *)framePtr->clientData; + CallContext *callerContextPtr = (CallContext *) framePtr->clientData; Method *callerMethodPtr = callerContextPtr->callPtr->chain[callerContextPtr->index].mPtr; @@ -2788,8 +2812,7 @@ TclOOObjectCmdCore( if (startCls != NULL) { for (; contextPtr->index < contextPtr->callPtr->numChain; contextPtr->index++) { - struct MInvoke *miPtr = - &contextPtr->callPtr->chain[contextPtr->index]; + MInvoke *miPtr = &contextPtr->callPtr->chain[contextPtr->index]; if (miPtr->isFilter) { continue; @@ -2828,7 +2851,7 @@ FinalizeObjectCall( * structure. */ - TclOODeleteContext((CallContext *)data[0]); + TclOODeleteContext((CallContext *) data[0]); return result; } @@ -2984,7 +3007,7 @@ FinalizeNext( TCL_UNUSED(Tcl_Interp *), int result) { - CallContext *contextPtr = (CallContext *)data[0]; + CallContext *contextPtr = (CallContext *) data[0]; /* * Restore the call chain context index as we've finished the inner invoke @@ -3025,7 +3048,7 @@ Tcl_GetObjectFromObj( goto notAnObject; } } - return (Tcl_Object)cmdPtr->objClientData; + return (Tcl_Object) cmdPtr->objClientData; notAnObject: Tcl_SetObjResult(interp, Tcl_ObjPrintf( @@ -3141,49 +3164,49 @@ Tcl_Object Tcl_ObjectContextObject( Tcl_ObjectContext context) { - return (Tcl_Object) ((CallContext *)context)->oPtr; + return (Tcl_Object) ((CallContext *) context)->oPtr; } Tcl_Size Tcl_ObjectContextSkippedArgs( Tcl_ObjectContext context) { - return ((CallContext *)context)->skip; + return ((CallContext *) context)->skip; } Tcl_Namespace * Tcl_GetObjectNamespace( Tcl_Object object) { - return ((Object *)object)->namespacePtr; + return ((Object *) object)->namespacePtr; } Tcl_Command Tcl_GetObjectCommand( Tcl_Object object) { - return ((Object *)object)->command; + return ((Object *) object)->command; } Tcl_Class Tcl_GetObjectAsClass( Tcl_Object object) { - return (Tcl_Class) ((Object *)object)->classPtr; + return (Tcl_Class) ((Object *) object)->classPtr; } int Tcl_ObjectDeleted( Tcl_Object object) { - return ((Object *)object)->command == NULL; + return ((Object *) object)->command == NULL; } Tcl_Object Tcl_GetClassAsObject( Tcl_Class clazz) { - return (Tcl_Object) ((Class *)clazz)->thisPtr; + return (Tcl_Object) ((Class *) clazz)->thisPtr; } Tcl_ObjectMapMethodNameProc * |