summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2005-06-07 10:04:46 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2005-06-07 10:04:46 (GMT)
commit665306595a3bc3b92d851d4df40e62875e0442e4 (patch)
treedb151d401631884701b22d31740507e5839dbd14
parentf10e294a14970b83477f6e6d09c48218469aa0a9 (diff)
downloadtcl-665306595a3bc3b92d851d4df40e62875e0442e4.zip
tcl-665306595a3bc3b92d851d4df40e62875e0442e4.tar.gz
tcl-665306595a3bc3b92d851d4df40e62875e0442e4.tar.bz2
Clean up tests in chan.test and add mechanism for chaining Tcl_WrongNumArgs
messages (used in [read] implementation)
-rw-r--r--ChangeLog6
-rw-r--r--generic/tclIOCmd.c16
-rw-r--r--generic/tclIndexObj.c9
-rw-r--r--generic/tclInt.h7
-rw-r--r--tests/chan.test12
5 files changed, 37 insertions, 13 deletions
diff --git a/ChangeLog b/ChangeLog
index ce34267..05d318d 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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 {