diff options
| -rw-r--r-- | ChangeLog | 6 | ||||
| -rw-r--r-- | generic/tclIOCmd.c | 16 | ||||
| -rw-r--r-- | generic/tclIndexObj.c | 9 | ||||
| -rw-r--r-- | generic/tclInt.h | 7 | ||||
| -rw-r--r-- | tests/chan.test | 12 |
5 files changed, 37 insertions, 13 deletions
@@ -1,3 +1,9 @@ +2005-06-07 Donal K. Fellows <dkf@users.sf.net> + + * generic/tclInt.h (INTERP_TRACE_IN_PROGRESS): Add flag so the error + * generic/tclIndexObj.c (Tcl_WrongNumArgs): messages from ensembles + * generic/tclIOCmd.c (Tcl_ReadObjCmd): can be correct. + 2005-06-07 Don Porter <dgp@users.sourceforge.net> * generic/tclDecls.h: make genstubs diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c index 0d2f681..f33bde5 100644 --- a/generic/tclIOCmd.c +++ b/generic/tclIOCmd.c @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclIOCmd.c,v 1.26 2005/06/07 02:12:45 dgp Exp $ + * RCS: @(#) $Id: tclIOCmd.c,v 1.27 2005/06/07 10:05:00 dkf Exp $ */ #include "tclInt.h" @@ -305,10 +305,18 @@ Tcl_ReadObjCmd(dummy, interp, objc, objv) Tcl_Obj *resultPtr; if ((objc != 2) && (objc != 3)) { - argerror: + Interp *iPtr; + + argerror: + iPtr = (Interp *) interp; Tcl_WrongNumArgs(interp, 1, objv, "channelId ?numChars?"); - Tcl_AppendResult(interp, " or \"", Tcl_GetString(objv[0]), - " ?-nonewline? channelId\"", (char *) NULL); + /* + * Do not append directly; that makes ensembles using this + * command as a subcommand produce the wrong message. + */ + iPtr->flags |= INTERP_ALTERNATE_WRONG_ARGS; + Tcl_WrongNumArgs(interp, 1, objv, "?-nonewline? channelId"); + iPtr->flags &= ~INTERP_ALTERNATE_WRONG_ARGS; return TCL_ERROR; } diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c index 478e3a9..9b858ab 100644 --- a/generic/tclIndexObj.c +++ b/generic/tclIndexObj.c @@ -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: tclIndexObj.c,v 1.22 2004/11/25 16:37:15 dkf Exp $ + * RCS: @(#) $Id: tclIndexObj.c,v 1.23 2005/06/07 10:05:00 dkf Exp $ */ #include "tclInt.h" @@ -462,7 +462,12 @@ Tcl_WrongNumArgs(interp, objc, objv, message) #endif /* AVOID_HACKS_FOR_ITCL */ TclNewObj(objPtr); - Tcl_AppendToObj(objPtr, "wrong # args: should be \"", -1); + if (iPtr->flags & INTERP_ALTERNATE_WRONG_ARGS) { + Tcl_AppendObjToObj(objPtr, Tcl_GetObjResult(interp)); + Tcl_AppendToObj(objPtr, " or \"", -1); + } else { + Tcl_AppendToObj(objPtr, "wrong # args: should be \"", -1); + } /* * Check to see if we are processing an ensemble implementation, diff --git a/generic/tclInt.h b/generic/tclInt.h index 0e075bb..17566ef 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclInt.h,v 1.233 2005/06/06 23:45:44 dkf Exp $ + * RCS: @(#) $Id: tclInt.h,v 1.234 2005/06/07 10:05:00 dkf Exp $ */ #ifndef _TCLINT @@ -1530,6 +1530,10 @@ typedef struct Interp { * INTERP_TRACE_IN_PROGRESS: Non-zero means that an interp trace is currently * active; so no further trace callbacks should be * invoked. + * INTERP_ALTERNATE_WRONG_ARGS: Used for listing second and subsequent forms + * of the wrong-num-args string in Tcl_WrongNumArgs. + * Makes it append instead of replacing and uses + * different intermediate text. * * WARNING: For the sake of some extensions that have made use of former * internal values, do not re-use the flag values 2 (formerly ERR_IN_PROGRESS) @@ -1542,6 +1546,7 @@ typedef struct Interp { #define RAND_SEED_INITIALIZED 0x40 #define SAFE_INTERP 0x80 #define INTERP_TRACE_IN_PROGRESS 0x200 +#define INTERP_ALTERNATE_WRONG_ARGS 0x400 /* * Maximum number of levels of nesting permitted in Tcl commands (used diff --git a/tests/chan.test b/tests/chan.test index ae866bd..93cadc9 100644 --- a/tests/chan.test +++ b/tests/chan.test @@ -7,7 +7,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: chan.test,v 1.1 2005/06/06 23:45:46 dkf Exp $ +# RCS: @(#) $Id: chan.test,v 1.2 2005/06/07 10:05:01 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -16,10 +16,10 @@ if {[lsearch [namespace children] ::tcltest] == -1} { test chan-1.1 {chan command general syntax} -body { chan -} -returnCodes error -result "wrong # args: should be \"chan subcommand ...\"" +} -returnCodes error -result "wrong # args: should be \"chan subcommand ?argument ...?\"" test chan-1.2 {chan command general syntax} -body { chan FOOBAR -} -returnCodes error -result "unknown or ambiguous command \"FOOBAR\": should be one of blocked, close, configure, copy, eof, event, flush, gets, names, puts, read, seek, tell, and truncate" +} -returnCodes error -result "unknown or ambiguous subcommand \"FOOBAR\": must be blocked, close, configure, copy, eof, event, flush, gets, names, puts, read, seek, tell, or truncate" test chan-2.1 {chan command: blocked subcommand} -body { chan blocked foo bar @@ -30,7 +30,7 @@ test chan-3.1 {chan command: close subcommand} -body { } -returnCodes error -result "wrong # args: should be \"chan close channelId\"" test chan-4.1 {chan command: configure subcommand} -body { - chan blocked + chan configure } -returnCodes error -result "wrong # args: should be \"chan configure channelId ?optionName? ?value? ?optionName value?...\"" test chan-5.1 {chan command: copy subcommand} -body { @@ -43,7 +43,7 @@ test chan-6.1 {chan command: eof subcommand} -body { test chan-7.1 {chan command: event subcommand} -body { chan event foo -} -returnCodes error -result "wrong # args: should be \"chan event channelId mode ?script?\"" +} -returnCodes error -result "wrong # args: should be \"chan event channelId event ?script?\"" test chan-8.1 {chan command: flush subcommand} -body { chan flush foo bar @@ -62,7 +62,7 @@ test chan-11.1 {chan command: puts subcommand} -body { } -returnCodes error -result "wrong # args: should be \"chan puts ?-nonewline? ?channelId? string\"" test chan-12.1 {chan command: read subcommand} -body { - chan read foo bar + chan read } -returnCodes error -result "wrong # args: should be \"chan read channelId ?numChars?\" or \"chan read ?-nonewline? channelId\"" test chan-13.1 {chan command: seek subcommand} -body { |