summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2004-11-25 16:37:08 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2004-11-25 16:37:08 (GMT)
commit6ee1f25ba7a09bad8a410b44ff14dc80cfeb7bf1 (patch)
treeb31529be3473f6a2a50e3360557021e1ce66cdd0
parent16786015d10aff3dce40b31e1cd011edb3ee6bf6 (diff)
downloadtcl-6ee1f25ba7a09bad8a410b44ff14dc80cfeb7bf1.zip
tcl-6ee1f25ba7a09bad8a410b44ff14dc80cfeb7bf1.tar.gz
tcl-6ee1f25ba7a09bad8a410b44ff14dc80cfeb7bf1.tar.bz2
Fix [Bug 1066837] without reopening other bugs... What a horrid hack! :^/
-rw-r--r--ChangeLog9
-rw-r--r--generic/tclIndexObj.c24
-rw-r--r--generic/tclProc.c12
-rw-r--r--tests/indexObj.test7
4 files changed, 47 insertions, 5 deletions
diff --git a/ChangeLog b/ChangeLog
index 6a44435..104a0ad 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,12 @@
+2004-11-25 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * generic/tclProc.c (TclObjInterpProc): Make it so that only
+ * generic/tclIndexObj.c (Tcl_WrongNumArgs): [proc] instances do
+ * tests/indexObj.test (indexObj-5.7): quoting of their first
+ arguments, so keeping [Bug 942757] fixed and making [Bug 1066837]
+ be fixed as well. Done with a load of #ifdef-ery because this hack
+ is so ugly nobody should keep it around once Itcl's fixed.
+
2004-11-25 Reinhard Max <max@suse.de>
* tests/tcltest.test: The order in which [glob] returns the file
diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c
index cd4dc44..478e3a9 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.21 2004/10/29 15:39:05 dkf Exp $
+ * RCS: @(#) $Id: tclIndexObj.c,v 1.22 2004/11/25 16:37:15 dkf Exp $
*/
#include "tclInt.h"
@@ -449,6 +449,17 @@ Tcl_WrongNumArgs(interp, objc, objv, message)
register IndexRep *indexRep;
Interp *iPtr = (Interp *) interp;
char *elementStr;
+#ifndef AVOID_HACKS_FOR_ITCL
+ int isFirst = 1; /* Special flag used to inhibit the
+ * treating of the first word as a
+ * list element so the hacky way Itcl
+ * does error message generation for
+ * ensembles will still work.
+ * [Bug 1066837] */
+#define MAY_QUOTE_WORD (!isFirst)
+#else /* !AVOID_HACKS_FOR_ITCL */
+#define MAY_QUOTE_WORD 1
+#endif /* AVOID_HACKS_FOR_ITCL */
TclNewObj(objPtr);
Tcl_AppendToObj(objPtr, "wrong # args: should be \"", -1);
@@ -480,7 +491,7 @@ Tcl_WrongNumArgs(interp, objc, objv, message)
elementStr = Tcl_GetStringFromObj(
iPtr->ensembleRewrite.sourceObjs[i], &elemLen);
len = Tcl_ScanCountedElement(elementStr, elemLen, &flags);
- if (len != elemLen) {
+ if (MAY_QUOTE_WORD && len != elemLen) {
char *quotedElementStr = ckalloc((unsigned) len);
len = Tcl_ConvertCountedElement(elementStr, elemLen,
quotedElementStr, flags);
@@ -489,6 +500,9 @@ Tcl_WrongNumArgs(interp, objc, objv, message)
} else {
Tcl_AppendToObj(objPtr, elementStr, elemLen);
}
+#ifndef AVOID_HACKS_FOR_ITCL
+ isFirst = 0;
+#endif /* AVOID_HACKS_FOR_ITCL */
/*
* Add a space if the word is not the last one (which
@@ -525,7 +539,7 @@ Tcl_WrongNumArgs(interp, objc, objv, message)
elementStr = Tcl_GetStringFromObj(objv[i], &elemLen);
len = Tcl_ScanCountedElement(elementStr, elemLen, &flags);
- if (len != elemLen) {
+ if (MAY_QUOTE_WORD && len != elemLen) {
char *quotedElementStr = ckalloc((unsigned) len);
len = Tcl_ConvertCountedElement(elementStr, elemLen,
quotedElementStr, flags);
@@ -535,6 +549,9 @@ Tcl_WrongNumArgs(interp, objc, objv, message)
Tcl_AppendToObj(objPtr, elementStr, elemLen);
}
}
+#ifndef AVOID_HACKS_FOR_ITCL
+ isFirst = 0;
+#endif /* AVOID_HACKS_FOR_ITCL */
/*
* Append a space character (" ") if there is more text to follow
@@ -556,4 +573,5 @@ Tcl_WrongNumArgs(interp, objc, objv, message)
}
Tcl_AppendStringsToObj(objPtr, "\"", (char *) NULL);
Tcl_SetObjResult(interp, objPtr);
+#undef MAY_QUOTE_WORD
}
diff --git a/generic/tclProc.c b/generic/tclProc.c
index df1f110..6d46f81 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.65 2004/11/01 11:58:00 dkf Exp $
+ * RCS: @(#) $Id: tclProc.c,v 1.66 2004/11/25 16:37:15 dkf Exp $
*/
#include "tclInt.h"
@@ -1046,7 +1046,11 @@ TclObjInterpProc(clientData, interp, objc, objv)
desiredObjs = (Tcl_Obj **)
ckalloc(sizeof(Tcl_Obj *) * (unsigned)(numArgs+1));
+#ifdef AVOID_HACKS_FOR_ITCL
desiredObjs[0] = objv[0];
+#else
+ desiredObjs[0] = Tcl_NewListObj(1, objv);
+#endif /* AVOID_HACKS_FOR_ITCL */
localPtr = procPtr->firstLocalPtr;
for (i=1 ; i<=numArgs ; i++) {
TclNewObj(argObj);
@@ -1066,9 +1070,15 @@ TclObjInterpProc(clientData, interp, objc, objv)
Tcl_WrongNumArgs(interp, numArgs+1, desiredObjs, NULL);
result = TCL_ERROR;
+#ifdef AVOID_HACKS_FOR_ITCL
for (i=1 ; i<=numArgs ; i++) {
TclDecrRefCount(desiredObjs[i]);
}
+#else
+ for (i=0 ; i<=numArgs ; i++) {
+ TclDecrRefCount(desiredObjs[i]);
+ }
+#endif /* AVOID_HACKS_FOR_ITCL */
ckfree((char *) desiredObjs);
goto procDone;
}
diff --git a/tests/indexObj.test b/tests/indexObj.test
index 70740f7..7fea854 100644
--- a/tests/indexObj.test
+++ b/tests/indexObj.test
@@ -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: indexObj.test,v 1.8 2004/05/19 12:17:31 dkf Exp $
+# RCS: @(#) $Id: indexObj.test,v 1.9 2004/11/25 16:37:15 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -83,6 +83,11 @@ test indexObj-5.5 {Tcl_WrongNumArgs} testindexobj {
test indexObj-5.6 {Tcl_WrongNumArgs} testindexobj {
testwrongnumargs 2 "" mycmd foo
} "wrong # args: should be \"mycmd foo\""
+# Contrast this with test proc-3.6; they have to be like this because
+# of [Bug 1066837] so Itcl won't break.
+test indexObj-5.7 {Tcl_WrongNumArgs} testindexobj {
+ testwrongnumargs 2 "fee fi" "fo fum" foo bar
+} "wrong # args: should be \"fo fum foo fee fi\""
test indexObj-6.1 {Tcl_GetIndexFromObjStruct} testindexobj {
set x a