diff options
| -rw-r--r-- | ChangeLog | 6 | ||||
| -rw-r--r-- | generic/tclInterp.c | 21 | ||||
| -rw-r--r-- | tests/interp.test | 8 |
3 files changed, 29 insertions, 6 deletions
@@ -1,3 +1,9 @@ +2002-11-22 Jeff Hobbs <jeffh@ActiveState.com> + + * tests/interp.test: interp-14.4 + * generic/tclInterp.c (TclPreventAliasLoop): prevent seg fault + when creating an alias command over the interp name. [Bug #641195] + 2002-11-18 Jeff Hobbs <jeffh@ActiveState.com> * generic/tclUtil.c (SetEndOffsetFromAny): handle integer offset diff --git a/generic/tclInterp.c b/generic/tclInterp.c index cd61b06..8a7a2ca 100644 --- a/generic/tclInterp.c +++ b/generic/tclInterp.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: tclInterp.c,v 1.18 2002/09/03 16:31:32 msofer Exp $ + * RCS: @(#) $Id: tclInterp.c,v 1.19 2002/11/23 01:22:50 hobbs Exp $ */ #include "tclInt.h" @@ -1063,7 +1063,7 @@ TclPreventAliasLoop(interp, cmdInterp, cmd) Alias *aliasPtr, *nextAliasPtr; Tcl_Command aliasCmd; Command *aliasCmdPtr; - + /* * If we are not creating or renaming an alias, then it is * always OK to create or rename the command. @@ -1089,6 +1089,18 @@ TclPreventAliasLoop(interp, cmdInterp, cmd) * the source alias, we have a loop. */ + if (((Interp *)(nextAliasPtr->targetInterp))->flags & DELETED) { + /* + * The slave interpreter can be deleted while creating the alias. + * [Bug #641195] + */ + + Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), + "cannot define or rename alias \"", + Tcl_GetString(aliasPtr->namePtr), + "\": interpreter deleted", (char *) NULL); + return TCL_ERROR; + } cmdNamePtr = nextAliasPtr->objPtr; aliasCmd = Tcl_FindCommand(nextAliasPtr->targetInterp, Tcl_GetString(cmdNamePtr), @@ -1153,12 +1165,11 @@ AliasCreate(interp, slaveInterp, masterInterp, namePtr, targetNamePtr, { Alias *aliasPtr; Tcl_HashEntry *hPtr; - int new; Target *targetPtr; Slave *slavePtr; Master *masterPtr; - int i; Tcl_Obj **prefv; + int new, i; aliasPtr = (Alias *) ckalloc((unsigned) (sizeof(Alias) + objc * sizeof(Tcl_Obj *))); @@ -1210,7 +1221,7 @@ AliasCreate(interp, slaveInterp, masterInterp, namePtr, targetNamePtr, return TCL_ERROR; } - + /* * Make an entry in the alias table. If it already exists delete * the alias command. Then retry. diff --git a/tests/interp.test b/tests/interp.test index b05454f..5824639 100644 --- a/tests/interp.test +++ b/tests/interp.test @@ -10,7 +10,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: interp.test,v 1.17 2002/07/29 15:56:54 msofer Exp $ +# RCS: @(#) $Id: interp.test,v 1.18 2002/11/23 01:22:51 hobbs Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -497,6 +497,12 @@ test interp-14.3 {testing interp aliases} { interp alias {a x3} froboz "" puts interp aliases {a x3} } froboz +test interp-14.4 {testing interp alias - alias over master} { + # SF Bug 641195 + catch {interp delete a} + interp create a + list [catch {interp alias "" a a eval} msg] $msg [info commands a] +} {1 {cannot define or rename alias "a": interpreter deleted} {}} # part 15: testing file sharing test interp-15.1 {testing file sharing} { |