diff options
Diffstat (limited to 'generic/tclOOMethod.c')
-rw-r--r-- | generic/tclOOMethod.c | 134 |
1 files changed, 90 insertions, 44 deletions
diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c index 1255f1d..28820e0 100644 --- a/generic/tclOOMethod.c +++ b/generic/tclOOMethod.c @@ -3,12 +3,10 @@ * * This file contains code to create and manage methods. * - * Copyright (c) 2005-2008 by Donal K. Fellows + * Copyright (c) 2005-2011 by Donal K. Fellows * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. - * - * RCS: @(#) $Id: tclOOMethod.c,v 1.28 2010/09/26 14:16:26 msofer Exp $ */ #ifdef HAVE_CONFIG_H @@ -41,6 +39,8 @@ typedef struct { Tcl_Obj *nameObj; /* The "name" of the command. */ Command cmd; /* The command structure. Mostly bogus. */ ExtraFrameInfo efi; /* Extra information used for [info frame]. */ + Command *oldCmdPtr; /* Saved cmdPtr so that we can be safe after a + * recursive call returns. */ struct PNI pni; /* Specialist information used in the efi * field for this type of call. */ } PMFrameData; @@ -157,19 +157,19 @@ Tcl_NewInstanceMethod( int isNew; if (nameObj == NULL) { - mPtr = (Method *) ckalloc(sizeof(Method)); + mPtr = ckalloc(sizeof(Method)); mPtr->namePtr = NULL; mPtr->refCount = 1; goto populate; } if (!oPtr->methodsPtr) { - oPtr->methodsPtr = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable)); + oPtr->methodsPtr = ckalloc(sizeof(Tcl_HashTable)); Tcl_InitObjHashTable(oPtr->methodsPtr); oPtr->flags &= ~USE_CLASS_CACHE; } hPtr = Tcl_CreateHashEntry(oPtr->methodsPtr, (char *) nameObj, &isNew); if (isNew) { - mPtr = (Method *) ckalloc(sizeof(Method)); + mPtr = ckalloc(sizeof(Method)); mPtr->namePtr = nameObj; mPtr->refCount = 1; Tcl_IncrRefCount(nameObj); @@ -225,14 +225,14 @@ Tcl_NewMethod( int isNew; if (nameObj == NULL) { - mPtr = (Method *) ckalloc(sizeof(Method)); + mPtr = ckalloc(sizeof(Method)); mPtr->namePtr = NULL; mPtr->refCount = 1; goto populate; } hPtr = Tcl_CreateHashEntry(&clsPtr->classMethods, (char *)nameObj,&isNew); if (isNew) { - mPtr = (Method *) ckalloc(sizeof(Method)); + mPtr = ckalloc(sizeof(Method)); mPtr->refCount = 1; mPtr->namePtr = nameObj; Tcl_IncrRefCount(nameObj); @@ -280,7 +280,7 @@ TclOODelMethodRef( Tcl_DecrRefCount(mPtr->namePtr); } - ckfree((char *) mPtr); + ckfree(mPtr); } } @@ -344,7 +344,7 @@ TclOONewProcInstanceMethod( if (Tcl_ListObjLength(interp, argsObj, &argsLen) != TCL_OK) { return NULL; } - pmPtr = (ProcedureMethod *) ckalloc(sizeof(ProcedureMethod)); + pmPtr = ckalloc(sizeof(ProcedureMethod)); memset(pmPtr, 0, sizeof(ProcedureMethod)); pmPtr->version = TCLOO_PROCEDURE_METHOD_VERSION; pmPtr->flags = flags & USE_DECLARER_NS; @@ -353,7 +353,7 @@ TclOONewProcInstanceMethod( method = TclOOMakeProcInstanceMethod(interp, oPtr, flags, nameObj, argsObj, bodyObj, &procMethodType, pmPtr, &pmPtr->procPtr); if (method == NULL) { - ckfree((char *) pmPtr); + ckfree(pmPtr); } else if (pmPtrPtr != NULL) { *pmPtrPtr = pmPtr; } @@ -405,7 +405,7 @@ TclOONewProcMethod( procName = (nameObj==NULL ? "<constructor>" : TclGetString(nameObj)); } - pmPtr = (ProcedureMethod *) ckalloc(sizeof(ProcedureMethod)); + pmPtr = ckalloc(sizeof(ProcedureMethod)); memset(pmPtr, 0, sizeof(ProcedureMethod)); pmPtr->version = TCLOO_PROCEDURE_METHOD_VERSION; pmPtr->flags = flags & USE_DECLARER_NS; @@ -418,7 +418,7 @@ TclOONewProcMethod( Tcl_DecrRefCount(argsObj); } if (method == NULL) { - ckfree((char *) pmPtr); + ckfree(pmPtr); } else if (pmPtrPtr != NULL) { *pmPtrPtr = pmPtr; } @@ -499,12 +499,12 @@ TclOOMakeProcInstanceMethod( if (context.line && (context.nline >= 4) && (context.line[3] >= 0)) { int isNew; - CmdFrame *cfPtr = (CmdFrame *) ckalloc(sizeof(CmdFrame)); + CmdFrame *cfPtr = ckalloc(sizeof(CmdFrame)); Tcl_HashEntry *hPtr; cfPtr->level = -1; cfPtr->type = context.type; - cfPtr->line = (int *) ckalloc(sizeof(int)); + cfPtr->line = ckalloc(sizeof(int)); cfPtr->line[0] = context.line[3]; cfPtr->nline = 1; cfPtr->framePtr = NULL; @@ -612,12 +612,12 @@ TclOOMakeProcMethod( if (context.line && (context.nline >= 4) && (context.line[3] >= 0)) { int isNew; - CmdFrame *cfPtr = (CmdFrame *) ckalloc(sizeof(CmdFrame)); + CmdFrame *cfPtr = ckalloc(sizeof(CmdFrame)); Tcl_HashEntry *hPtr; cfPtr->level = -1; cfPtr->type = context.type; - cfPtr->line = (int *) ckalloc(sizeof(int)); + cfPtr->line = ckalloc(sizeof(int)); cfPtr->line[0] = context.line[3]; cfPtr->nline = 1; cfPtr->framePtr = NULL; @@ -711,6 +711,13 @@ InvokeProcedureMethod( result = pmPtr->preCallProc(pmPtr->clientData, interp, context, (Tcl_CallFrame *) fdPtr->framePtr, &isFinished); if (isFinished || result != TCL_OK) { + /* + * Restore the old cmdPtr so that a subsequent use of [info frame] + * won't crash on us. [Bug 3001438] + */ + + pmPtr->procPtr->cmdPtr = fdPtr->oldCmdPtr; + Tcl_PopCallFrame(interp); TclStackFree(interp, fdPtr->framePtr); if (--pmPtr->refCount < 1) { @@ -752,6 +759,13 @@ FinalizePMCall( } /* + * Restore the old cmdPtr so that a subsequent use of [info frame] won't + * crash on us. [Bug 3001438] + */ + + pmPtr->procPtr->cmdPtr = fdPtr->oldCmdPtr; + + /* * Scrap the special frame data now that we're done with it. Note that we * are inlining DeleteProcedureMethod() here; this location is highly * sensitive when it comes to performance! @@ -820,6 +834,14 @@ PushMethodCallFrame( } /* + * Save the old cmdPtr so that when this recursive call returns, we can + * restore it. To do otherwise causes crashes in [info frame] after we + * return from a recursive call. [Bug 3001438] + */ + + fdPtr->oldCmdPtr = pmPtr->procPtr->cmdPtr; + + /* * Compile the body. This operation may fail. */ @@ -845,7 +867,7 @@ PushMethodCallFrame( result = TclProcCompileProc(interp, pmPtr->procPtr, pmPtr->procPtr->bodyPtr, nsPtr, "body of method", namePtr); if (result != TCL_OK) { - return result; + goto failureReturn; } /* @@ -856,7 +878,7 @@ PushMethodCallFrame( result = TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr, (Tcl_Namespace *) nsPtr, FRAME_IS_PROC|FRAME_IS_METHOD); if (result != TCL_OK) { - return result; + goto failureReturn; } fdPtr->framePtr->clientData = contextPtr; @@ -891,6 +913,15 @@ PushMethodCallFrame( } return TCL_OK; + + /* + * Restore the old cmdPtr so that a subsequent use of [info frame] won't + * crash on us. [Bug 3001438] + */ + + failureReturn: + pmPtr->procPtr->cmdPtr = fdPtr->oldCmdPtr; + return result; } /* @@ -929,7 +960,7 @@ ProcedureMethodVarResolver( Tcl_Var *varPtr) { int result; - Tcl_ResolvedVarInfo *rPtr; + Tcl_ResolvedVarInfo *rPtr = NULL; result = ProcedureMethodCompiledVarResolver(interp, varName, strlen(varName), contextNs, &rPtr); @@ -939,6 +970,14 @@ ProcedureMethodVarResolver( } *varPtr = rPtr->fetchProc(interp, rPtr); + + /* + * Must not retain reference to resolved information. [Bug 3105999] + */ + + if (rPtr != NULL) { + rPtr->deleteProc(rPtr); + } return (*varPtr? TCL_OK : TCL_CONTINUE); } @@ -956,8 +995,6 @@ ProcedureMethodCompiledVarConnect( int i, isNew, cacheIt, varLen, len; const char *match, *varName; - varName = TclGetStringFromObj(infoPtr->variableObj, &varLen); - /* * Check that the variable is being requested in a context that is also a * method call; if not (i.e. we're evaluating in the object's namespace or @@ -984,6 +1021,7 @@ ProcedureMethodCompiledVarConnect( * either. */ + varName = TclGetStringFromObj(infoPtr->variableObj, &varLen); if (contextPtr->callPtr->chain[contextPtr->index] .mPtr->declaringClassPtr != NULL) { FOREACH(variableObj, contextPtr->callPtr->chain[contextPtr->index] @@ -1017,6 +1055,14 @@ ProcedureMethodCompiledVarConnect( } if (cacheIt) { infoPtr->cachedObjectVar = TclVarHashGetValue(hPtr); + + /* + * We must keep a reference to the variable so everything will + * continue to work correctly even if it is unset; being unset does + * not end the life of the variable at this level. [Bug 3185009] + */ + + VarHashRefCount(infoPtr->cachedObjectVar)++; } return TclVarHashGetValue(hPtr); } @@ -1027,8 +1073,16 @@ ProcedureMethodCompiledVarDelete( { OOResVarInfo *infoPtr = (OOResVarInfo *) rPtr; + /* + * Release the reference to the variable if we were holding it. + */ + + if (infoPtr->cachedObjectVar) { + VarHashRefCount(infoPtr->cachedObjectVar)--; + TclCleanupVar((Var *) infoPtr->cachedObjectVar, NULL); + } Tcl_DecrRefCount(infoPtr->variableObj); - ckfree((char *) infoPtr); + ckfree(infoPtr); } static int @@ -1053,7 +1107,7 @@ ProcedureMethodCompiledVarResolver( return TCL_CONTINUE; } - infoPtr = (OOResVarInfo *) ckalloc(sizeof(OOResVarInfo)); + infoPtr = ckalloc(sizeof(OOResVarInfo)); infoPtr->info.fetchProc = ProcedureMethodCompiledVarConnect; infoPtr->info.deleteProc = ProcedureMethodCompiledVarDelete; infoPtr->cachedObjectVar = NULL; @@ -1150,15 +1204,6 @@ ConstructorErrorHandler( const char *objectName, *kindName; int objectNameLen; - if (Tcl_GetErrorLine(interp) == (int) 0xDEADBEEF) { - /* - * Horrible hack to deal with certain constructors that must not add - * information to the error trace. - */ - - return; - } - if (mPtr->declaringObjectPtr != NULL) { declarerPtr = mPtr->declaringObjectPtr; kindName = "object"; @@ -1224,7 +1269,7 @@ DeleteProcedureMethodRecord( if (pmPtr->deleteClientdataProc) { pmPtr->deleteClientdataProc(pmPtr->clientData); } - ckfree((char *) pmPtr); + ckfree(pmPtr); } static void @@ -1245,8 +1290,7 @@ CloneProcedureMethod( ClientData *newClientData) { ProcedureMethod *pmPtr = clientData; - ProcedureMethod *pm2Ptr = (ProcedureMethod *) - ckalloc(sizeof(ProcedureMethod)); + ProcedureMethod *pm2Ptr = ckalloc(sizeof(ProcedureMethod)); memcpy(pm2Ptr, pmPtr, sizeof(ProcedureMethod)); pm2Ptr->refCount = 1; @@ -1285,12 +1329,13 @@ TclOONewForwardInstanceMethod( return NULL; } if (prefixLen < 1) { - Tcl_AppendResult(interp, "method forward prefix must be non-empty", - NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "method forward prefix must be non-empty", -1)); + Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_FORWARD", NULL); return NULL; } - fmPtr = (ForwardMethod *) ckalloc(sizeof(ForwardMethod)); + fmPtr = ckalloc(sizeof(ForwardMethod)); fmPtr->prefixObj = prefixObj; Tcl_ListObjIndex(interp, prefixObj, 0, &cmdObj); fmPtr->fullyQualified = (strncmp(TclGetString(cmdObj), "::", 2) == 0); @@ -1326,12 +1371,13 @@ TclOONewForwardMethod( return NULL; } if (prefixLen < 1) { - Tcl_AppendResult(interp, "method forward prefix must be non-empty", - NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "method forward prefix must be non-empty", -1)); + Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_FORWARD", NULL); return NULL; } - fmPtr = (ForwardMethod *) ckalloc(sizeof(ForwardMethod)); + fmPtr = ckalloc(sizeof(ForwardMethod)); fmPtr->prefixObj = prefixObj; Tcl_ListObjIndex(interp, prefixObj, 0, &cmdObj); fmPtr->fullyQualified = (strncmp(TclGetString(cmdObj), "::", 2) == 0); @@ -1415,7 +1461,7 @@ DeleteForwardMethod( ForwardMethod *fmPtr = clientData; Tcl_DecrRefCount(fmPtr->prefixObj); - ckfree((char *) fmPtr); + ckfree(fmPtr); } static int @@ -1425,7 +1471,7 @@ CloneForwardMethod( ClientData *newClientData) { ForwardMethod *fmPtr = clientData; - ForwardMethod *fm2Ptr = (ForwardMethod *) ckalloc(sizeof(ForwardMethod)); + ForwardMethod *fm2Ptr = ckalloc(sizeof(ForwardMethod)); fm2Ptr->prefixObj = fmPtr->prefixObj; fm2Ptr->fullyQualified = fmPtr->fullyQualified; |