From 06f7470662af25ea53cefea3f2e731cbf6ce2eaf Mon Sep 17 00:00:00 2001
From: vincentdarley <vincentdarley>
Date: Thu, 23 Oct 2003 10:07:09 +0000
Subject: mac resource freeing fix

---
 ChangeLog            |  6 ++++++
 mac/tclMacResource.c | 11 +++++++++--
 tests/resource.test  |  6 +++++-
 3 files changed, 20 insertions(+), 3 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 68acb30..dde01b8 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2003-10-23  Vince Darley  <vincentdarley@users.sourceforge.net>
+
+	* tests/resource.test:
+	* mac/tclMacResource.c: fix to resource freeing problem in 'resource'
+	command reported by Bernard Desgraupes.
+
 2003-10-22  Donal K. Fellows  <fellowsd@cs.man.ac.uk>
 
 	* generic/tclCmdAH.c (Tcl_FileObjCmd): Changed FILE_ prefix to FCMD_
diff --git a/mac/tclMacResource.c b/mac/tclMacResource.c
index 2403ebf..aff6bed 100644
--- a/mac/tclMacResource.c
+++ b/mac/tclMacResource.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: tclMacResource.c,v 1.18 2003/10/14 15:44:53 dgp Exp $
+ * RCS: @(#) $Id: tclMacResource.c,v 1.19 2003/10/23 10:07:09 vincentdarley Exp $
  */
 
 #include <Errors.h>
@@ -478,7 +478,14 @@ resourceRef? resourceType");
 		    } else {
 			objPtr = Tcl_NewIntObj(id);
 		    }
-		    ReleaseResource(resource);
+		    /*
+		     * If the Master Pointer of the  returned handle is
+		     * null, then resource was not in memory, and it is
+		     * safe to release it. Otherwise, it is not.
+		     */
+		    if (*resource == NULL) {
+			ReleaseResource(resource);
+		    }
 		    result = Tcl_ListObjAppendElement(interp, resultPtr,
 			    objPtr);
 		    if (result != TCL_OK) {
diff --git a/tests/resource.test b/tests/resource.test
index f968769..a650d48 100644
--- a/tests/resource.test
+++ b/tests/resource.test
@@ -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: resource.test,v 1.8 2003/10/06 14:32:22 dgp Exp $
+# RCS: @(#) $Id: resource.test,v 1.9 2003/10/23 10:07:30 vincentdarley Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -148,6 +148,10 @@ test resource-5.4 {resource types tests} {macOnly} {
     resource close $id
     set result
 } {TEXT}
+test resource-5.5 {resource types lists} {macOnly} {
+    # This should not crash
+    catch {foreach f [resource types] { resource list $f }}
+} {0}
 
 # resource write tests
 test resource-6.1 {resource write tests} {macOnly} {
-- 
cgit v0.12