diff options
| -rw-r--r-- | ChangeLog | 12 | ||||
| -rw-r--r-- | generic/tclOOBasic.c | 55 | ||||
| -rw-r--r-- | generic/tclOOInfo.c | 273 |
3 files changed, 152 insertions, 188 deletions
@@ -1,4 +1,12 @@ -2008-10-4 Jan Nijtmans <nijtmans@users.sf.net> +2008-10-04 Donal K. Fellows <dkf@users.sf.net> + + * generic/tclOOInfo.c (GetClassFromObj): Factor out the code to parse + a Tcl_Obj and get a class. Also make result handling hygienic. + * generic/tclOOBasic.c (TclOOSelfObjCmd): Better hygiene of results, + and stop allocating quite so much memory by sharing special "method" + names. + +2008-10-04 Jan Nijtmans <nijtmans@users.sf.net> * doc/Hash.3: CONSTified the typePtr argument * generic/tcl.decls: of Tcl_InitCustomHashTable. @@ -8,8 +16,6 @@ * generic/tclDecls.h: regenerated This change complies with TIP #27. -2008-10-4 Jan Nijtmans <nijtmans@users.sf.net> - * doc/GetIndex.3: CONSTified the tablePtr argument * generic/tcl.decls: of Tcl_GetIndexFromObj. * generic/tclIndexObj.c diff --git a/generic/tclOOBasic.c b/generic/tclOOBasic.c index 2e3868d..2d224dd 100644 --- a/generic/tclOOBasic.c +++ b/generic/tclOOBasic.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclOOBasic.c,v 1.11 2008/09/26 20:16:39 dgp Exp $ + * RCS: @(#) $Id: tclOOBasic.c,v 1.12 2008/10/04 12:00:25 dkf Exp $ */ #ifdef HAVE_CONFIG_H @@ -761,9 +761,9 @@ TclOOSelfObjCmd( } case SELF_METHOD: if (contextPtr->callPtr->flags & CONSTRUCTOR) { - Tcl_AppendResult(interp, "<constructor>", NULL); + Tcl_SetObjResult(interp, contextPtr->oPtr->fPtr->constructorName); } else if (contextPtr->callPtr->flags & DESTRUCTOR) { - Tcl_AppendResult(interp, "<destructor>", NULL); + Tcl_SetObjResult(interp, contextPtr->oPtr->fPtr->destructorName); } else { Tcl_SetObjResult(interp, CurrentlyInvoked(contextPtr).mPtr->namePtr); @@ -794,11 +794,15 @@ TclOOSelfObjCmd( return TCL_OK; } case SELF_CALLER: - if ((framePtr->callerVarPtr != NULL) && - (framePtr->callerVarPtr->isProcCallFrame & FRAME_IS_METHOD)) { + if ((framePtr->callerVarPtr == NULL) || + !(framePtr->callerVarPtr->isProcCallFrame & FRAME_IS_METHOD)){ + Tcl_AppendResult(interp, "caller is not an object", NULL); + return TCL_ERROR; + } else { CallContext *callerPtr = framePtr->callerVarPtr->clientData; Method *mPtr = callerPtr->callPtr->chain[callerPtr->index].mPtr; Object *declarerPtr; + Tcl_Obj *result[3]; if (mPtr->declaringClassPtr != NULL) { declarerPtr = mPtr->declaringClassPtr->thisPtr; @@ -813,30 +817,24 @@ TclOOSelfObjCmd( return TCL_ERROR; } - Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp), - TclOOObjectName(interp, declarerPtr)); - Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp), - TclOOObjectName(interp, callerPtr->oPtr)); + result[0] = TclOOObjectName(interp, declarerPtr); + result[1] = TclOOObjectName(interp, callerPtr->oPtr); if (callerPtr->callPtr->flags & CONSTRUCTOR) { - Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp), - Tcl_NewStringObj("<constructor>", -1)); + result[2] = declarerPtr->fPtr->constructorName; } else if (callerPtr->callPtr->flags & DESTRUCTOR) { - Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp), - Tcl_NewStringObj("<destructor>", -1)); + result[2] = declarerPtr->fPtr->destructorName; } else { - Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp), - mPtr->namePtr); + result[2] = mPtr->namePtr; } + Tcl_SetObjResult(interp, Tcl_NewListObj(3, result)); return TCL_OK; - } else { - Tcl_AppendResult(interp, "caller is not an object", NULL); - return TCL_ERROR; } case SELF_NEXT: if (contextPtr->index < contextPtr->callPtr->numChain-1) { Method *mPtr = contextPtr->callPtr->chain[contextPtr->index+1].mPtr; Object *declarerPtr; + Tcl_Obj *result[2]; if (mPtr->declaringClassPtr != NULL) { declarerPtr = mPtr->declaringClassPtr->thisPtr; @@ -851,18 +849,15 @@ TclOOSelfObjCmd( return TCL_ERROR; } - Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp), - TclOOObjectName(interp, declarerPtr)); + result[0] = TclOOObjectName(interp, declarerPtr); if (contextPtr->callPtr->flags & CONSTRUCTOR) { - Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp), - Tcl_NewStringObj("<constructor>", -1)); + result[1] = declarerPtr->fPtr->constructorName; } else if (contextPtr->callPtr->flags & DESTRUCTOR) { - Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp), - Tcl_NewStringObj("<destructor>", -1)); + result[1] = declarerPtr->fPtr->destructorName; } else { - Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp), - mPtr->namePtr); + result[1] = mPtr->namePtr; } + Tcl_SetObjResult(interp, Tcl_NewListObj(2, result)); } return TCL_OK; case SELF_TARGET: @@ -872,6 +867,7 @@ TclOOSelfObjCmd( } else { Method *mPtr; Object *declarerPtr; + Tcl_Obj *result[2]; int i; for (i=contextPtr->index ; i<contextPtr->callPtr->numChain ; i++){ @@ -895,10 +891,9 @@ TclOOSelfObjCmd( Tcl_AppendResult(interp, "method without declarer!", NULL); return TCL_ERROR; } - Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp), - TclOOObjectName(interp, declarerPtr)); - Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp), - mPtr->namePtr); + result[0] = TclOOObjectName(interp, declarerPtr); + result[1] = mPtr->namePtr; + Tcl_SetObjResult(interp, Tcl_NewListObj(2, result)); return TCL_OK; } } diff --git a/generic/tclOOInfo.c b/generic/tclOOInfo.c index 41d90a4..ee19373 100644 --- a/generic/tclOOInfo.c +++ b/generic/tclOOInfo.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclOOInfo.c,v 1.7 2008/09/23 05:05:54 dkf Exp $ + * RCS: @(#) $Id: tclOOInfo.c,v 1.8 2008/10/04 12:00:25 dkf Exp $ */ #ifdef HAVE_CONFIG_H @@ -18,6 +18,7 @@ #include "tclInt.h" #include "tclOOInt.h" +static inline Class * GetClassFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr); static Tcl_ObjCmdProc InfoObjectClassCmd; static Tcl_ObjCmdProc InfoObjectDefnCmd; static Tcl_ObjCmdProc InfoObjectFiltersCmd; @@ -149,6 +150,35 @@ TclOOInitInfo( /* * ---------------------------------------------------------------------- * + * GetClassFromObj -- + * + * How to correctly get a class from a Tcl_Obj. Just a wrapper round + * Tcl_GetObjectFromObj, but this is an idiom that was used heavily. + * + * ---------------------------------------------------------------------- + */ + +static inline Class * +GetClassFromObj( + Tcl_Interp *interp, + Tcl_Obj *objPtr) +{ + Object *oPtr = (Object *) Tcl_GetObjectFromObj(interp, objPtr); + + if (oPtr == NULL) { + return NULL; + } + if (oPtr->classPtr == NULL) { + Tcl_AppendResult(interp, "\"", TclGetString(objPtr), + "\" is not a class", NULL); + return NULL; + } + return oPtr->classPtr; +} + +/* + * ---------------------------------------------------------------------- + * * InfoObjectClassCmd -- * * Implements [info object class $objName ?$className?] @@ -227,7 +257,7 @@ InfoObjectDefnCmd( Tcl_HashEntry *hPtr; Proc *procPtr; CompiledLocal *localPtr; - Tcl_Obj *argsObj; + Tcl_Obj *resultObjs[2]; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "objName methodName"); @@ -256,7 +286,7 @@ InfoObjectDefnCmd( return TCL_ERROR; } - argsObj = Tcl_NewObj(); + resultObjs[0] = Tcl_NewObj(); for (localPtr=procPtr->firstLocalPtr; localPtr!=NULL; localPtr=localPtr->nextPtr) { if (TclIsVarArgument(localPtr)) { @@ -268,12 +298,11 @@ InfoObjectDefnCmd( if (localPtr->defValuePtr != NULL) { Tcl_ListObjAppendElement(NULL, argObj, localPtr->defValuePtr); } - Tcl_ListObjAppendElement(NULL, argsObj, argObj); + Tcl_ListObjAppendElement(NULL, resultObjs[0], argObj); } } - Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp), argsObj); - Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp), - TclOOGetMethodBody(Tcl_GetHashValue(hPtr))); + resultObjs[1] = TclOOGetMethodBody(Tcl_GetHashValue(hPtr)); + Tcl_SetObjResult(interp, Tcl_NewListObj(2, resultObjs)); return TCL_OK; } @@ -295,7 +324,7 @@ InfoObjectFiltersCmd( Tcl_Obj *const objv[]) { int i; - Tcl_Obj *filterObj; + Tcl_Obj *filterObj, *resultObj; Object *oPtr; if (objc != 2) { @@ -307,10 +336,12 @@ InfoObjectFiltersCmd( if (oPtr == NULL) { return TCL_ERROR; } + resultObj = Tcl_NewObj(); FOREACH(filterObj, oPtr->filters) { - Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp), filterObj); + Tcl_ListObjAppendElement(NULL, resultObj, filterObj); } + Tcl_SetObjResult(interp, resultObj); return TCL_OK; } @@ -507,7 +538,7 @@ InfoObjectMethodsCmd( Object *oPtr; int flag = PUBLIC_METHOD, recurse = 0; FOREACH_HASH_DECLS; - Tcl_Obj *namePtr; + Tcl_Obj *namePtr, *resultObj; Method *mPtr; static const char *options[] = { "-all", "-localprivate", "-private", NULL @@ -546,28 +577,24 @@ InfoObjectMethodsCmd( } } + resultObj = Tcl_NewObj(); if (recurse) { const char **names; int i, numNames = TclOOGetSortedMethodList(oPtr, flag, &names); - Tcl_Obj *resultObj = Tcl_NewObj(); for (i=0 ; i<numNames ; i++) { Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj(names[i], -1)); } ckfree((char *) names); - Tcl_SetObjResult(interp, resultObj); - return TCL_OK; - } - - if (oPtr->methodsPtr) { + } else if (oPtr->methodsPtr) { FOREACH_HASH(namePtr, mPtr, oPtr->methodsPtr) { if (mPtr->typePtr != NULL && (mPtr->flags & flag) == flag) { - Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp), - namePtr); + Tcl_ListObjAppendElement(NULL, resultObj, namePtr); } } } + Tcl_SetObjResult(interp, resultObj); return TCL_OK; } @@ -590,6 +617,7 @@ InfoObjectMixinsCmd( { Class *mixinPtr; Object *oPtr; + Tcl_Obj *resultObj; int i; if (objc != 2) { @@ -601,10 +629,12 @@ InfoObjectMixinsCmd( return TCL_ERROR; } + resultObj = Tcl_NewObj(); FOREACH(mixinPtr, oPtr->mixins) { - Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp), + Tcl_ListObjAppendElement(NULL, resultObj, TclOOObjectName(interp, mixinPtr->thisPtr)); } + Tcl_SetObjResult(interp, resultObj); return TCL_OK; } @@ -626,7 +656,7 @@ InfoObjectVariablesCmd( Tcl_Obj *const objv[]) { Object *oPtr; - Tcl_Obj *variableObj; + Tcl_Obj *variableObj, *resultObj; int i; if (objc != 2) { @@ -638,9 +668,11 @@ InfoObjectVariablesCmd( return TCL_ERROR; } + resultObj = Tcl_NewObj(); FOREACH(variableObj, oPtr->variables) { - Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp), variableObj); + Tcl_ListObjAppendElement(NULL, resultObj, variableObj); } + Tcl_SetObjResult(interp, resultObj); return TCL_OK; } @@ -724,25 +756,17 @@ InfoClassConstrCmd( { Proc *procPtr; CompiledLocal *localPtr; - Tcl_Obj *argsObj; - Object *oPtr; + Tcl_Obj *resultObjs[2]; Class *clsPtr; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "className"); return TCL_ERROR; } - oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]); - if (oPtr == NULL) { - return TCL_ERROR; - } - if (oPtr->classPtr == NULL) { - Tcl_AppendResult(interp, "\"", TclGetString(objv[1]), - "\" is not a class", NULL); + clsPtr = GetClassFromObj(interp, objv[1]); + if (clsPtr == NULL) { return TCL_ERROR; } - clsPtr = oPtr->classPtr; - if (clsPtr->constructorPtr == NULL) { return TCL_OK; } @@ -753,7 +777,7 @@ InfoClassConstrCmd( return TCL_ERROR; } - argsObj = Tcl_NewObj(); + resultObjs[0] = Tcl_NewObj(); for (localPtr=procPtr->firstLocalPtr; localPtr!=NULL; localPtr=localPtr->nextPtr) { if (TclIsVarArgument(localPtr)) { @@ -765,12 +789,11 @@ InfoClassConstrCmd( if (localPtr->defValuePtr != NULL) { Tcl_ListObjAppendElement(NULL, argObj, localPtr->defValuePtr); } - Tcl_ListObjAppendElement(NULL, argsObj, argObj); + Tcl_ListObjAppendElement(NULL, resultObjs[0], argObj); } } - Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp), argsObj); - Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp), - TclOOGetMethodBody(clsPtr->constructorPtr)); + resultObjs[1] = TclOOGetMethodBody(clsPtr->constructorPtr); + Tcl_SetObjResult(interp, Tcl_NewListObj(2, resultObjs)); return TCL_OK; } @@ -794,25 +817,17 @@ InfoClassDefnCmd( Tcl_HashEntry *hPtr; Proc *procPtr; CompiledLocal *localPtr; - Tcl_Obj *argsObj; - Object *oPtr; + Tcl_Obj *resultObjs[2]; Class *clsPtr; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "className methodName"); return TCL_ERROR; } - oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]); - if (oPtr == NULL) { + clsPtr = GetClassFromObj(interp, objv[1]); + if (clsPtr == NULL) { return TCL_ERROR; } - if (oPtr->classPtr == NULL) { - Tcl_AppendResult(interp, "\"", TclGetString(objv[1]), - "\" is not a class", NULL); - return TCL_ERROR; - } - clsPtr = oPtr->classPtr; - hPtr = Tcl_FindHashEntry(&clsPtr->classMethods, (char *) objv[2]); if (hPtr == NULL) { Tcl_AppendResult(interp, "unknown method \"", TclGetString(objv[2]), @@ -826,7 +841,7 @@ InfoClassDefnCmd( return TCL_ERROR; } - argsObj = Tcl_NewObj(); + resultObjs[0] = Tcl_NewObj(); for (localPtr=procPtr->firstLocalPtr; localPtr!=NULL; localPtr=localPtr->nextPtr) { if (TclIsVarArgument(localPtr)) { @@ -838,12 +853,11 @@ InfoClassDefnCmd( if (localPtr->defValuePtr != NULL) { Tcl_ListObjAppendElement(NULL, argObj, localPtr->defValuePtr); } - Tcl_ListObjAppendElement(NULL, argsObj, argObj); + Tcl_ListObjAppendElement(NULL, resultObjs[0], argObj); } } - Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp), argsObj); - Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp), - TclOOGetMethodBody(Tcl_GetHashValue(hPtr))); + resultObjs[1] = TclOOGetMethodBody(Tcl_GetHashValue(hPtr)); + Tcl_SetObjResult(interp, Tcl_NewListObj(2, resultObjs)); return TCL_OK; } @@ -865,24 +879,13 @@ InfoClassDestrCmd( Tcl_Obj *const objv[]) { Proc *procPtr; - Object *oPtr; Class *clsPtr; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "className"); return TCL_ERROR; } - oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]); - if (oPtr == NULL) { - return TCL_ERROR; - } - if (oPtr->classPtr == NULL) { - Tcl_AppendResult(interp, "\"", TclGetString(objv[1]), - "\" is not a class", NULL); - return TCL_ERROR; - } - clsPtr = oPtr->classPtr; - + clsPtr = GetClassFromObj(interp, objv[1]); if (clsPtr->destructorPtr == NULL) { return TCL_OK; } @@ -915,28 +918,23 @@ InfoClassFiltersCmd( Tcl_Obj *const objv[]) { int i; - Tcl_Obj *filterObj; - Object *oPtr; + Tcl_Obj *filterObj, *resultObj; Class *clsPtr; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "className"); return TCL_ERROR; } - oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]); - if (oPtr == NULL) { - return TCL_ERROR; - } - if (oPtr->classPtr == NULL) { - Tcl_AppendResult(interp, "\"", TclGetString(objv[1]), - "\" is not a class", NULL); + clsPtr = GetClassFromObj(interp, objv[1]); + if (clsPtr == NULL) { return TCL_ERROR; } - clsPtr = oPtr->classPtr; + resultObj = Tcl_NewObj(); FOREACH(filterObj, clsPtr->filters) { - Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp), filterObj); + Tcl_ListObjAppendElement(NULL, resultObj, filterObj); } + Tcl_SetObjResult(interp, resultObj); return TCL_OK; } @@ -959,24 +957,16 @@ InfoClassForwardCmd( { Tcl_HashEntry *hPtr; Tcl_Obj *prefixObj; - Object *oPtr; Class *clsPtr; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "className methodName"); return TCL_ERROR; } - oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]); - if (oPtr == NULL) { - return TCL_ERROR; - } - if (oPtr->classPtr == NULL) { - Tcl_AppendResult(interp, "\"", TclGetString(objv[1]), - "\" is not a class", NULL); + clsPtr = GetClassFromObj(interp, objv[1]); + if (clsPtr == NULL) { return TCL_ERROR; } - clsPtr = oPtr->classPtr; - hPtr = Tcl_FindHashEntry(&clsPtr->classMethods, (char *) objv[2]); if (hPtr == NULL) { Tcl_AppendResult(interp, "unknown method \"", TclGetString(objv[2]), @@ -1016,33 +1006,30 @@ InfoClassInstancesCmd( Class *clsPtr; int i; const char *pattern = NULL; + Tcl_Obj *resultObj; if (objc != 2 && objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "className ?pattern?"); return TCL_ERROR; } - oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]); - if (oPtr == NULL) { + clsPtr = GetClassFromObj(interp, objv[1]); + if (clsPtr == NULL) { return TCL_ERROR; } - if (oPtr->classPtr == NULL) { - Tcl_AppendResult(interp, "\"", TclGetString(objv[1]), - "\" is not a class", NULL); - return TCL_ERROR; - } - clsPtr = oPtr->classPtr; if (objc == 3) { pattern = TclGetString(objv[2]); } + resultObj = Tcl_NewObj(); FOREACH(oPtr, clsPtr->instances) { Tcl_Obj *tmpObj = TclOOObjectName(interp, oPtr); if (pattern && !Tcl_StringMatch(TclGetString(tmpObj), pattern)) { continue; } - Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp), tmpObj); + Tcl_ListObjAppendElement(NULL, resultObj, tmpObj); } + Tcl_SetObjResult(interp, resultObj); return TCL_OK; } @@ -1064,10 +1051,8 @@ InfoClassMethodsCmd( Tcl_Obj *const objv[]) { int flag = PUBLIC_METHOD, recurse = 0; - FOREACH_HASH_DECLS; - Tcl_Obj *namePtr; + Tcl_Obj *namePtr, *resultObj; Method *mPtr; - Object *oPtr; Class *clsPtr; static const char *options[] = { "-all", "-localprivate", "-private", NULL @@ -1080,16 +1065,10 @@ InfoClassMethodsCmd( Tcl_WrongNumArgs(interp, 1, objv, "className ?-option value ...?"); return TCL_ERROR; } - oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]); - if (oPtr == NULL) { - return TCL_ERROR; - } - if (oPtr->classPtr == NULL) { - Tcl_AppendResult(interp, "\"", TclGetString(objv[1]), - "\" is not a class", NULL); + clsPtr = GetClassFromObj(interp, objv[1]); + if (clsPtr == NULL) { return TCL_ERROR; } - clsPtr = oPtr->classPtr; if (objc != 2) { int i, idx; @@ -1112,25 +1091,26 @@ InfoClassMethodsCmd( } } + resultObj = Tcl_NewObj(); if (recurse) { const char **names; int i, numNames = TclOOGetSortedClassMethodList(clsPtr, flag, &names); - Tcl_Obj *resultObj = Tcl_NewObj(); for (i=0 ; i<numNames ; i++) { Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj(names[i], -1)); } ckfree((char *) names); - Tcl_SetObjResult(interp, resultObj); - return TCL_OK; - } + } else { + FOREACH_HASH_DECLS; - FOREACH_HASH(namePtr, mPtr, &clsPtr->classMethods) { - if (mPtr->typePtr != NULL && (mPtr->flags & flag) == flag) { - Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp), namePtr); + FOREACH_HASH(namePtr, mPtr, &clsPtr->classMethods) { + if (mPtr->typePtr != NULL && (mPtr->flags & flag) == flag) { + Tcl_ListObjAppendElement(NULL, resultObj, namePtr); + } } } + Tcl_SetObjResult(interp, resultObj); return TCL_OK; } @@ -1151,29 +1131,25 @@ InfoClassMixinsCmd( int objc, Tcl_Obj *const objv[]) { - Object *oPtr; Class *clsPtr, *mixinPtr; + Tcl_Obj *resultObj; int i; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "className"); return TCL_ERROR; } - oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]); - if (oPtr == NULL) { + clsPtr = GetClassFromObj(interp, objv[1]); + if (clsPtr == NULL) { return TCL_ERROR; } - if (oPtr->classPtr == NULL) { - Tcl_AppendResult(interp, "\"", TclGetString(objv[1]), - "\" is not a class", NULL); - return TCL_ERROR; - } - clsPtr = oPtr->classPtr; + resultObj = Tcl_NewObj(); FOREACH(mixinPtr, clsPtr->mixins) { - Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp), + Tcl_ListObjAppendElement(NULL, resultObj, TclOOObjectName(interp, mixinPtr->thisPtr)); } + Tcl_SetObjResult(interp, resultObj); return TCL_OK; } @@ -1194,8 +1170,8 @@ InfoClassSubsCmd( int objc, Tcl_Obj *const objv[]) { - Object *oPtr; Class *clsPtr, *subclassPtr; + Tcl_Obj *resultObj; int i; const char *pattern = NULL; @@ -1203,27 +1179,22 @@ InfoClassSubsCmd( Tcl_WrongNumArgs(interp, 1, objv, "className ?pattern?"); return TCL_ERROR; } - oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]); - if (oPtr == NULL) { - return TCL_ERROR; - } - if (oPtr->classPtr == NULL) { - Tcl_AppendResult(interp, "\"", TclGetString(objv[1]), - "\" is not a class", NULL); + clsPtr = GetClassFromObj(interp, objv[1]); + if (clsPtr == NULL) { return TCL_ERROR; } - clsPtr = oPtr->classPtr; if (objc == 3) { pattern = TclGetString(objv[2]); } + resultObj = Tcl_NewObj(); FOREACH(subclassPtr, clsPtr->subclasses) { Tcl_Obj *tmpObj = TclOOObjectName(interp, subclassPtr->thisPtr); if (pattern && !Tcl_StringMatch(TclGetString(tmpObj), pattern)) { continue; } - Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp), tmpObj); + Tcl_ListObjAppendElement(NULL, resultObj, tmpObj); } FOREACH(subclassPtr, clsPtr->mixinSubs) { Tcl_Obj *tmpObj = TclOOObjectName(interp, subclassPtr->thisPtr); @@ -1231,8 +1202,9 @@ InfoClassSubsCmd( if (pattern && !Tcl_StringMatch(TclGetString(tmpObj), pattern)) { continue; } - Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp), tmpObj); + Tcl_ListObjAppendElement(NULL, resultObj, tmpObj); } + Tcl_SetObjResult(interp, resultObj); return TCL_OK; } @@ -1253,29 +1225,25 @@ InfoClassSupersCmd( int objc, Tcl_Obj *const objv[]) { - Object *oPtr; Class *clsPtr, *superPtr; + Tcl_Obj *resultObj; int i; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "className"); return TCL_ERROR; } - oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]); - if (oPtr == NULL) { - return TCL_ERROR; - } - if (oPtr->classPtr == NULL) { - Tcl_AppendResult(interp, "\"", TclGetString(objv[1]), - "\" is not a class", NULL); + clsPtr = GetClassFromObj(interp, objv[1]); + if (clsPtr == NULL) { return TCL_ERROR; } - clsPtr = oPtr->classPtr; + resultObj = Tcl_NewObj(); FOREACH(superPtr, clsPtr->superclasses) { - Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp), + Tcl_ListObjAppendElement(NULL, resultObj, TclOOObjectName(interp, superPtr->thisPtr)); } + Tcl_SetObjResult(interp, resultObj); return TCL_OK; } @@ -1296,29 +1264,24 @@ InfoClassVariablesCmd( int objc, Tcl_Obj *const objv[]) { - Object *oPtr; Class *clsPtr; - Tcl_Obj *variableObj; + Tcl_Obj *variableObj, *resultObj; int i; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "className"); return TCL_ERROR; } - oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]); - if (oPtr == NULL) { - return TCL_ERROR; - } - if (oPtr->classPtr == NULL) { - Tcl_AppendResult(interp, "\"", TclGetString(objv[1]), - "\" is not a class", NULL); + clsPtr = GetClassFromObj(interp, objv[1]); + if (clsPtr == NULL) { return TCL_ERROR; } - clsPtr = oPtr->classPtr; + resultObj = Tcl_NewObj(); FOREACH(variableObj, clsPtr->variables) { - Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp), variableObj); + Tcl_ListObjAppendElement(NULL, resultObj, variableObj); } + Tcl_SetObjResult(interp, resultObj); return TCL_OK; } |