summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2024-05-17 13:28:51 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2024-05-17 13:28:51 (GMT)
commit3c40e6048981fffbf3f87e3097fd7b14b748e79b (patch)
tree639e43ec0fc4e3db26702fe545c888a6f60eed1a /generic
parentaa585c0ac925c9ca50a5a98d65e576eb93e5afcc (diff)
downloadtcl-3c40e6048981fffbf3f87e3097fd7b14b748e79b.zip
tcl-3c40e6048981fffbf3f87e3097fd7b14b748e79b.tar.gz
tcl-3c40e6048981fffbf3f87e3097fd7b14b748e79b.tar.bz2
Fix the problem properly
Diffstat (limited to 'generic')
-rw-r--r--generic/tclOOInt.h1
-rw-r--r--generic/tclOOMethod.c158
2 files changed, 56 insertions, 103 deletions
diff --git a/generic/tclOOInt.h b/generic/tclOOInt.h
index e7d727a..41c674c 100644
--- a/generic/tclOOInt.h
+++ b/generic/tclOOInt.h
@@ -97,6 +97,7 @@ typedef struct ProcedureMethod {
GetFrameInfoValueProc *gfivProc;
/* Callback to allow for fine tuning of how
* the method reports itself. */
+ Command cmd; /* Space used to connect to [info frame] */
ExtraFrameInfo efi; /* Space used to store data for [info frame] */
Tcl_Interp *interp; /* Interpreter in which to compute the name of
* the method. */
diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c
index 1347aa5..5cff201 100644
--- a/generic/tclOOMethod.c
+++ b/generic/tclOOMethod.c
@@ -25,10 +25,8 @@ typedef struct {
CallFrame *framePtr; /* Reference to the call frame itself (it's
* actually allocated on the Tcl stack). */
ProcErrorProc *errProc; /* The error handler for the body. */
- Tcl_Obj *nameObj; /* The "name" of the command. */
- Command cmd; /* The command structure. Mostly bogus. */
- Command *oldCmdPtr; /* Saved cmdPtr so that we can be safe after a
- * recursive call returns. */
+ Tcl_Obj *nameObj; /* The "name" of the command. Only used for a
+ * few moments, so not reference. */
} PMFrameData;
/*
@@ -72,8 +70,6 @@ static void ConstructorErrorHandler(Tcl_Interp *interp,
Tcl_Obj *procNameObj);
static void DestructorErrorHandler(Tcl_Interp *interp,
Tcl_Obj *procNameObj);
-static inline void InitFrameInfo(Tcl_Interp *interp,
- ProcedureMethod *pmPtr, Tcl_ObjectContext context);
static Tcl_Obj * RenderMethodName(void *clientData);
static Tcl_Obj * RenderDeclarerName(void *clientData);
static int InvokeForwardMethod(void *clientData,
@@ -111,6 +107,20 @@ static const Tcl_MethodType fwdMethodType = {
((Tcl_HashTable *) (&((Namespace *) (contextNs))->varTable))
#define TclVarHashGetValue(hPtr) \
((Tcl_Var) ((char *)hPtr - TclOffset(VarInHash, entry)))
+
+static inline ProcedureMethod *
+AllocProcedureMethodRecord(
+ int flags)
+{
+ ProcedureMethod *pmPtr = (ProcedureMethod *)
+ ckalloc(sizeof(ProcedureMethod));
+ memset(pmPtr, 0, sizeof(ProcedureMethod));
+ pmPtr->version = TCLOO_PROCEDURE_METHOD_VERSION;
+ pmPtr->flags = flags & USE_DECLARER_NS;
+ pmPtr->refCount = 1;
+ pmPtr->cmd.clientData = &pmPtr->efi;
+ return pmPtr;
+}
/*
* ----------------------------------------------------------------------
@@ -331,12 +341,7 @@ TclOONewProcInstanceMethod(
if (TclListObjLength(interp, argsObj, &argsLen) != TCL_OK) {
return NULL;
}
- pmPtr = (ProcedureMethod *)ckalloc(sizeof(ProcedureMethod));
- memset(pmPtr, 0, sizeof(ProcedureMethod));
- pmPtr->version = TCLOO_PROCEDURE_METHOD_VERSION;
- pmPtr->flags = flags & USE_DECLARER_NS;
- pmPtr->refCount = 1;
-
+ pmPtr = AllocProcedureMethodRecord(flags);
method = TclOOMakeProcInstanceMethod(interp, oPtr, flags, nameObj,
argsObj, bodyObj, &procMethodType, pmPtr, &pmPtr->procPtr);
if (method == NULL) {
@@ -392,12 +397,7 @@ TclOONewProcMethod(
procName = (nameObj==NULL ? "<constructor>" : TclGetString(nameObj));
}
- pmPtr = (ProcedureMethod *)ckalloc(sizeof(ProcedureMethod));
- memset(pmPtr, 0, sizeof(ProcedureMethod));
- pmPtr->version = TCLOO_PROCEDURE_METHOD_VERSION;
- pmPtr->flags = flags & USE_DECLARER_NS;
- pmPtr->refCount = 1;
-
+ pmPtr = AllocProcedureMethodRecord(flags);
method = TclOOMakeProcMethod(interp, clsPtr, flags, nameObj, procName,
argsObj, bodyObj, &procMethodType, pmPtr, &pmPtr->procPtr);
@@ -671,7 +671,36 @@ InvokeProcedureMethod(
Tcl_ObjectContextSkippedArgs(context));
}
- InitFrameInfo(interp, pmPtr, context);
+ /*
+ * Finishes filling out the extra frame info so that [info frame] works if
+ * that is not already set up.
+ */
+
+ if (pmPtr->efi.length == 0) {
+ Tcl_Method method = Tcl_ObjectContextMethod(context);
+
+ pmPtr->efi.length = 2;
+ pmPtr->efi.fields[0].name = "method";
+ pmPtr->efi.fields[0].proc = RenderMethodName;
+ pmPtr->efi.fields[0].clientData = pmPtr;
+ pmPtr->callSiteFlags = ((CallContext *)
+ context)->callPtr->flags & (CONSTRUCTOR | DESTRUCTOR);
+ pmPtr->interp = interp;
+ pmPtr->method = method;
+ if (pmPtr->gfivProc != NULL) {
+ pmPtr->efi.fields[1].name = "";
+ pmPtr->efi.fields[1].proc = pmPtr->gfivProc;
+ pmPtr->efi.fields[1].clientData = pmPtr;
+ } else {
+ if (Tcl_MethodDeclarerObject(method) != NULL) {
+ pmPtr->efi.fields[1].name = "object";
+ } else {
+ pmPtr->efi.fields[1].name = "class";
+ }
+ pmPtr->efi.fields[1].proc = RenderDeclarerName;
+ pmPtr->efi.fields[1].clientData = pmPtr;
+ }
+ }
/*
* Allocate the special frame data.
@@ -702,13 +731,6 @@ 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) {
@@ -728,48 +750,6 @@ InvokeProcedureMethod(
Tcl_ObjectContextSkippedArgs(context), fdPtr->errProc);
}
-/*
- * Finishes filling out the extra frame info so that [info frame] works.
- */
-static inline void
-InitFrameInfo(
- Tcl_Interp *interp, /* For object name resolution later. */
- ProcedureMethod *pmPtr, /* What we're writing to. */
- Tcl_ObjectContext context) /* The calling context, used to figure out how
- * we're using the method. */
-{
- Tcl_Method method = Tcl_ObjectContextMethod(context);
-
- if (pmPtr->efi.length) {
- /*
- * Do nothing if already set up.
- */
- return;
- }
-
- pmPtr->efi.length = 2;
- pmPtr->efi.fields[0].name = "method";
- pmPtr->efi.fields[0].proc = RenderMethodName;
- pmPtr->efi.fields[0].clientData = pmPtr;
- pmPtr->callSiteFlags = ((CallContext *)
- context)->callPtr->flags & (CONSTRUCTOR | DESTRUCTOR);
- pmPtr->interp = interp;
- pmPtr->method = method;
- if (pmPtr->gfivProc != NULL) {
- pmPtr->efi.fields[1].name = "";
- pmPtr->efi.fields[1].proc = pmPtr->gfivProc;
- pmPtr->efi.fields[1].clientData = pmPtr;
- } else {
- if (Tcl_MethodDeclarerObject(method) != NULL) {
- pmPtr->efi.fields[1].name = "object";
- } else {
- pmPtr->efi.fields[1].name = "class";
- }
- pmPtr->efi.fields[1].proc = RenderDeclarerName;
- pmPtr->efi.fields[1].clientData = pmPtr;
- }
-}
-
static int
FinalizePMCall(
void *data[],
@@ -792,13 +772,6 @@ 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!
@@ -862,29 +835,15 @@ 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.
- */
-
- memset(&fdPtr->cmd, 0, sizeof(Command));
- fdPtr->cmd.nsPtr = nsPtr;
- fdPtr->cmd.clientData = &pmPtr->efi;
- pmPtr->procPtr->cmdPtr = &fdPtr->cmd;
-
- /*
+ * Compile the body.
+ *
* [Bug 2037727] Always call TclProcCompileProc so that we check not only
* that we have bytecode, but also that it remains valid. Note that we set
* the namespace of the code here directly; this is a hack, but the
* alternative is *so* slow...
*/
+ pmPtr->procPtr->cmdPtr = &pmPtr->cmd;
if (pmPtr->procPtr->bodyPtr->typePtr == &tclByteCodeType) {
ByteCode *codePtr =
pmPtr->procPtr->bodyPtr->internalRep.twoPtrValue.ptr1;
@@ -895,12 +854,12 @@ PushMethodCallFrame(
pmPtr->procPtr->bodyPtr, nsPtr, "body of method",
TclGetString(fdPtr->nameObj));
if (result != TCL_OK) {
- goto failureReturn;
+ return result;
}
/*
* Make the stack frame and fill it out with information about this call.
- * This operation may fail.
+ * This operation doesn't ever actually fail.
*/
(void) TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr,
@@ -912,15 +871,6 @@ PushMethodCallFrame(
fdPtr->framePtr->procPtr = pmPtr->procPtr;
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;
}
/*
@@ -1357,6 +1307,8 @@ CloneProcedureMethod(
pm2Ptr = (ProcedureMethod *)ckalloc(sizeof(ProcedureMethod));
memcpy(pm2Ptr, pmPtr, sizeof(ProcedureMethod));
pm2Ptr->refCount = 1;
+ pm2Ptr->cmd.clientData = &pm2Ptr->efi;
+ pm2Ptr->efi.length = 0; /* Trigger a reinit of this. */
Tcl_IncrRefCount(argsObj);
Tcl_IncrRefCount(bodyObj);
if (TclCreateProc(interp, NULL, "", argsObj, bodyObj,