diff options
author | dkf <donal.k.fellows@manchester.ac.uk> | 2009-01-06 14:30:19 (GMT) |
---|---|---|
committer | dkf <donal.k.fellows@manchester.ac.uk> | 2009-01-06 14:30:19 (GMT) |
commit | a75fc7d7f1485fbc0cd498df85f8b6db86167a21 (patch) | |
tree | 9adf9b59d360b0a43649921ec3f5fc11ebb80679 | |
parent | a4a1ae8979a30624c2e3594cdf689a22146caca1 (diff) | |
download | tcl-a75fc7d7f1485fbc0cd498df85f8b6db86167a21.zip tcl-a75fc7d7f1485fbc0cd498df85f8b6db86167a21.tar.gz tcl-a75fc7d7f1485fbc0cd498df85f8b6db86167a21.tar.bz2 |
Fix [Bug 2489836]
-rw-r--r-- | ChangeLog | 3 | ||||
-rw-r--r-- | generic/tclOOInfo.c | 10 | ||||
-rw-r--r-- | tests/oo.test | 18 |
3 files changed, 27 insertions, 4 deletions
@@ -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 |