diff options
| -rw-r--r-- | ChangeLog | 5 | ||||
| -rw-r--r-- | generic/tclInterp.c | 30 | ||||
| -rw-r--r-- | tests/interp.test | 13 |
3 files changed, 37 insertions, 11 deletions
@@ -1,9 +1,14 @@ 2001-11-16 Kevin B. Kenny <kennykb@users.sourceforge.net> + * generic/tclListObj.c: removed a C++-style comment that was inadvertently left in the source code. 2001-11-16 Jeff Hobbs <jeffh@ActiveState.com> + * tests/interp.test: + * generic/tclInterp.c (SlaveObjCmd): Corrected argument checking + for '$interp alias|aliases|issafe'. [Patch #479560] (thoyts, hobbs) + * unix/tclUnixInit.c: added HAVE_LANGINFO code block. * unix/configure: regened * unix/configure.in: added SC_ENABLE_LANGINFO call diff --git a/generic/tclInterp.c b/generic/tclInterp.c index fcc27bd..e6e7ca6 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.7 2001/09/11 00:46:35 hobbs Exp $ + * RCS: @(#) $Id: tclInterp.c,v 1.8 2001/11/16 22:28:08 hobbs Exp $ */ #include <stdio.h> @@ -1856,22 +1856,28 @@ SlaveObjCmd(clientData, interp, objc, objv) switch ((enum options) index) { case OPT_ALIAS: { - if (objc == 3) { - return AliasDescribe(interp, slaveInterp, objv[2]); - } - if (Tcl_GetString(objv[3])[0] == '\0') { - if (objc == 4) { - return AliasDelete(interp, slaveInterp, objv[2]); + if (objc > 2) { + if (objc == 3) { + return AliasDescribe(interp, slaveInterp, objv[2]); + } + if (Tcl_GetString(objv[3])[0] == '\0') { + if (objc == 4) { + return AliasDelete(interp, slaveInterp, objv[2]); + } + } else { + return AliasCreate(interp, slaveInterp, interp, objv[2], + objv[3], objc - 4, objv + 4); } - } else { - return AliasCreate(interp, slaveInterp, interp, objv[2], - objv[3], objc - 4, objv + 4); } Tcl_WrongNumArgs(interp, 2, objv, "aliasName ?targetName? ?args..?"); return TCL_ERROR; } case OPT_ALIASES: { + if (objc != 2) { + Tcl_WrongNumArgs(interp, 2, objv, (char *) NULL); + return TCL_ERROR; + } return AliasList(interp, slaveInterp); } case OPT_EVAL: { @@ -1903,6 +1909,10 @@ SlaveObjCmd(clientData, interp, objc, objv) return SlaveHidden(interp, slaveInterp); } case OPT_ISSAFE: { + if (objc != 2) { + Tcl_WrongNumArgs(interp, 2, objv, (char *) NULL); + return TCL_ERROR; + } Tcl_SetIntObj(Tcl_GetObjResult(interp), Tcl_IsSafe(slaveInterp)); return TCL_OK; } diff --git a/tests/interp.test b/tests/interp.test index 0dab342..5d72a7b 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.12 2001/03/29 23:24:32 mdejong Exp $ +# RCS: @(#) $Id: interp.test,v 1.13 2001/11/16 22:28:08 hobbs Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -259,6 +259,9 @@ test interp-7.4 {testing basic alias creation} { test interp-7.5 {testing basic alias creation} { a aliases } {foo bar} +test interp-7.6 {testing basic aliases arg checking} { + list [catch {a aliases too many args} msg] $msg +} {1 {wrong # args: should be "a aliases"}} # Part 7: testing basic alias invocation test interp-8.1 {testing basic alias invocation} { @@ -271,6 +274,10 @@ test interp-8.2 {testing basic alias invocation} { a alias bar in_master a1 a2 a3 a eval bar s1 s2 s3 } {seen in master: {a1 a2 a3 s1 s2 s3}} +test interp-8.3 {testing basic alias invocation} { + catch {interp create a} + list [catch {a alias} msg] $msg +} {1 {wrong # args: should be "a alias aliasName ?targetName? ?args..?"}} # Part 8: Testing aliases for non-existent targets test interp-9.1 {testing aliases for non-existent targets} { @@ -441,6 +448,10 @@ test interp-13.3 {testing foo issafe} { interp create {a x3 foo} a eval x3 eval foo issafe } 1 +test interp-7.6 {testing issafe arg checking} { + catch {interp create a} + list [catch {a issafe too many args} msg] $msg +} {1 {wrong # args: should be "a issafe"}} # part 14: testing interp aliases test interp-14.1 {testing interp aliases} { |