From 20d4b34f6477d15f854d40540e12bb756e48d90e Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Tue, 6 Jul 2004 21:08:36 +0000
Subject:         * tests/cmdMZ.test (cmdMZ-return-2.17):  Added a test that a
 word         containing backslash-quoted value is treated correctly.

        * generic/tclCompile.c (TclWordKnownAtCompileTime):  [Bug 986196]
        Corrected flaw above and the flaw that caused TCL_TOKEN_SIMPLE_WORDs
        to have their original word value copied ( "{a b}" ) rather than the
        actual value ( "a b" ).  Thanks to Kevin Kenny for report and tests.
---
 ChangeLog            | 10 ++++++++++
 generic/tclCompile.c |  9 +++++----
 tests/cmdMZ.test     | 12 +++++++++++-
 3 files changed, 26 insertions(+), 5 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 47b95fb..176a025 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,13 @@
+2004-07-06  Don Porter  <dgp@users.sourceforge.net>
+
+	* tests/cmdMZ.test (cmdMZ-return-2.17):  Added a test that a word
+	containing backslash-quoted value is treated correctly.
+
+	* generic/tclCompile.c (TclWordKnownAtCompileTime):  [Bug 986196]
+	Corrected flaw above and the flaw that caused TCL_TOKEN_SIMPLE_WORDs
+	to have their original word value copied ( "{a b}" ) rather than the
+	actual value ( "a b" ).  Thanks to Kevin Kenny for report and tests.
+
 2004-07-06  Kevin B. Kenny  <kennykb@acm.org>
 
 	* tests/cmdMZ.test (cmdMZ-return-2.15,cmdMZ-return-2.16):
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 58627d1..92d3368 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -11,7 +11,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclCompile.c,v 1.67 2004/06/08 19:27:01 msofer Exp $
+ * RCS: @(#) $Id: tclCompile.c,v 1.68 2004/07/06 21:08:36 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -832,7 +832,7 @@ TclWordKnownAtCompileTime(tokenPtr, valuePtr)
 
     if (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
 	if (valuePtr != NULL) {
-	    Tcl_AppendToObj(valuePtr, tokenPtr->start, tokenPtr->size);
+	    Tcl_AppendToObj(valuePtr, tokenPtr[1].start, tokenPtr[1].size);
 	}
 	return 1;
     }
@@ -850,7 +850,7 @@ TclWordKnownAtCompileTime(tokenPtr, valuePtr)
 		if (tempPtr != NULL) {
 		    Tcl_AppendToObj(tempPtr, tokenPtr->start, tokenPtr->size);
 		}
-		continue;
+		break;
 
 	    case TCL_TOKEN_BS:
 		if (tempPtr != NULL) {
@@ -859,7 +859,7 @@ TclWordKnownAtCompileTime(tokenPtr, valuePtr)
 			    Tcl_UtfBackslash(tokenPtr->start, NULL, utfBuf);
 		    Tcl_AppendToObj(tempPtr, utfBuf, length);
 		}
-		continue;
+		break;
 	    
 	    default:
 		if (tempPtr != NULL) {
@@ -867,6 +867,7 @@ TclWordKnownAtCompileTime(tokenPtr, valuePtr)
 		}
 		return 0;
 	}
+	tokenPtr++;
     }
     if (valuePtr != NULL) {
 	Tcl_AppendObjToObj(valuePtr, tempPtr);
diff --git a/tests/cmdMZ.test b/tests/cmdMZ.test
index 827c77b..2eff71f 100644
--- a/tests/cmdMZ.test
+++ b/tests/cmdMZ.test
@@ -11,7 +11,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: cmdMZ.test,v 1.23 2004/07/06 20:17:11 kennykb Exp $
+# RCS: @(#) $Id: cmdMZ.test,v 1.24 2004/07/06 21:08:37 dgp Exp $
 
 if {[catch {package require tcltest 2.1}]} {
     puts stderr "Skipping tests in [info script]. tcltest 2.1 required."
@@ -171,6 +171,16 @@ test cmdMZ-return-2.16 {return opton handling} -setup {
         rename p {}
     } -result {1 c {a b}}
    
+test cmdMZ-return-2.17 {return opton handling} -setup {
+        proc p {} {
+            return -code error -errorcode a\ b c
+        }
+    } -body {
+        list [catch p result] $result $::errorCode
+    } -cleanup {
+        rename p {}
+    } -result {1 c {a b}}
+   
 
 # Check that the result of a [return -options $opts $result] is
 # indistinguishable from that of the originally caught script, no
-- 
cgit v0.12