From b53d7f844a52e25261a68ee3e64737a00f818f27 Mon Sep 17 00:00:00 2001
From: andreas_kupries <akupries@shaw.ca>
Date: Wed, 19 Sep 2001 00:50:23 +0000
Subject: 	* 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.

---
 ChangeLog          |  6 +++++
 generic/tclIOCmd.c | 79 +++++++++++++++++++++++++++++++++---------------------
 2 files changed, 54 insertions(+), 31 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 57f036a..5bb6036 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2001-09-18 Andreas Kupries  <andreas_kupries@users.sourceforge.net> 
+
+	* 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.
+
 2001-09-18  Don Porter  <dgp@users.sourceforge.net>
 
 	* unix/configure: Regen.
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;
     }
-- 
cgit v0.12