diff options
author | dkf <donal.k.fellows@manchester.ac.uk> | 2003-05-07 21:15:43 (GMT) |
---|---|---|
committer | dkf <donal.k.fellows@manchester.ac.uk> | 2003-05-07 21:15:43 (GMT) |
commit | 3b3fd58326def069be2ac1b8aab26a9d875aa237 (patch) | |
tree | ef4a6196a9098acb617cbec70c0b2a10a0874bbe | |
parent | c9ca13a50c7725c87968a8ce5e2053d23b5bd5cf (diff) | |
download | tcl-3b3fd58326def069be2ac1b8aab26a9d875aa237.zip tcl-3b3fd58326def069be2ac1b8aab26a9d875aa237.tar.gz tcl-3b3fd58326def069be2ac1b8aab26a9d875aa237.tar.bz2 |
Made error message for [trace info] more consistent with documentation.
-rw-r--r-- | ChangeLog | 3 | ||||
-rw-r--r-- | generic/tclCmdMZ.c | 28 | ||||
-rw-r--r-- | tests/trace.test | 4 |
3 files changed, 30 insertions, 5 deletions
@@ -1,5 +1,8 @@ 2003-05-07 Donal K. Fellows <fellowsd@cs.man.ac.uk> + * generic/tclCmdMZ.c (Tcl_TraceObjCmd): Made error message for + 'trace info' more consistent with documentation. [Bug 706961] + * generic/tclDictObj.c (DictInfoCmd): Fixed memory leak caused by confusion about string ownership. [Bug 731706] diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index 3e9d8d0..079ef15 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -14,7 +14,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCmdMZ.c,v 1.87 2003/05/05 20:54:38 dgp Exp $ + * RCS: @(#) $Id: tclCmdMZ.c,v 1.88 2003/05/07 21:15:44 dkf Exp $ */ #include "tclInt.h" @@ -2882,8 +2882,7 @@ Tcl_TraceObjCmd(dummy, interp, objc, objv) } switch ((enum traceOptions) optionIndex) { case TRACE_ADD: - case TRACE_REMOVE: - case TRACE_INFO: { + case TRACE_REMOVE: { /* * All sub commands of trace add/remove must take at least * one more argument. Beyond that we let the subcommand itself @@ -2901,6 +2900,29 @@ Tcl_TraceObjCmd(dummy, interp, objc, objv) return (traceSubCmds[typeIndex])(interp, optionIndex, objc, objv); break; } + case TRACE_INFO: { + /* + * All sub commands of trace info must take exactly two + * more arguments which name the type of thing being + * traced and the name of the thing being traced. + */ + int typeIndex; + if (objc < 3) { + /* + * Delegate other complaints to the type-specific code + * which can give a better error message. + */ + Tcl_WrongNumArgs(interp, 2, objv, "type name"); + return TCL_ERROR; + } + if (Tcl_GetIndexFromObj(interp, objv[2], traceTypeOptions, + "option", 0, &typeIndex) != TCL_OK) { + return TCL_ERROR; + } + return (traceSubCmds[typeIndex])(interp, optionIndex, objc, objv); + break; + } + #ifndef TCL_REMOVE_OBSOLETE_TRACES case TRACE_OLD_VARIABLE: { int flags; diff --git a/tests/trace.test b/tests/trace.test index 263b402..f757619 100644 --- a/tests/trace.test +++ b/tests/trace.test @@ -11,7 +11,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: trace.test,v 1.27 2003/03/27 13:19:15 dkf Exp $ +# RCS: @(#) $Id: trace.test,v 1.28 2003/05/07 21:15:44 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -780,7 +780,7 @@ test trace-14.3 "trace command, wrong # args errors" { } [list 1 "wrong # args: should be \"trace remove type ?arg arg ...?\""] test trace-14.4 "trace command, wrong # args errors" { list [catch {trace info} msg] $msg -} [list 1 "wrong # args: should be \"trace info type ?arg arg ...?\""] +} [list 1 "wrong # args: should be \"trace info type name\""] test trace-14.5 {trace command, invalid option} { list [catch {trace gorp} msg] $msg |