summaryrefslogtreecommitdiffstats
path: root/generic/tclIOCmd.c
diff options
context:
space:
mode:
authorandreas_kupries <akupries@shaw.ca>2001-09-19 00:50:23 (GMT)
committerandreas_kupries <akupries@shaw.ca>2001-09-19 00:50:23 (GMT)
commitb53d7f844a52e25261a68ee3e64737a00f818f27 (patch)
tree2de597cf010a500f1c37981cb3ede7f40816ec20 /generic/tclIOCmd.c
parent36111fee5e882a66dd488fd909783e00076ed9f5 (diff)
downloadtcl-b53d7f844a52e25261a68ee3e64737a00f818f27.zip
tcl-b53d7f844a52e25261a68ee3e64737a00f818f27.tar.gz
tcl-b53d7f844a52e25261a68ee3e64737a00f818f27.tar.bz2
* generic/tclIOCmd.c (Tcl_PutsObjCmd): Rewritten to have saner and
faster argument handling. Fixes bug #123552. Patch provided by Donal K. Fellows <fellowsd@cs.man.ac.uk>: #402564.
Diffstat (limited to 'generic/tclIOCmd.c')
-rw-r--r--generic/tclIOCmd.c79
1 files changed, 48 insertions, 31 deletions
diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c
index 5fb3a15..a74b3b9 100644
--- a/generic/tclIOCmd.c
+++ b/generic/tclIOCmd.c
@@ -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: tclIOCmd.c,v 1.9 2001/08/06 22:17:58 andreas_kupries Exp $
+ * RCS: @(#) $Id: tclIOCmd.c,v 1.10 2001/09/19 00:50:23 andreas_kupries Exp $
*/
#include "tclInt.h"
@@ -63,45 +63,62 @@ Tcl_PutsObjCmd(dummy, interp, objc, objv)
Tcl_Obj *CONST objv[]; /* Argument objects. */
{
Tcl_Channel chan; /* The channel to puts on. */
- int i; /* Counter. */
+ Tcl_Obj *string; /* String to write. */
int newline; /* Add a newline at end? */
char *channelId; /* Name of channel for puts. */
int result; /* Result of puts operation. */
int mode; /* Mode in which channel is opened. */
- char *arg;
- int length;
- i = 1;
- newline = 1;
- if ((objc >= 2) && (strcmp(Tcl_GetString(objv[1]), "-nonewline") == 0)) {
- newline = 0;
- i++;
- }
- if ((i < (objc-3)) || (i >= objc)) {
- Tcl_WrongNumArgs(interp, 1, objv, "?-nonewline? ?channelId? string");
- return TCL_ERROR;
- }
+ switch (objc) {
+ case 2: /* puts $x */
+ string = objv[1];
+ newline = 1;
+ channelId = "stdout";
+ break;
- /*
- * The code below provides backwards compatibility with an old
- * form of the command that is no longer recommended or documented.
- */
+ 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;
- 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;
+ 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];
}
newline = 0;
+ break;
+
+ default: /* puts or puts some bad number of arguments... */
+ Tcl_WrongNumArgs(interp, 1, objv, "?-nonewline? ?channelId? string");
+ return TCL_ERROR;
}
- if (i == (objc - 1)) {
- channelId = "stdout";
- } else {
- channelId = Tcl_GetString(objv[i]);
- i++;
- }
+
chan = Tcl_GetChannel(interp, channelId, &mode);
if (chan == (Tcl_Channel) NULL) {
return TCL_ERROR;
@@ -112,7 +129,7 @@ Tcl_PutsObjCmd(dummy, interp, objc, objv)
return TCL_ERROR;
}
- result = Tcl_WriteObj(chan, objv[i]);
+ result = Tcl_WriteObj(chan, string);
if (result < 0) {
goto error;
}