From a75fc7d7f1485fbc0cd498df85f8b6db86167a21 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Tue, 6 Jan 2009 14:30:19 +0000
Subject: Fix [Bug 2489836]

---
 ChangeLog           |  3 +++
 generic/tclOOInfo.c | 10 +++++++---
 tests/oo.test       | 18 +++++++++++++++++-
 3 files changed, 27 insertions(+), 4 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index ec4026d..d24b13e 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,8 @@
 2009-01-06  Donal K. Fellows  <dkf@users.sf.net>
 
+	* generic/tclOOInfo.c (InfoObjectMethodsCmd,InfoClassMethodsCmd): Only
+	delete pointers that were actually allocated! [Bug 2489836]
+
 	* generic/tclOO.c (TclNRNewObjectInstance, Tcl_NewObjectInstance):
 	Perform search for existing commands in right context. [Bug 2481109]
 
diff --git a/generic/tclOOInfo.c b/generic/tclOOInfo.c
index 583907b..44c5399 100644
--- a/generic/tclOOInfo.c
+++ b/generic/tclOOInfo.c
@@ -9,7 +9,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclOOInfo.c,v 1.10 2008/10/16 22:34:18 nijtmans Exp $
+ * RCS: @(#) $Id: tclOOInfo.c,v 1.11 2009/01/06 14:30:19 dkf Exp $
  */
 
 #ifdef HAVE_CONFIG_H
@@ -586,7 +586,9 @@ InfoObjectMethodsCmd(
 	    Tcl_ListObjAppendElement(NULL, resultObj,
 		    Tcl_NewStringObj(names[i], -1));
 	}
-	ckfree((char *) names);
+	if (numNames > 0) {
+	    ckfree((char *) names);
+	}
     } else if (oPtr->methodsPtr) {
 	FOREACH_HASH(namePtr, mPtr, oPtr->methodsPtr) {
 	    if (mPtr->typePtr != NULL && (mPtr->flags & flag) == flag) {
@@ -1104,7 +1106,9 @@ InfoClassMethodsCmd(
 	    Tcl_ListObjAppendElement(NULL, resultObj,
 		    Tcl_NewStringObj(names[i], -1));
 	}
-	ckfree((char *) names);
+	if (numNames > 0) {
+	    ckfree((char *) names);
+	}
     } else {
 	FOREACH_HASH_DECLS;
 
diff --git a/tests/oo.test b/tests/oo.test
index 07ceaef..0505ddd 100644
--- a/tests/oo.test
+++ b/tests/oo.test
@@ -7,7 +7,7 @@
 # See the file "license.terms" for information on usage and redistribution of
 # this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: oo.test,v 1.18 2009/01/06 10:20:54 dkf Exp $
+# RCS: @(#) $Id: oo.test,v 1.19 2009/01/06 14:30:19 dkf Exp $
 
 package require TclOO 0.6.1 ;# Must match value in generic/tclOO.h
 if {[lsearch [namespace children] ::tcltest] == -1} {
@@ -1258,6 +1258,14 @@ test oo-16.11 {OO: object introspection} -setup {
 } -cleanup {
     foo destroy
 } -result {{boo destroy spong} {boo destroy eval spong unknown variable varname}}
+test oo-16.12 {OO: object introspection} -setup {
+    oo::object create foo
+} -cleanup {
+    rename foo {}
+} -body {
+    oo::objdefine foo unexport {*}[info object methods foo -all]
+    info object methods foo -all
+} -result {}
 
 test oo-17.1 {OO: class introspection} -body {
     info class
@@ -1326,6 +1334,14 @@ test oo-17.9 {OO: class introspection} -setup {
 } -cleanup {
     foo destroy
 } -result {{bar boo destroy} {bar boo destroy eval unknown variable varname}}
+test oo-17.10 {OO: class introspection} -setup {
+    oo::class create foo
+} -cleanup {
+    rename foo {}
+} -body {
+    oo::define foo unexport {*}[info class methods foo -all]
+    info class methods foo -all
+} -result {}
 
 test oo-18.1 {OO: define command support} {
     list [catch {oo::define oo::object {error foo}} msg] $msg $errorInfo
-- 
cgit v0.12