* tests/io.test, tests/chanio.test (io-73.1): Make sure to invalidate

	* generic/tclIO.c (SetChannelFromAny):        internal rep only after
	validating channel rep. [Bug 1847044]

4 files changed, 26 insertions, 8 deletions

diff --git a/ChangeLog b/ChangeLog
index 6193b72..ef6f0ac 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2007-12-09  Jeff Hobbs  <jeffh@ActiveState.com>
+
+	* tests/io.test, tests/chanio.test (io-73.1): Make sure to invalidate
+	* generic/tclIO.c (SetChannelFromAny):        internal rep only after
+	validating channel rep. [Bug 1847044]
+	
 2007-12-08  Donal K. Fellows  <dkf@users.sf.net>
 
 	* doc/expr.n, doc/mathop.n: Improved the documentation of the
diff --git a/generic/tclIO.c b/generic/tclIO.c
index 0e8346d..4d723af 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -10,7 +10,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclIO.c,v 1.133 2007/12/05 21:47:26 hobbs Exp $
+ * RCS: @(#) $Id: tclIO.c,v 1.134 2007/12/09 22:24:01 hobbs Exp $
  */
 
 #include "tclInt.h"
@@ -10618,11 +10618,12 @@ SetChannelFromAny(
     if (objPtr->typePtr != &tclChannelType) {
 	Tcl_Channel chan;
 
-	if (objPtr->typePtr != NULL) {
-	    if (objPtr->bytes == NULL) {
-		objPtr->typePtr->updateStringProc(objPtr);
-	    }
-	    TclFreeIntRep(objPtr);
+	/*
+	 * We need a valid string with which to check for a valid channel, but
+	 * make sure not to free internal rep until validated. [Bug 1847044]
+	 */
+	if ((objPtr->typePtr != NULL) && (objPtr->bytes == NULL)) {
+	    objPtr->typePtr->updateStringProc(objPtr);
 	}
 
 	chan = Tcl_GetChannel(interp, objPtr->bytes, NULL);
@@ -10630,6 +10631,7 @@ SetChannelFromAny(
 	    return TCL_ERROR;
 	}
 
+	TclFreeIntRep(objPtr);
 	statePtr = ((Channel *)chan)->state;
 	Tcl_Preserve((ClientData) statePtr);
 	SET_CHANNELSTATE(objPtr, statePtr);
diff --git a/tests/chanio.test b/tests/chanio.test
index a7fb471..d9b73d4 100644
--- a/tests/chanio.test
+++ b/tests/chanio.test
@@ -13,7 +13,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: chanio.test,v 1.1 2007/11/14 19:53:26 andreas_kupries Exp $
+# RCS: @(#) $Id: chanio.test,v 1.2 2007/12/09 22:24:04 hobbs Exp $
 
 if {[catch {package require tcltest 2}]} {
     chan puts stderr "Skipping tests in [info script].  tcltest 2 required."
@@ -7451,6 +7451,11 @@ foreach {n msg expected} {
     } [lrange $expected 0 end]
 }
 
+test chan-io-73.1 {channel Tcl_Obj SetChannelFromAny} {} {
+    # Test for Bug 1847044 - don't spoil type unless we have a valid channel
+    catch {chan close [lreplace [list a] 0 end]}
+} {1}
+
 # ### ### ### ######### ######### #########
 
 # cleanup
diff --git a/tests/io.test b/tests/io.test
index 38c25da..9b76ae3 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -13,7 +13,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: io.test,v 1.78 2007/11/14 19:53:27 andreas_kupries Exp $
+# RCS: @(#) $Id: io.test,v 1.79 2007/12/09 22:24:03 hobbs Exp $
 
 if {[catch {package require tcltest 2}]} {
     puts stderr "Skipping tests in [info script].  tcltest 2 required."
@@ -7451,6 +7451,11 @@ foreach {n msg expected} {
     } [lrange $expected 0 end]
 }
 
+test io-73.1 {channel Tcl_Obj SetChannelFromAny} {} {
+    # Test for Bug 1847044 - don't spoil type unless we have a valid channel
+    catch {close [lreplace [list a] 0 end]}
+} {1}
+
 # ### ### ### ######### ######### #########
 
 # cleanup