diff options
| -rw-r--r-- | ChangeLog | 6 | ||||
| -rw-r--r-- | generic/tclBasic.c | 62 | ||||
| -rw-r--r-- | library/init.tcl | 26 |
3 files changed, 64 insertions, 30 deletions
@@ -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 } } |