summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2006-11-20 14:28:01 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2006-11-20 14:28:01 (GMT)
commita23b22d1236f195c8aff34ed42355da55ca5e18a (patch)
tree47acbf05215f9f3b3553028a16921ac8710178a7
parent5ab9c74b4a9874c1861cbd28eb075b4578abedf5 (diff)
downloadtcl-a23b22d1236f195c8aff34ed42355da55ca5e18a.zip
tcl-a23b22d1236f195c8aff34ed42355da55ca5e18a.tar.gz
tcl-a23b22d1236f195c8aff34ed42355da55ca5e18a.tar.bz2
Make the guts of [chan] more robust.
-rw-r--r--ChangeLog6
-rw-r--r--generic/tclBasic.c62
-rw-r--r--library/init.tcl26
3 files changed, 64 insertions, 30 deletions
diff --git a/ChangeLog b/ChangeLog
index ce83e3c..829f493 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2006-11-20 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclBasic.c (Tcl_CreateInterp, TclHideUnsafeCommands):
+ * library/init.tcl: Refactored the [chan] command's guts so that it
+ does not use aliases to global commands, making the code more robust.
+
2006-11-17 Don Porter <dgp@users.sourceforge.net>
* generic/tclExecute.c (INST_EXPON): Corrected crash on
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 3844e16..a817bd9 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -13,7 +13,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclBasic.c,v 1.218 2006/11/15 20:08:42 dgp Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.219 2006/11/20 14:28:02 dkf Exp $
*/
#include "tclInt.h"
@@ -83,7 +83,7 @@ static void MathFuncWrongNumArgs (Tcl_Interp* interp, int expected,
extern TclStubs tclStubs;
/*
- * The following structure defines the commands in the Tcl core.
+ * The following structures define the commands in the Tcl core.
*/
typedef struct {
@@ -94,12 +94,20 @@ typedef struct {
* safe interpreter. Otherwise it will be
* hidden. */
} CmdInfo;
+typedef struct {
+ const char *name; /* Name of object-based command. */
+ const char *name2; /* Name of secondary object-based command. */
+ Tcl_ObjCmdProc *objProc; /* Object-based function for command. */
+ int isSafe; /* If non-zero, command will be present in
+ * safe interpreter. Otherwise it will be
+ * hidden. */
+} CmdInfo2;
/*
* The built-in commands, and the functions that implement them:
*/
-static CmdInfo builtInCmds[] = {
+static const CmdInfo builtInCmds[] = {
/*
* Commands in the generic core.
*/
@@ -119,8 +127,6 @@ static CmdInfo builtInCmds[] = {
{"eval", Tcl_EvalObjCmd, NULL, 1},
{"exit", Tcl_ExitObjCmd, NULL, 0},
{"expr", Tcl_ExprObjCmd, TclCompileExprCmd, 1},
- {"fcopy", Tcl_FcopyObjCmd, NULL, 1},
- {"fileevent", Tcl_FileEventObjCmd, NULL, 1},
{"for", Tcl_ForObjCmd, TclCompileForCmd, 1},
{"foreach", Tcl_ForeachObjCmd, TclCompileForeachCmd, 1},
{"format", Tcl_FormatObjCmd, NULL, 1},
@@ -171,22 +177,12 @@ static CmdInfo builtInCmds[] = {
#ifndef TCL_GENERIC_ONLY
{"after", Tcl_AfterObjCmd, NULL, 1},
{"cd", Tcl_CdObjCmd, NULL, 0},
- {"close", Tcl_CloseObjCmd, NULL, 1},
- {"eof", Tcl_EofObjCmd, NULL, 1},
- {"fblocked", Tcl_FblockedObjCmd, NULL, 1},
- {"fconfigure", Tcl_FconfigureObjCmd, NULL, 0},
{"file", Tcl_FileObjCmd, NULL, 0},
- {"flush", Tcl_FlushObjCmd, NULL, 1},
- {"gets", Tcl_GetsObjCmd, NULL, 1},
{"glob", Tcl_GlobObjCmd, NULL, 0},
{"open", Tcl_OpenObjCmd, NULL, 0},
{"pid", Tcl_PidObjCmd, NULL, 1},
- {"puts", Tcl_PutsObjCmd, NULL, 1},
{"pwd", Tcl_PwdObjCmd, NULL, 0},
- {"read", Tcl_ReadObjCmd, NULL, 1},
- {"seek", Tcl_SeekObjCmd, NULL, 1},
{"socket", Tcl_SocketObjCmd, NULL, 0},
- {"tell", Tcl_TellObjCmd, NULL, 1},
{"time", Tcl_TimeObjCmd, NULL, 1},
{"update", Tcl_UpdateObjCmd, NULL, 1},
{"vwait", Tcl_VwaitObjCmd, NULL, 1},
@@ -196,6 +192,24 @@ static CmdInfo builtInCmds[] = {
{NULL, NULL, NULL, 0}
};
+static const CmdInfo2 builtInCmds2[] = {
+ {"fileevent", "::tcl::chan::event", Tcl_FileEventObjCmd, 1},
+ {"fcopy", "::tcl::chan::copy", Tcl_FcopyObjCmd, 1},
+#ifndef TCL_GENERIC_ONLY
+ {"close", "::tcl::chan::close", Tcl_CloseObjCmd, 1},
+ {"eof", "::tcl::chan::eof", Tcl_EofObjCmd, 1},
+ {"fblocked", "::tcl::chan::blocked", Tcl_FblockedObjCmd, 1},
+ {"fconfigure", "::tcl::chan::configure", Tcl_FconfigureObjCmd, 0},
+ {"flush", "::tcl::chan::flush", Tcl_FlushObjCmd, 1},
+ {"gets", "::tcl::chan::gets", Tcl_GetsObjCmd, 1},
+ {"puts", "::tcl::chan::puts", Tcl_PutsObjCmd, 1},
+ {"read", "::tcl::chan::read", Tcl_ReadObjCmd, 1},
+ {"seek", "::tcl::chan::seek", Tcl_SeekObjCmd, 1},
+ {"tell", "::tcl::chan::tell", Tcl_TellObjCmd, 1},
+#endif /* TCL_GENERIC_ONLY */
+ {NULL, NULL, 0}
+};
+
/*
* Math functions
*/
@@ -206,7 +220,7 @@ typedef struct {
Tcl_ObjCmdProc *objCmdProc; /* Function that evaluates the function */
ClientData clientData; /* Client data for the function */
} BuiltinFuncDef;
-static BuiltinFuncDef BuiltinFuncTable[] = {
+static const BuiltinFuncDef BuiltinFuncTable[] = {
{ "abs", ExprAbsFunc, NULL },
{ "acos", ExprUnaryFunc, (ClientData) acos },
{ "asin", ExprUnaryFunc, (ClientData) asin },
@@ -262,8 +276,9 @@ Tcl_CreateInterp(void)
Interp *iPtr;
Tcl_Interp *interp;
Command *cmdPtr;
- BuiltinFuncDef *builtinFuncPtr;
+ const BuiltinFuncDef *builtinFuncPtr;
const CmdInfo *cmdInfoPtr;
+ const CmdInfo2 *cmdInfo2Ptr;
Tcl_Namespace *mathfuncNSPtr;
union {
char c[sizeof(short)];
@@ -501,6 +516,12 @@ Tcl_CreateInterp(void)
TclClockInit(interp);
+ for (cmdInfo2Ptr=builtInCmds2; cmdInfo2Ptr->name!=NULL; cmdInfo2Ptr++) {
+ Tcl_CreateObjCommand(interp, cmdInfo2Ptr->name, cmdInfo2Ptr->objProc,
+ NULL, NULL);
+ Tcl_CreateObjCommand(interp, cmdInfo2Ptr->name2, cmdInfo2Ptr->objProc,
+ NULL, NULL);
+ }
/* TIP #208 */
Tcl_CreateObjCommand(interp, "::tcl::chan::Truncate",
TclChanTruncateObjCmd, (ClientData) NULL, NULL);
@@ -632,6 +653,7 @@ TclHideUnsafeCommands(
Tcl_Interp *interp) /* Hide commands in this interpreter. */
{
register const CmdInfo *cmdInfoPtr;
+ register const CmdInfo2 *cmdInfo2Ptr;
if (interp == NULL) {
return TCL_ERROR;
@@ -641,6 +663,12 @@ TclHideUnsafeCommands(
Tcl_HideCommand(interp, cmdInfoPtr->name, cmdInfoPtr->name);
}
}
+ for (cmdInfo2Ptr=builtInCmds2; cmdInfo2Ptr->name!=NULL; cmdInfo2Ptr++) {
+ if (!cmdInfo2Ptr->isSafe) {
+ Tcl_HideCommand(interp, cmdInfo2Ptr->name, cmdInfo2Ptr->name);
+ Tcl_HideCommand(interp, cmdInfo2Ptr->name2, cmdInfo2Ptr->name2);
+ }
+ }
return TCL_OK;
}
diff --git a/library/init.tcl b/library/init.tcl
index 1c7a3a9..13f6d96 100644
--- a/library/init.tcl
+++ b/library/init.tcl
@@ -3,7 +3,7 @@
# Default system startup file for Tcl-based applications. Defines
# "unknown" procedure and auto-load facilities.
#
-# RCS: @(#) $Id: init.tcl,v 1.88 2006/11/03 00:34:52 hobbs Exp $
+# RCS: @(#) $Id: init.tcl,v 1.89 2006/11/20 14:28:03 dkf Exp $
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
@@ -79,21 +79,21 @@ namespace eval tcl {
namespace eval chan {
# TIP #219. Added methods: create, postevent.
namespace ensemble create -command ::chan -map {
- blocked ::fblocked
- close ::close
- configure ::fconfigure
- copy ::fcopy
+ blocked ::tcl::chan::blocked
+ close ::tcl::chan::close
+ configure ::tcl::chan::configure
+ copy ::tcl::chan::copy
create ::tcl::chan::rCreate
- eof ::eof
- event ::fileevent
- flush ::flush
- gets ::gets
+ eof ::tcl::chan::eof
+ event ::tcl::chan::event
+ flush ::tcl::chan::flush
+ gets ::tcl::chan::gets
names {::file channels}
postevent ::tcl::chan::rPostevent
- puts ::puts
- read ::read
- seek ::seek
- tell ::tell
+ puts ::tcl::chan::puts
+ read ::tcl::chan::read
+ seek ::tcl::chan::seek
+ tell ::tcl::chan::tell
truncate ::tcl::chan::Truncate
}
}