summaryrefslogtreecommitdiffstats
path: root/Lib/lib2to3
Commit message (Expand)AuthorAgeFilesLines
* bpo-45229: Remove test_main in many tests (GH-28405)Serhiy Storchaka2021-09-192-10/+4
* bpo-40360: Deprecate the lib2to3 package (GH-28116)Victor Stinner2021-09-021-1/+1
* make lib2to3 parse async generators everywhere (GH-6588)Zsolt Dollenstein2021-08-102-8/+16
* Update URLs in comments and metadata to use HTTPS (GH-27458)Noah Kantrowitz2021-07-302-2/+2
* Remove unnecessary pass statements (GH-27103)Elisha Hollander2021-07-131-1/+0
* bpo-43844: Fix PendingDeprecationWarning in test_lib2to3 (GH-25407)Victor Stinner2021-04-161-4/+8
* bpo-43651: Fix EncodingWarning in lib2to3/pgen2/pgen.py (GH-25127)Inada Naoki2021-04-011-1/+1
* bpo-36541: Add lib2to3 grammar PEP-570 pos-only arg parsing (GH-23759)Gregory P. Smith2020-12-142-6/+77
* bpo-40360: Deprecate lib2to3 module in light of PEP 617 (GH-19663)Carl Meyer2020-04-241-1/+8
* lib2to3: Support named assignment expressions (GH-12702)Tim Hatch2020-04-025-6/+25
* bpo-38080: Added "getproxies" to urllib fixes in the 2to3 tool (GH-16167)José Roberto Meza Cabrera2020-03-112-1/+5
* bpo-38641: Add lib2to3 support for starred expressions in return/yield statem...Vlad Emelianov2020-03-012-3/+15
* bpo-39313: Add an option to RefactoringTool for using exec as a function (GH-...Batuhan Taşkaya2020-01-123-7/+20
* bpo-38871: Fix lib2to3 for filter-based statements that contain lambda (GH-17...Dong-hee Na2020-01-072-3/+12
* Remove binding of captured exceptions when not used to reduce the chances of ...Pablo Galindo2019-11-191-2/+2
* bpo-33348: parse expressions after * and ** in lib2to3 (GH-6586)Zsolt Dollenstein2019-10-245-11/+12
* Fix typos in comments, docs and test names (#15018)Min ho Kim2019-07-302-2/+2
* closes bpo-37675: Use pkgutil.iter_modules to find fixers in a package rather...Benjamin Peterson2019-07-241-4/+4
* Fix typos in docs and docstrings (GH-13745)Xtreak2019-06-021-1/+1
* bpo-5028: Fix up rest of documentation for tokenize documenting line (GH-13686)Anthony Sottile2019-05-301-1/+1
* bpo-5028: fix doc bug for tokenize (GH-11683)Andrew Carr2019-05-301-1/+1
* bpo-23896: Add a grammar where exec isn't a stmt (#13272)Batuhan Taşkaya2019-05-201-0/+3
* bpo-36766: Typos in docs and code comments (GH-13116)penguindustin2019-05-061-1/+1
* bpo-35312: Make lib2to3.pgen2.parse.ParseError round-trip pickle-able. (GH-10...Anthony Sottile2018-11-272-0/+15
* bpo-35202: Remove unused imports in Lib directory. (GH-10446)Srinivas Thatiparthy (శ్రీనివాస్ తాటిపర్తి)2018-11-102-2/+0
* bpo-16965: 2to3 now rewrites execfile() to open with 'rb'. (GH-8569)Zackery Spytz2018-10-132-9/+10
* closes bpo-34515: Support non-ASCII identifiers in lib2to3. (GH-8950)Monson Shao2018-09-152-6/+15
* Revert "closes bpo-27494: Fix 2to3 handling of trailing comma after a genera...Serhiy Storchaka2018-07-316-36/+10
* bpo-21446: Update reload fixer to use importlib (GH-8391)Berker Peksag2018-07-232-9/+9
* bpo-34108: Fix double carriage return in 2to3 on Windows (#8271)Jason R. Coombs2018-07-132-1/+2
* bpo-31583: Fix 2to3 for using with --add-suffix option (GH-3758)Denis Osipov2018-04-181-1/+1
* bpo-11594: Ensure line-endings are respected when using 2to3 (GH-6483)Aaron Ang2018-04-173-18/+34
* [lib2to3] Make grammar pickling faster (#6491)Łukasz Langa2018-04-171-25/+2
* Add support for all string literals to lib2to3 (#6457)Zsolt Dollenstein2018-04-162-52/+28
* Revert "bpo-30406: Make async and await proper keywords (#1669)" (GH-6143)Jelle Zijlstra2018-03-184-20/+94
* lib2to3: Add more tests (#6101)Łukasz Langa2018-03-131-0/+108
* bpo-33064: lib2to3: support trailing comma after *args and **kwargs (#6096)Łukasz Langa2018-03-132-26/+37
* compare with difflib not diff(1) (GH-5450)Benjamin Peterson2018-01-301-13/+9
* closes bpo-30117: fix lib2to3 ParserIdempotency test (GH-1242)Eric Appelt2018-01-302-10/+15
* remove unused import (#5040)Benjamin Peterson2017-12-291-1/+0
* make PatternCompiler use the packaged grammar if possible (more bpo-24960) (#...Benjamin Peterson2017-12-291-7/+7
* correct wording (#4983)Benjamin Peterson2017-12-231-1/+1
* bpo-24960: use pkgutil.get_data in lib2to3 to read pickled grammar files (#4977)Benjamin Peterson2017-12-224-2/+42
* bpo-32046: Update 2to3 when converts operator.isCallable(obj). (#4417)Dong-hee Na2017-11-282-6/+5
* bpo-30143: 2to3 now generates a code that uses abstract collection classes (#...Serhiy Storchaka2017-11-162-10/+10
* bpo-30406: Make async and await proper keywords (#1669)Jelle Zijlstra2017-10-064-94/+24
* closes bpo-27494: Fix 2to3 handling of trailing comma after a generator expre...Jakub Stasiak2017-10-056-10/+36
* bpo-29783: Replace codecs.open() with io.open() (#599)Victor Stinner2017-06-162-30/+11
* bpo-23894: make lib2to3 recognize f-strings (#1733)Łukasz Langa2017-05-222-1/+7
* Make rb'' strings work in lib2to3 (#1724)Łukasz Langa2017-05-222-7/+37
tion value='mig_opt2'>mig_opt2 Tcl is a high-level, general-purpose, interpreted, dynamic programming language. It was designed with the goal of being very simple but powerful.
summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2004-10-29 15:39:02 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2004-10-29 15:39:02 (GMT)
commitf21fa0e01c0fb463b0ec26f3b0cef1218243908a (patch)
tree0fe2010a58b021f880f03fd319b7dce9e764cd63
parent151836cea1737631c005e07ca9a26e7641ff009d (diff)
downloadtcl-f21fa0e01c0fb463b0ec26f3b0cef1218243908a.zip
tcl-f21fa0e01c0fb463b0ec26f3b0cef1218243908a.tar.gz
tcl-f21fa0e01c0fb463b0ec26f3b0cef1218243908a.tar.bz2
Allow ensembles to rewrite their subcommands' error messages to be more
relevant to users. [Patch 1056864] Also patches to core to take advantage of this Also other general cleaning up of Tcl_WrongNumArgs usage
Diffstat
-rw-r--r--ChangeLog27
-rw-r--r--generic/tclBasic.c15
-rw-r--r--generic/tclClock.c108
-rw-r--r--generic/tclConfig.c8
-rw-r--r--generic/tclIndexObj.c87
-rw-r--r--generic/tclInt.h20
-rw-r--r--generic/tclNamesp.c80
-rw-r--r--generic/tclProc.c52
-rw-r--r--generic/tclVar.c14
-rw-r--r--library/tm.tcl23
-rw-r--r--tests/clock.test4
-rw-r--r--tests/config.test10
-rw-r--r--tests/namespace.test33
-rw-r--r--tests/proc-old.test6
-rw-r--r--tests/tm.test6
15 files changed, 340 insertions, 153 deletions
diff --git a/ChangeLog b/ChangeLog
index 4421e8d..6aa13f2 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,30 @@
+2004-10-29 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * library/tm.tcl (::tcl::tm::*): Use the core proc engine to
+ generate the wrong-num-args error messages for the path ensemble.
+
+ Ensembles can now (sometimes) rewrite the error messages of their
+ subcommands so they appear more like the arguments that the user
+ passed to the ensemble. Below is a description of changes involved
+ in doing this.
+
+ * tests/namespace.test (namespace-50.*): Tests of ensemble
+ subcommand error message rewriting.
+ * generic/tclProc.c (TclObjInterpProc): Make procedures implement
+ their wrong-num-args message using Tcl_WrongNumArgs instead of
+ something baked-at-home.
+ * generic/tclNamesp.c (TclIsEnsemble, NsEnsembleImplementationCmd):
+ Added test of ensemble-hood (available to rest of core) and made
+ ensembles set up the rewriting for Tcl_WrongNumArgs to take
+ advantage of.
+ * generic/tclInt.h (Interp.ensembleRewrite): Extra fields.
+ * generic/tclIndexObj.c (Tcl_WrongNumArgs): Add knowledge of what
+ is going on in ensembles' command rewriting so this command can
+ generate the right error message itself.
+ * generic/tclBasic.c (Tcl_CreateInterp, TclEvalObjvInternal):
+ Added code to initialize (as empty) the rewriting fields and reset
+ them when we leak outside an ensemble implementation.
+
2004-10-28 Miguel Sofer <msofer@users.sf.net>
* generic/tclExecute.c (INST_START_CMD):
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 0102390..2375920 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.133 2004/10/24 22:25:12 dgp Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.134 2004/10/29 15:39:04 dkf Exp $
*/
#include "tclInt.h"
@@ -314,6 +314,14 @@ Tcl_CreateInterp()
iPtr->stubTable = &tclStubs;
/*
+ * Initialize the ensemble error message rewriting support.
+ */
+
+ iPtr->ensembleRewrite.sourceObjs = NULL;
+ iPtr->ensembleRewrite.numRemovedObjs = 0;
+ iPtr->ensembleRewrite.numInsertedObjs = 0;
+
+ /*
* TIP#143: Initialise the resource limit support.
*/
@@ -3031,6 +3039,11 @@ TclEvalObjvInternal(interp, objc, objv, command, length, flags)
if (flags & TCL_EVAL_GLOBAL) {
iPtr->varFramePtr = NULL;
}
+ if (!(flags & TCL_EVAL_INVOKE) &&
+ (iPtr->ensembleRewrite.sourceObjs != NULL) &&
+ !TclIsEnsemble(cmdPtr)) {
+ iPtr->ensembleRewrite.sourceObjs = NULL;
+ }
code = (*cmdPtr->objProc)(cmdPtr->objClientData, interp, objc, objv);
iPtr->varFramePtr = savedVarFramePtr;
}
diff --git a/generic/tclClock.c b/generic/tclClock.c
index 68b7142..ff63767 100644
--- a/generic/tclClock.c
+++ b/generic/tclClock.c
@@ -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: tclClock.c,v 1.35 2004/10/21 03:53:04 kennykb Exp $
+ * RCS: @(#) $Id: tclClock.c,v 1.36 2004/10/29 15:39:05 dkf Exp $
*/
#include "tclInt.h"
@@ -336,7 +336,6 @@ TclClockMktimeObjCmd( ClientData clientData,
}
-
/*----------------------------------------------------------------------
*
* TclClockClicksObjCmd --
@@ -356,7 +355,7 @@ TclClockMktimeObjCmd( ClientData clientData,
*/
int
-TclClockClicksObjCmd( clientData, interp, objc, objv )
+TclClockClicksObjCmd(clientData, interp, objc, objv)
ClientData clientData; /* Client data is unused */
Tcl_Interp* interp; /* Tcl interpreter */
int objc; /* Parameter count */
@@ -371,46 +370,43 @@ TclClockClicksObjCmd( clientData, interp, objc, objv )
int index = CLICKS_NATIVE;
Tcl_Time now;
- switch ( objc ) {
- case 1:
- break;
- case 2:
- if ( Tcl_GetIndexFromObj( interp, objv[1], clicksSwitches,
- "option", 0, &index) != TCL_OK ) {
- return TCL_ERROR;
- }
- break;
- default:
- Tcl_WrongNumArgs( interp, 1, objv, "?option?" );
+ switch (objc) {
+ case 1:
+ break;
+ case 2:
+ if (Tcl_GetIndexFromObj(interp, objv[1], clicksSwitches, "option", 0,
+ &index) != TCL_OK) {
return TCL_ERROR;
+ }
+ break;
+ default:
+ Tcl_WrongNumArgs(interp, 1, objv, "?option?");
+ return TCL_ERROR;
}
- switch ( index ) {
- case CLICKS_MILLIS:
- Tcl_GetTime( &now );
- Tcl_SetObjResult( interp,
- Tcl_NewWideIntObj( (Tcl_WideInt) now.sec * 1000
- + now.usec / 1000 ) );
- break;
- case CLICKS_NATIVE:
+ switch (index) {
+ case CLICKS_MILLIS:
+ Tcl_GetTime(&now);
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj( (Tcl_WideInt)
+ now.sec * 1000 + now.usec / 1000 ) );
+ break;
+ case CLICKS_NATIVE:
#if 0
- /*
- * The following code will be used once this is incorporated
- * into Tcl. But TEA bugs prevent it for right now. :(
- * So we fall through this case and return the microseconds
- * instead.
- */
- Tcl_SetObjResult( interp,
- Tcl_NewWideIntObj( (Tcl_WideInt) TclpGetClicks() ) );
- break;
+ /*
+ * The following code will be used once this is incorporated
+ * into Tcl. But TEA bugs prevent it for right now. :(
+ * So we fall through this case and return the microseconds
+ * instead.
+ */
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj( (Tcl_WideInt)
+ TclpGetClicks()));
+ break;
#endif
- case CLICKS_MICROS:
- Tcl_GetTime( &now );
- Tcl_SetObjResult( interp,
- Tcl_NewWideIntObj( ( (Tcl_WideInt) now.sec
- * 1000000 )
- + now.usec ) );
- break;
+ case CLICKS_MICROS:
+ Tcl_GetTime(&now);
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(
+ ((Tcl_WideInt) now.sec * 1000000) + now.usec));
+ break;
}
return TCL_OK;
@@ -435,21 +431,20 @@ TclClockClicksObjCmd( clientData, interp, objc, objv )
*/
int
-TclClockMillisecondsObjCmd( clientData, interp, objc, objv )
+TclClockMillisecondsObjCmd(clientData, interp, objc, objv)
ClientData clientData; /* Client data is unused */
Tcl_Interp* interp; /* Tcl interpreter */
int objc; /* Parameter count */
Tcl_Obj* CONST* objv; /* Parameter values */
{
Tcl_Time now;
- if ( objc != 1 ) {
- Tcl_WrongNumArgs( interp, 1, objv, "" );
+ if (objc != 1) {
+ Tcl_WrongNumArgs(interp, 1, objv, NULL);
return TCL_ERROR;
}
- Tcl_GetTime( &now );
- Tcl_SetObjResult( interp,
- Tcl_NewWideIntObj( (Tcl_WideInt) now.sec * 1000
- + now.usec / 1000 ) );
+ Tcl_GetTime(&now);
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj( (Tcl_WideInt)
+ now.sec * 1000 + now.usec / 1000));
return TCL_OK;
}
@@ -472,21 +467,20 @@ TclClockMillisecondsObjCmd( clientData, interp, objc, objv )
*/
int
-TclClockMicrosecondsObjCmd( clientData, interp, objc, objv )
+TclClockMicrosecondsObjCmd(clientData, interp, objc, objv)
ClientData clientData; /* Client data is unused */
Tcl_Interp* interp; /* Tcl interpreter */
int objc; /* Parameter count */
Tcl_Obj* CONST* objv; /* Parameter values */
{
Tcl_Time now;
- if ( objc != 1 ) {
- Tcl_WrongNumArgs( interp, 1, objv, "" );
+ if (objc != 1) {
+ Tcl_WrongNumArgs(interp, 1, objv, NULL);
return TCL_ERROR;
}
- Tcl_GetTime( &now );
- Tcl_SetObjResult( interp,
- Tcl_NewWideIntObj( ( (Tcl_WideInt) now.sec * 1000000 )
- + now.usec ) );
+ Tcl_GetTime(&now);
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(
+ ((Tcl_WideInt) now.sec * 1000000) + now.usec));
return TCL_OK;
}
@@ -509,19 +503,19 @@ TclClockMicrosecondsObjCmd( clientData, interp, objc, objv )
*/
int
-TclClockSecondsObjCmd( clientData, interp, objc, objv )
+TclClockSecondsObjCmd(clientData, interp, objc, objv)
ClientData clientData; /* Client data is unused */
Tcl_Interp* interp; /* Tcl interpreter */
int objc; /* Parameter count */
Tcl_Obj* CONST* objv; /* Parameter values */
{
Tcl_Time now;
- if ( objc != 1 ) {
- Tcl_WrongNumArgs( interp, 1, objv, "" );
+ if (objc != 1) {
+ Tcl_WrongNumArgs(interp, 1, objv, NULL);
return TCL_ERROR;
}
- Tcl_GetTime( &now );
- Tcl_SetObjResult( interp, Tcl_NewWideIntObj( (Tcl_WideInt) now.sec ) );
+ Tcl_GetTime(&now);
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt) now.sec));
return TCL_OK;
}
diff --git a/generic/tclConfig.c b/generic/tclConfig.c
index 3cd5813..4daf92f 100644
--- a/generic/tclConfig.c
+++ b/generic/tclConfig.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: tclConfig.c,v 1.5 2003/12/24 04:18:19 davygrvy Exp $
+ * RCS: @(#) $Id: tclConfig.c,v 1.6 2004/10/29 15:39:05 dkf Exp $
*/
#include "tclInt.h"
@@ -209,7 +209,7 @@ QueryConfigObjCmd(clientData, interp, objc, objv)
};
if ((objc < 2) || (objc > 3)) {
- Tcl_WrongNumArgs (interp, 0, NULL, "list | get key");
+ Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?argument?");
return TCL_ERROR;
}
if (Tcl_GetIndexFromObj(interp, objv[1], subcmdStrings,
@@ -228,7 +228,7 @@ QueryConfigObjCmd(clientData, interp, objc, objv)
switch ((enum subcmds) index) {
case CFG_GET:
if (objc != 3) {
- Tcl_WrongNumArgs(interp, 0, NULL, "get key");
+ Tcl_WrongNumArgs(interp, 1, objv, "get key");
return TCL_ERROR;
}
@@ -243,7 +243,7 @@ QueryConfigObjCmd(clientData, interp, objc, objv)
case CFG_LIST:
if (objc != 2) {
- Tcl_WrongNumArgs(interp, 0, NULL, "list");
+ Tcl_WrongNumArgs(interp, 1, objv, "list");
return TCL_ERROR;
}
diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c
index 22397af..cd4dc44 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.20 2004/10/06 14:59:02 dgp Exp $
+ * RCS: @(#) $Id: tclIndexObj.c,v 1.21 2004/10/29 15:39:05 dkf Exp $
*/
#include "tclInt.h"
@@ -445,12 +445,69 @@ Tcl_WrongNumArgs(interp, objc, objv, message)
* message may be NULL. */
{
Tcl_Obj *objPtr;
- int i;
+ int i, len, elemLen, flags;
register IndexRep *indexRep;
+ Interp *iPtr = (Interp *) interp;
+ char *elementStr;
TclNewObj(objPtr);
- Tcl_SetObjResult(interp, objPtr);
Tcl_AppendToObj(objPtr, "wrong # args: should be \"", -1);
+
+ /*
+ * Check to see if we are processing an ensemble implementation,
+ * and if so rewrite the results in terms of how the ensemble was
+ * invoked.
+ */
+
+ if (iPtr->ensembleRewrite.sourceObjs != NULL) {
+ /*
+ * We only know how to do rewriting if all the replaced
+ * objects are actually arguments (in objv) to this function.
+ * Otherwise it just gets too complicated...
+ */
+
+ if (objc >= iPtr->ensembleRewrite.numInsertedObjs) {
+ objv += iPtr->ensembleRewrite.numInsertedObjs;
+ objc -= iPtr->ensembleRewrite.numInsertedObjs;
+ /*
+ * We assume no object is of index type.
+ */
+ for (i=0 ; i<iPtr->ensembleRewrite.numRemovedObjs ; i++) {
+ /*
+ * Add the element, quoting it if necessary.
+ */
+
+ elementStr = Tcl_GetStringFromObj(
+ iPtr->ensembleRewrite.sourceObjs[i], &elemLen);
+ len = Tcl_ScanCountedElement(elementStr, elemLen, &flags);
+ if (len != elemLen) {
+ char *quotedElementStr = ckalloc((unsigned) len);
+ len = Tcl_ConvertCountedElement(elementStr, elemLen,
+ quotedElementStr, flags);
+ Tcl_AppendToObj(objPtr, quotedElementStr, len);
+ ckfree(quotedElementStr);
+ } else {
+ Tcl_AppendToObj(objPtr, elementStr, elemLen);
+ }
+
+ /*
+ * Add a space if the word is not the last one (which
+ * has a moderately complex condition here).
+ */
+
+ if ((i < (iPtr->ensembleRewrite.numRemovedObjs - 1))
+ || objc || message) {
+ Tcl_AppendStringsToObj(objPtr, " ", (char *) NULL);
+ }
+ }
+ }
+ }
+
+ /*
+ * Now add the arguments (other than those rewritten) that the
+ * caller took from its calling context.
+ */
+
for (i = 0; i < objc; i++) {
/*
* If the object is an index type use the index table which allows
@@ -462,8 +519,21 @@ Tcl_WrongNumArgs(interp, objc, objv, message)
indexRep = (IndexRep *) objv[i]->internalRep.otherValuePtr;
Tcl_AppendStringsToObj(objPtr, EXPAND_OF(indexRep), (char *) NULL);
} else {
- Tcl_AppendStringsToObj(objPtr, Tcl_GetString(objv[i]),
- (char *) NULL);
+ /*
+ * Quote the argument if it contains spaces (Bug 942757).
+ */
+
+ elementStr = Tcl_GetStringFromObj(objv[i], &elemLen);
+ len = Tcl_ScanCountedElement(elementStr, elemLen, &flags);
+ if (len != elemLen) {
+ char *quotedElementStr = ckalloc((unsigned) len);
+ len = Tcl_ConvertCountedElement(elementStr, elemLen,
+ quotedElementStr, flags);
+ Tcl_AppendToObj(objPtr, quotedElementStr, len);
+ ckfree(quotedElementStr);
+ } else {
+ Tcl_AppendToObj(objPtr, elementStr, elemLen);
+ }
}
/*
@@ -475,8 +545,15 @@ Tcl_WrongNumArgs(interp, objc, objv, message)
}
}
+ /*
+ * Add any trailing message bits and set the resulting string as
+ * the interpreter result. Caller is responsible for reporting
+ * this as an actual error.
+ */
+
if (message) {
Tcl_AppendStringsToObj(objPtr, message, (char *) NULL);
}
Tcl_AppendStringsToObj(objPtr, "\"", (char *) NULL);
+ Tcl_SetObjResult(interp, objPtr);
}
diff --git a/generic/tclInt.h b/generic/tclInt.h
index ca5727c..c4182db 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.189 2004/10/27 17:13:58 davygrvy Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.190 2004/10/29 15:39:05 dkf Exp $
*/
#ifndef _TCLINT
@@ -1400,6 +1400,23 @@ typedef struct Interp {
} limit;
/*
+ * Information for improved default error generation from
+ * ensembles (TIP#112).
+ */
+
+ struct {
+ Tcl_Obj * CONST *sourceObjs;
+ /* What arguments were actually input into
+ * the *root* ensemble command? (Nested
+ * ensembles don't rewrite this.) NULL if
+ * we're not processing an ensemble. */
+ int numRemovedObjs; /* How many arguments have been stripped off
+ * because of ensemble processing. */
+ int numInsertedObjs; /* How many of the current arguments were
+ * inserted by an ensemble. */
+ } ensembleRewrite;
+
+ /*
* Statistical information about the bytecode compiler and interpreter's
* operation.
*/
@@ -1949,6 +1966,7 @@ EXTERN int TclpDlopen _ANSI_ARGS_((Tcl_Interp *interp,
Tcl_FSUnloadFileProc **unloadProcPtr));
EXTERN int TclpUtime _ANSI_ARGS_((Tcl_Obj *pathPtr,
struct utimbuf *tval));
+EXTERN int TclIsEnsemble _ANSI_ARGS_((Command *cmdPtr));
/*
*----------------------------------------------------------------
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index 38c5dd7..34faf71 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -21,7 +21,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclNamesp.c,v 1.63 2004/10/22 15:46:37 dkf Exp $
+ * RCS: @(#) $Id: tclNamesp.c,v 1.64 2004/10/29 15:39:06 dkf Exp $
*/
#include "tclInt.h"
@@ -3367,8 +3367,7 @@ NamespaceExportCmd(dummy, interp, objc, objv)
int firstArg, patternCt, i, result;
if (objc < 2) {
- Tcl_WrongNumArgs(interp, 2, objv,
- "?-clear? ?pattern pattern...?");
+ Tcl_WrongNumArgs(interp, 2, objv, "?-clear? ?pattern pattern...?");
return TCL_ERROR;
}
@@ -3526,8 +3525,7 @@ NamespaceImportCmd(dummy, interp, objc, objv)
int firstArg;
if (objc < 2) {
- Tcl_WrongNumArgs(interp, 2, objv,
- "?-force? ?pattern pattern...?");
+ Tcl_WrongNumArgs(interp, 2, objv, "?-force? ?pattern pattern...?");
return TCL_ERROR;
}
@@ -4863,6 +4861,37 @@ FindEnsemble(interp, cmdNameObj, flags)
/*
*----------------------------------------------------------------------
*
+ * TclIsEnsemble --
+ *
+ * Simple test for ensemble-hood that takes into account imported
+ * ensemble commands as well.
+ *
+ * Results:
+ * Boolean value
+ *
+ * Side effects:
+ * None
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclIsEnsemble(cmdPtr)
+ Command *cmdPtr;
+{
+ if (cmdPtr->objProc == NsEnsembleImplementationCmd) {
+ return 1;
+ }
+ cmdPtr = (Command *) TclGetOriginalCommand((Tcl_Command) cmdPtr);
+ if (cmdPtr == NULL || cmdPtr->objProc != NsEnsembleImplementationCmd) {
+ return 0;
+ }
+ return 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* NsEnsembleImplementationCmd --
*
* Implements an ensemble of commands (being those exported by a
@@ -5045,15 +5074,38 @@ NsEnsembleImplementationCmd(clientData, interp, objc, objv)
Tcl_IncrRefCount(prefixObj);
runResultingSubcommand:
- Tcl_ListObjGetElements(NULL, prefixObj, &prefixObjc, &prefixObjv);
- tempObjv = (Tcl_Obj **) ckalloc(sizeof(Tcl_Obj *)*(objc-2+prefixObjc));
- memcpy(tempObjv, prefixObjv, sizeof(Tcl_Obj *) * prefixObjc);
- memcpy(tempObjv+prefixObjc, objv+2, sizeof(Tcl_Obj *) * (objc-2));
- result = Tcl_EvalObjv(interp, objc-2+prefixObjc, tempObjv,
- TCL_EVAL_INVOKE);
- Tcl_DecrRefCount(prefixObj);
- ckfree((char *)tempObjv);
- return result;
+ {
+ Interp *iPtr = (Interp *) interp;
+ int isRootEnsemble = (iPtr->ensembleRewrite.sourceObjs == NULL);
+
+ Tcl_ListObjGetElements(NULL, prefixObj, &prefixObjc, &prefixObjv);
+ if (isRootEnsemble) {
+ iPtr->ensembleRewrite.sourceObjs = objv;
+ iPtr->ensembleRewrite.numRemovedObjs = 2;
+ iPtr->ensembleRewrite.numInsertedObjs = prefixObjc;
+ } else {
+ int ni = iPtr->ensembleRewrite.numInsertedObjs;
+ if (ni < 2) {
+ iPtr->ensembleRewrite.numRemovedObjs += 2 - ni;
+ iPtr->ensembleRewrite.numInsertedObjs += prefixObjc - 1;
+ } else {
+ iPtr->ensembleRewrite.numInsertedObjs += prefixObjc - 2;
+ }
+ }
+ tempObjv = (Tcl_Obj **) ckalloc(sizeof(Tcl_Obj *)*(objc-2+prefixObjc));
+ memcpy(tempObjv, prefixObjv, sizeof(Tcl_Obj *) * prefixObjc);
+ memcpy(tempObjv+prefixObjc, objv+2, sizeof(Tcl_Obj *) * (objc-2));
+ result = Tcl_EvalObjv(interp, objc-2+prefixObjc, tempObjv,
+ TCL_EVAL_INVOKE);
+ Tcl_DecrRefCount(prefixObj);
+ ckfree((char *)tempObjv);
+ if (isRootEnsemble) {
+ iPtr->ensembleRewrite.sourceObjs = NULL;
+ iPtr->ensembleRewrite.numRemovedObjs = 0;
+ iPtr->ensembleRewrite.numInsertedObjs = 0;
+ }
+ return result;
+ }
unknownOrAmbiguousSubcommand:
/*
diff --git a/generic/tclProc.c b/generic/tclProc.c
index d35ba32..adca38d 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.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: tclProc.c,v 1.63 2004/10/22 13:48:58 dkf Exp $
+ * RCS: @(#) $Id: tclProc.c,v 1.64 2004/10/29 15:39:06 dkf Exp $
*/
#include "tclInt.h"
@@ -1043,47 +1043,39 @@ TclObjInterpProc(clientData, interp, objc, objv)
localPtr = localPtr->nextPtr;
}
if (argCt > 0) {
- Tcl_Obj *objResult;
- int len, flags;
+ Tcl_Obj **desiredObjs, *argObj;
- incorrectArgs:
+ incorrectArgs:
/*
- * Build up equivalent to Tcl_WrongNumArgs message for proc
+ * Build up desired argument list for Tcl_WrongNumArgs
*/
- Tcl_ResetResult(interp);
- TclNewObj(objResult);
- Tcl_AppendToObj(objResult, "wrong # args: should be \"", -1);
-
- /*
- * Quote the proc name if it contains spaces (Bug 942757).
- */
-
- len = Tcl_ScanCountedElement(procName, nameLen, &flags);
- if (len != nameLen) {
- char *procName1 = ckalloc((unsigned) len);
- len = Tcl_ConvertCountedElement(procName, nameLen, procName1, flags);
- Tcl_AppendToObj(objResult, procName1, len);
- ckfree(procName1);
- } else {
- Tcl_AppendToObj(objResult, procName, len);
- }
-
+ desiredObjs = (Tcl_Obj **)
+ ckalloc(sizeof(Tcl_Obj *) * (unsigned)(numArgs+1));
+ desiredObjs[0] = objv[0];
localPtr = procPtr->firstLocalPtr;
- for (i = 1; i <= numArgs; i++) {
+ for (i=1 ; i<=numArgs ; i++) {
+ TclNewObj(argObj);
if (localPtr->defValuePtr != NULL) {
- Tcl_AppendStringsToObj(objResult,
- " ?", localPtr->name, "?", (char *) NULL);
+ Tcl_AppendStringsToObj(argObj,
+ "?", localPtr->name, "?", (char *) NULL);
+ } else if ((i==numArgs) && (strcmp(localPtr->name, "args")==0)) {
+ Tcl_AppendStringsToObj(argObj, "...", (char *) NULL);
} else {
- Tcl_AppendStringsToObj(objResult,
- " ", localPtr->name, (char *) NULL);
+ Tcl_AppendStringsToObj(argObj, localPtr->name, (char *) NULL);
}
+ desiredObjs[i] = argObj;
localPtr = localPtr->nextPtr;
}
- Tcl_AppendStringsToObj(objResult, "\"", (char *) NULL);
- Tcl_SetObjResult(interp, objResult);
+ Tcl_ResetResult(interp);
+ Tcl_WrongNumArgs(interp, numArgs+1, desiredObjs, NULL);
result = TCL_ERROR;
+
+ for (i=1 ; i<=numArgs ; i++) {
+ TclDecrRefCount(desiredObjs[i]);
+ }
+ ckfree((char *) desiredObjs);
goto procDone;
}
diff --git a/generic/tclVar.c b/generic/tclVar.c
index 7dc0bfe..6162fc3 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -15,7 +15,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclVar.c,v 1.97 2004/10/26 16:19:58 msofer Exp $
+ * RCS: @(#) $Id: tclVar.c,v 1.98 2004/10/29 15:39:06 dkf Exp $
*/
#ifdef STDC_HEADERS
@@ -2729,8 +2729,7 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv)
ArraySearch *searchPtr;
if (objc != 4) {
- Tcl_WrongNumArgs(interp, 2, objv,
- "arrayName searchId");
+ Tcl_WrongNumArgs(interp, 2, objv, "arrayName searchId");
return TCL_ERROR;
}
if (notArray) {
@@ -2762,8 +2761,7 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv)
ArraySearch *searchPtr, *prevPtr;
if (objc != 4) {
- Tcl_WrongNumArgs(interp, 2, objv,
- "arrayName searchId");
+ Tcl_WrongNumArgs(interp, 2, objv, "arrayName searchId");
return TCL_ERROR;
}
if (notArray) {
@@ -2914,8 +2912,7 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv)
mode = OPT_GLOB;
if ((objc < 3) || (objc > 5)) {
- Tcl_WrongNumArgs(interp, 2, objv,
- "arrayName ?mode? ?pattern?");
+ Tcl_WrongNumArgs(interp, 2,objv, "arrayName ?mode? ?pattern?");
return TCL_ERROR;
}
if (notArray) {
@@ -2975,8 +2972,7 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv)
Tcl_HashEntry *hPtr;
if (objc != 4) {
- Tcl_WrongNumArgs(interp, 2, objv,
- "arrayName searchId");
+ Tcl_WrongNumArgs(interp, 2, objv, "arrayName searchId");
return TCL_ERROR;
}
if (notArray) {
diff --git a/library/tm.tcl b/library/tm.tcl
index 491d25d..14dab45 100644
--- a/library/tm.tcl
+++ b/library/tm.tcl
@@ -79,7 +79,7 @@ namespace eval ::tcl::tm {
# paths to search for Tcl Modules. The subcommand 'list' has no
# sideeffects.
-proc ::tcl::tm::add {args} {
+proc ::tcl::tm::add {path args} {
# PART OF THE ::tcl::tm::path ENSEMBLE
#
# The path is added at the head to the list of module paths.
@@ -91,11 +91,6 @@ proc ::tcl::tm::add {args} {
# If the path is already present as is no error will be raised and
# no action will be taken.
- if {[llength $args] == 0} {
- return -code error \
- "wrong # args: should be \"::tcl::tm::path add path ?path ...?\""
- }
-
variable paths
# We use a copy of the path as source during validation, and
@@ -107,7 +102,7 @@ proc ::tcl::tm::add {args} {
# paths to the official state var.
set newpaths $paths
- foreach p $args {
+ foreach p [linsert $args 0 $path] {
if {$p in $newpaths} {
# Ignore a path already on the list.
continue
@@ -148,20 +143,15 @@ proc ::tcl::tm::add {args} {
return
}
-proc ::tcl::tm::remove {args} {
+proc ::tcl::tm::remove {path args} {
# PART OF THE ::tcl::tm::path ENSEMBLE
#
# Removes the path from the list of module paths. The command is
# silently ignored if the path is not on the list.
- if {[llength $args] == 0} {
- return -code error \
- "wrong # args: should be \"::tcl::tm::path remove path ?path ...?\""
- }
-
variable paths
- foreach p $args {
+ foreach p [linsert $args 0 $path] {
set pos [lsearch -exact $paths $p]
if {$pos >= 0} {
set paths [lreplace $paths $pos $pos]
@@ -169,12 +159,9 @@ proc ::tcl::tm::remove {args} {
}
}
-proc ::tcl::tm::list {args} {
+proc ::tcl::tm::list {} {
# PART OF THE ::tcl::tm::path ENSEMBLE
- if {[llength $args] != 0} {
- return -code error "wrong # args: should be \"::tcl::tm::path list\""
- }
variable paths
return $paths
}
diff --git a/tests/clock.test b/tests/clock.test
index 746e26a..20fec79 100644
--- a/tests/clock.test
+++ b/tests/clock.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: clock.test,v 1.49 2004/10/28 00:04:33 dgp Exp $
+# RCS: @(#) $Id: clock.test,v 1.50 2004/10/29 15:39:07 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -35223,7 +35223,7 @@ test clock-35.1 {clock seconds tests} {
} {}
test clock-35.2 {clock seconds tests} {
list [catch {clock seconds foo} msg] $msg
-} {1 {wrong # args: should be "::tcl::clock::seconds "}}
+} {1 {wrong # args: should be "clock seconds"}}
test clock-35.3 {clock seconds tests} {
set start [clock seconds]
after 2000
diff --git a/tests/config.test b/tests/config.test
index 8c05a7e..2023d9c 100644
--- a/tests/config.test
+++ b/tests/config.test
@@ -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: config.test,v 1.3 2004/05/19 12:22:13 dkf Exp $
+# RCS: @(#) $Id: config.test,v 1.4 2004/10/29 15:39:10 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -35,7 +35,7 @@ test pkgconfig-1.3 {query value multiple times} {
test pkgconfig-2.0 {error: missing subcommand} {
catch {::tcl::pkgconfig} msg
set msg
-} {wrong # args: should be "list | get key"}
+} {wrong # args: should be "::tcl::pkgconfig subcommand ?argument?"}
test pkgconfig-2.1 {error: illegal subcommand} {
catch {::tcl::pkgconfig foo} msg
set msg
@@ -43,11 +43,11 @@ test pkgconfig-2.1 {error: illegal subcommand} {
test pkgconfig-2.2 {error: list with arguments} {
catch {::tcl::pkgconfig list foo} msg
set msg
-} {wrong # args: should be "list"}
+} {wrong # args: should be "::tcl::pkgconfig list"}
test pkgconfig-2.3 {error: get without arguments} {
catch {::tcl::pkgconfig get} msg
set msg
-} {wrong # args: should be "get key"}
+} {wrong # args: should be "::tcl::pkgconfig get key"}
test pkgconfig-2.4 {error: query unknown key} {
catch {::tcl::pkgconfig get foo} msg
set msg
@@ -55,7 +55,7 @@ test pkgconfig-2.4 {error: query unknown key} {
test pkgconfig-2.5 {error: query with to many arguments} {
catch {::tcl::pkgconfig get foo bar} msg
set msg
-} {wrong # args: should be "list | get key"}
+} {wrong # args: should be "::tcl::pkgconfig subcommand ?argument?"}
# cleanup
::tcltest::cleanupTests
diff --git a/tests/namespace.test b/tests/namespace.test