diff options
author | dkf <donal.k.fellows@manchester.ac.uk> | 2009-01-06 10:20:54 (GMT) |
---|---|---|
committer | dkf <donal.k.fellows@manchester.ac.uk> | 2009-01-06 10:20:54 (GMT) |
commit | a4a1ae8979a30624c2e3594cdf689a22146caca1 (patch) | |
tree | ed08f8806ff6b57df8a04685a0a443077a5098f7 | |
parent | 6fc7bc4022917dd2a594eb838f0b92903fca7061 (diff) | |
download | tcl-a4a1ae8979a30624c2e3594cdf689a22146caca1.zip tcl-a4a1ae8979a30624c2e3594cdf689a22146caca1.tar.gz tcl-a4a1ae8979a30624c2e3594cdf689a22146caca1.tar.bz2 |
Fix [Bug 2481109]
-rw-r--r-- | ChangeLog | 5 | ||||
-rw-r--r-- | generic/tclOO.c | 8 | ||||
-rw-r--r-- | tests/oo.test | 11 |
3 files changed, 18 insertions, 6 deletions
@@ -1,3 +1,8 @@ +2009-01-06 Donal K. Fellows <dkf@users.sf.net> + + * generic/tclOO.c (TclNRNewObjectInstance, Tcl_NewObjectInstance): + Perform search for existing commands in right context. [Bug 2481109] + 2009-01-05 Donal K. Fellows <dkf@users.sf.net> * generic/tclCmdMZ.c (TclNRSourceObjCmd): Make implementation of the diff --git a/generic/tclOO.c b/generic/tclOO.c index e161563..430e1cc 100644 --- a/generic/tclOO.c +++ b/generic/tclOO.c @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclOO.c,v 1.18 2008/10/31 22:08:32 dkf Exp $ + * RCS: @(#) $Id: tclOO.c,v 1.19 2009/01/06 10:20:54 dkf Exp $ */ #ifdef HAVE_CONFIG_H @@ -1241,7 +1241,8 @@ Tcl_NewObjectInstance( * that's not allowed. */ - if (nameStr && Tcl_FindCommand(interp, nameStr, NULL, 0)) { + if (nameStr && Tcl_FindCommand(interp, nameStr, NULL, + TCL_NAMESPACE_ONLY)) { Tcl_AppendResult(interp, "can't create object \"", nameStr, "\": command already exists with that name", NULL); return NULL; @@ -1333,7 +1334,8 @@ TclNRNewObjectInstance( * that's not allowed. */ - if (nameStr && Tcl_FindCommand(interp, nameStr, NULL, 0)) { + if (nameStr && Tcl_FindCommand(interp, nameStr, NULL, + TCL_NAMESPACE_ONLY)) { Tcl_AppendResult(interp, "can't create object \"", nameStr, "\": command already exists with that name", NULL); return TCL_ERROR; diff --git a/tests/oo.test b/tests/oo.test index 5c105b8..07ceaef 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.17 2008/11/01 08:05:49 dkf Exp $ +# RCS: @(#) $Id: oo.test,v 1.18 2009/01/06 10:20:54 dkf Exp $ package require TclOO 0.6.1 ;# Must match value in generic/tclOO.h if {[lsearch [namespace children] ::tcltest] == -1} { @@ -36,7 +36,7 @@ proc initInterpreter name { $name eval [list package ifneeded TclOO [package provide TclOO] \ [package ifneeded TclOO [package provide TclOO]]] } - + test oo-0.1 {basic test of OO's ability to clean up its initial state} { interp create t initInterpreter t @@ -204,6 +204,11 @@ test oo-1.16 {basic test of OO functionality: abbreviating} -setup { oo::objdefine o forw a b info object forw o a } -result b +test oo-1.17 {basic test of OO functionality: Bug 2481109} -body { + namespace eval ::foo {oo::object create lreplace} +} -cleanup { + namespace delete ::foo +} -result ::foo::lreplace test oo-2.1 {basic test of OO functionality: constructor} -setup { # This is a bit complex because it needs to run in a sub-interp as @@ -2110,7 +2115,7 @@ test oo-27.11 {variables declaration - no instance var leaks with class resolver inst1 step list [inst1 value] [inst2 value] } -result {3 2} - + cleanupTests return |