summaryrefslogtreecommitdiffstats
path: root/generic/tclOOMethod.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclOOMethod.c')
-rw-r--r--generic/tclOOMethod.c134
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;
generated by cgit v0.12 at 2024-08-23 14:47:31 (GMT)