summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorhobbs <hobbs>2002-11-23 01:22:50 (GMT)
committerhobbs <hobbs>2002-11-23 01:22:50 (GMT)
commitb56bfc9dd2b0556ccc280a089ad5f815b86cae2d (patch)
tree6c4800d302936f5d02e10350f1807f6e9db635da
parentada87b51edc6c26dcb7261164f7092a397ba120c (diff)
downloadtcl-b56bfc9dd2b0556ccc280a089ad5f815b86cae2d.zip
tcl-b56bfc9dd2b0556ccc280a089ad5f815b86cae2d.tar.gz
tcl-b56bfc9dd2b0556ccc280a089ad5f815b86cae2d.tar.bz2
* tests/interp.test: interp-14.4
* generic/tclInterp.c (TclPreventAliasLoop): prevent seg fault when creating an alias command over the interp name. [Bug #641195]
-rw-r--r--ChangeLog6
-rw-r--r--generic/tclInterp.c21
-rw-r--r--tests/interp.test8
3 files changed, 29 insertions, 6 deletions
diff --git a/ChangeLog b/ChangeLog
index 36d95d7..f86f207 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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} {