Tcl Source Code

Artifact [8685001a70]
Login

Artifact 8685001a70360e2f5cda5fec6eb1f41da92b940f:

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);