summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2009-05-04 17:39:50 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2009-05-04 17:39:50 (GMT)
commitfd6cead82a2f2f559fa5376d1e8cf520ef79da95 (patch)
treee22acd444243f8927257e1586141c941c8d25c0c
parentba58e6442af44bef063652e496e60f09826716ec (diff)
downloadtcl-fd6cead82a2f2f559fa5376d1e8cf520ef79da95.zip
tcl-fd6cead82a2f2f559fa5376d1e8cf520ef79da95.tar.gz
tcl-fd6cead82a2f2f559fa5376d1e8cf520ef79da95.tar.bz2
Stop deletion of support namespaces leading to a potential crash.
-rw-r--r--ChangeLog7
-rw-r--r--generic/tclOO.c68
-rw-r--r--generic/tclOODefineCmds.c9
3 files changed, 73 insertions, 11 deletions
diff --git a/ChangeLog b/ChangeLog
index 91c6ff7..d81ce5d 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,10 @@
+2009-05-04 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclOO.c (InitFoundation, Deleted*Namespace, AllocClass):
+ * generic/tclOODefineCmds.c (InitDefineContext): Make sure that when
+ support namespaces are deleted, nothing bad can subsequently happen.
+ Issue spotted by Don Porter.
+
2009-05-03 Donal K. Fellows <dkf@users.sf.net>
* doc/Tcl.n: [Bug 2538432]: Clarified exact treatment of ${arr(idx)}
diff --git a/generic/tclOO.c b/generic/tclOO.c
index 430e1cc..4c0b253 100644
--- a/generic/tclOO.c
+++ b/generic/tclOO.c
@@ -8,7 +8,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclOO.c,v 1.19 2009/01/06 10:20:54 dkf Exp $
+ * RCS: @(#) $Id: tclOO.c,v 1.20 2009/05/04 17:39:51 dkf Exp $
*/
#ifdef HAVE_CONFIG_H
@@ -72,6 +72,9 @@ 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(ClientData clientData);
+static void DeletedObjdefNamespace(ClientData clientData);
+static void DeletedHelpersNamespace(ClientData clientData);
static int FinalizeAlloc(ClientData data[],
Tcl_Interp *interp, int result);
static int FinalizeNext(ClientData data[],
@@ -233,11 +236,12 @@ 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", NULL, NULL);
- fPtr->objdefNs = Tcl_CreateNamespace(interp, "::oo::objdefine", NULL,
- NULL);
- fPtr->helpersNs = Tcl_CreateNamespace(interp, "::oo::Helpers", NULL,
- NULL);
+ fPtr->defineNs = Tcl_CreateNamespace(interp, "::oo::define", fPtr,
+ DeletedDefineNamespace);
+ fPtr->objdefNs = Tcl_CreateNamespace(interp, "::oo::objdefine", fPtr,
+ DeletedObjdefNamespace);
+ fPtr->helpersNs = Tcl_CreateNamespace(interp, "::oo::Helpers", fPtr,
+ DeletedHelpersNamespace);
fPtr->epoch = 0;
fPtr->tsdPtr = tsdPtr;
fPtr->unknownMethodNameObj = Tcl_NewStringObj("unknown", -1);
@@ -354,6 +358,44 @@ InitFoundation(
/*
* ----------------------------------------------------------------------
*
+ * DeletedDefineNamespace, DeletedObjdefNamespace, DeletedHelpersNamespace --
+ *
+ * Simple helpers used to clear fields of the foundation when they no
+ * longer hold useful information.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static void
+DeletedDefineNamespace(
+ ClientData clientData)
+{
+ Foundation *fPtr = clientData;
+
+ fPtr->defineNs = NULL;
+}
+
+static void
+DeletedObjdefNamespace(
+ ClientData clientData)
+{
+ Foundation *fPtr = clientData;
+
+ fPtr->objdefNs = NULL;
+}
+
+static void
+DeletedHelpersNamespace(
+ ClientData clientData)
+{
+ Foundation *fPtr = clientData;
+
+ fPtr->helpersNs = NULL;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
* KillFoundation --
*
* Delete those parts of the OO core that are not deleted automatically
@@ -1154,7 +1196,6 @@ AllocClass(
{
Foundation *fPtr = GetFoundation(interp);
Class *clsPtr = (Class *) ckalloc(sizeof(Class));
- Tcl_Namespace *path[2];
/*
* Make an object if we haven't been given one.
@@ -1171,9 +1212,16 @@ AllocClass(
* Configure the namespace path for the class's object.
*/
- path[0] = fPtr->helpersNs;
- path[1] = fPtr->ooNs;
- TclSetNsPath((Namespace *) clsPtr->thisPtr->namespacePtr, 2, path);
+ if (fPtr->helpersNs != NULL) {
+ Tcl_Namespace *path[2];
+
+ path[0] = fPtr->helpersNs;
+ path[1] = fPtr->ooNs;
+ TclSetNsPath((Namespace *) clsPtr->thisPtr->namespacePtr, 2, path);
+ } else {
+ TclSetNsPath((Namespace *) clsPtr->thisPtr->namespacePtr, 1,
+ &fPtr->ooNs);
+ }
/*
* Class objects inherit from the class of classes unless they inherit
diff --git a/generic/tclOODefineCmds.c b/generic/tclOODefineCmds.c
index b732eec..2fb9ce5 100644
--- a/generic/tclOODefineCmds.c
+++ b/generic/tclOODefineCmds.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: tclOODefineCmds.c,v 1.10 2009/02/12 09:27:43 dkf Exp $
+ * RCS: @(#) $Id: tclOODefineCmds.c,v 1.11 2009/05/04 17:39:51 dkf Exp $
*/
#ifdef HAVE_CONFIG_H
@@ -564,6 +564,13 @@ InitDefineContext(
CallFrame *framePtr, **framePtrPtr = &framePtr;
int result;
+ if (namespacePtr == NULL) {
+ Tcl_AppendResult(interp,
+ "cannot process definitions; support namespace deleted",
+ NULL);
+ return TCL_ERROR;
+ }
+
/* framePtrPtr is needed to satisfy GCC 3.3's strict aliasing rules */
result = TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr,