Attachment "None" to
ticket [402564ffff]
added by
dkf
2000-11-28 18:31:55.
Index: ChangeLog
===================================================================
RCS file: /cvsroot/tcl/tcl/ChangeLog,v
retrieving revision 1.352
diff -r1.352 ChangeLog
0a1,9
> 2000-11-27 Donal K. Fellows <[email protected]>
>
> * generic/tclIOCmd.c (Tcl_PutsObjCmd): Rewritten to have saner and
> faster argument handling. Fixes bug #123552
>
> * generic/tclParse.c (Tcl_EvalEx): Call to EvalObjv was passing in
> the wrong piece of string to trigger traces upon. Fixes Bug
> #119236
>
Index: generic/tclIOCmd.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclIOCmd.c,v
retrieving revision 1.7
diff -r1.7 tclIOCmd.c
66c66
< int i; /* Counter. */
---
> Tcl_Obj *string; /* String to write. */
71,72d70
< char *arg;
< int length;
74,76c72,113
< i = 1;
< newline = 1;
< if ((objc >= 2) && (strcmp(Tcl_GetString(objv[1]), "-nonewline") == 0)) {
---
> switch (objc) {
> case 2: /* puts $x */
> string = objv[1];
> newline = 1;
> channelId = "stdout";
> break;
>
> case 3: /* puts -nonewline $x or puts $chan $x */
> if (strcmp(Tcl_GetString(objv[1]), "-nonewline") == 0) {
> newline = 0;
> channelId = "stdout";
> } else {
> newline = 1;
> channelId = Tcl_GetString(objv[1]);
> }
> string = objv[2];
> break;
>
> case 4: /* puts -nonewline $chan $x or puts $chan $x nonewline */
> if (strcmp(Tcl_GetString(objv[1]), "-nonewline") == 0) {
> channelId = Tcl_GetString(objv[2]);
> string = objv[3];
> } else {
> /*
> * The code below provides backwards compatibility with an
> * old form of the command that is no longer recommended
> * or documented.
> */
>
> char *arg;
> int length;
>
> arg = Tcl_GetStringFromObj(objv[3], &length);
> if (strncmp(arg, "nonewline", (size_t) length) != 0) {
> Tcl_AppendResult(interp, "bad argument \"", arg,
> "\": should be \"nonewline\"",
> (char *) NULL);
> return TCL_ERROR;
> }
> channelId = Tcl_GetString(objv[1]);
> string = objv[2];
> }
78,80c115,117
< i++;
< }
< if ((i < (objc-3)) || (i >= objc)) {
---
> break;
>
> default: /* puts or puts some bad number of arguments... */
85,104d121
< /*
< * The code below provides backwards compatibility with an old
< * form of the command that is no longer recommended or documented.
< */
<
< if (i == (objc-3)) {
< arg = Tcl_GetStringFromObj(objv[i + 2], &length);
< if (strncmp(arg, "nonewline", (size_t) length) != 0) {
< Tcl_AppendResult(interp, "bad argument \"", arg,
< "\": should be \"nonewline\"", (char *) NULL);
< return TCL_ERROR;
< }
< newline = 0;
< }
< if (i == (objc - 1)) {
< channelId = "stdout";
< } else {
< channelId = Tcl_GetString(objv[i]);
< i++;
< }
115c132
< result = Tcl_WriteObj(chan, objv[i]);
---
> result = Tcl_WriteObj(chan, string);
Index: generic/tclParse.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclParse.c,v
retrieving revision 1.14
diff -r1.14 tclParse.c
1393c1393,1394
< code = EvalObjv(interp, objectsUsed, objv, p, bytesLeft, 0);
---
> code = EvalObjv(interp, objectsUsed, objv, parse.commandStart,
> parse.commandSize, 0);