summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog6
-rw-r--r--generic/tclProc.c26
-rw-r--r--tests/proc.test7
3 files changed, 34 insertions, 5 deletions
diff --git a/ChangeLog b/ChangeLog
index d50a32f..5dc9c96 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2004-05-02 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclProc.c (TclObjInvokeProc):
+ * tests/proc.test (proc-3.6): fix for bad quoting of multi-word
+ proc names in error messages [Bug 942757]
+
2004-04-30 Donal K. Fellows <donal.k.fellows@man.ac.uk>
* doc/glob.n, doc/incr.n, doc/set.n: More examples.
diff --git a/generic/tclProc.c b/generic/tclProc.c
index e1a4116..d99266e 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.50 2004/03/09 12:59:05 vincentdarley Exp $
+ * RCS: @(#) $Id: tclProc.c,v 1.51 2004/05/02 20:49:56 msofer Exp $
*/
#include "tclInt.h"
@@ -909,7 +909,6 @@ TclObjInterpProc(clientData, interp, objc, objv)
register CompiledLocal *localPtr;
char *procName;
int nameLen, localCt, numArgs, argCt, i, result;
- Tcl_Obj *objResult = Tcl_GetObjResult(interp);
/*
* This procedure generates an array "compiledLocals" that holds the
@@ -1036,13 +1035,32 @@ TclObjInterpProc(clientData, interp, objc, objv)
localPtr = localPtr->nextPtr;
}
if (argCt > 0) {
+ Tcl_Obj *objResult;
+ int len, flags;
+
incorrectArgs:
/*
* Build up equivalent to Tcl_WrongNumArgs message for proc
*/
+
Tcl_ResetResult(interp);
- Tcl_AppendStringsToObj(objResult,
- "wrong # args: should be \"", procName, (char *) NULL);
+ objResult = Tcl_GetObjResult(interp);
+ 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);
+ }
+
localPtr = procPtr->firstLocalPtr;
for (i = 1; i <= numArgs; i++) {
if (localPtr->defValuePtr != NULL) {
diff --git a/tests/proc.test b/tests/proc.test
index 662d56f..ef5f3c4 100644
--- a/tests/proc.test
+++ b/tests/proc.test
@@ -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: proc.test,v 1.13 2004/03/30 16:22:22 msofer Exp $
+# RCS: @(#) $Id: proc.test,v 1.14 2004/05/02 20:49:56 msofer Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -166,6 +166,11 @@ test proc-3.5 {TclObjInterpProc, any old result is reset before appending error
list [catch {p} msg] $msg
} {1 {wrong # args: should be "p x"}}
+test proc-3.6 {TclObjInterpProc, proper quoting of proc name, Bug 942757} {
+ proc {a b c} {x} {info commands 3m}
+ list [catch {{a b c}} msg] $msg
+} {1 {wrong # args: should be "{a b c} x"}}
+
catch {namespace delete {expand}[namespace children :: test_ns_*]}
catch {rename p ""}
catch {rename {} ""}