summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2009-01-06 14:30:19 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2009-01-06 14:30:19 (GMT)
commita75fc7d7f1485fbc0cd498df85f8b6db86167a21 (patch)
tree9adf9b59d360b0a43649921ec3f5fc11ebb80679
parenta4a1ae8979a30624c2e3594cdf689a22146caca1 (diff)
downloadtcl-a75fc7d7f1485fbc0cd498df85f8b6db86167a21.zip
tcl-a75fc7d7f1485fbc0cd498df85f8b6db86167a21.tar.gz
tcl-a75fc7d7f1485fbc0cd498df85f8b6db86167a21.tar.bz2
Fix [Bug 2489836]
-rw-r--r--ChangeLog3
-rw-r--r--generic/tclOOInfo.c10
-rw-r--r--tests/oo.test18
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