diff options
| -rw-r--r-- | ChangeLog | 9 | ||||
| -rw-r--r-- | generic/tclIndexObj.c | 24 | ||||
| -rw-r--r-- | generic/tclProc.c | 12 | ||||
| -rw-r--r-- | tests/indexObj.test | 7 |
4 files changed, 47 insertions, 5 deletions
@@ -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 |