diff options
author | dkf <donal.k.fellows@manchester.ac.uk> | 2009-05-04 17:39:50 (GMT) |
---|---|---|
committer | dkf <donal.k.fellows@manchester.ac.uk> | 2009-05-04 17:39:50 (GMT) |
commit | fd6cead82a2f2f559fa5376d1e8cf520ef79da95 (patch) | |
tree | e22acd444243f8927257e1586141c941c8d25c0c | |
parent | ba58e6442af44bef063652e496e60f09826716ec (diff) | |
download | tcl-fd6cead82a2f2f559fa5376d1e8cf520ef79da95.zip tcl-fd6cead82a2f2f559fa5376d1e8cf520ef79da95.tar.gz tcl-fd6cead82a2f2f559fa5376d1e8cf520ef79da95.tar.bz2 |
Stop deletion of support namespaces leading to a potential crash.
-rw-r--r-- | ChangeLog | 7 | ||||
-rw-r--r-- | generic/tclOO.c | 68 | ||||
-rw-r--r-- | generic/tclOODefineCmds.c | 9 |
3 files changed, 73 insertions, 11 deletions
@@ -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, |