summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2009-01-06 10:20:54 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2009-01-06 10:20:54 (GMT)
commita4a1ae8979a30624c2e3594cdf689a22146caca1 (patch)
treeed08f8806ff6b57df8a04685a0a443077a5098f7
parent6fc7bc4022917dd2a594eb838f0b92903fca7061 (diff)
downloadtcl-a4a1ae8979a30624c2e3594cdf689a22146caca1.zip
tcl-a4a1ae8979a30624c2e3594cdf689a22146caca1.tar.gz
tcl-a4a1ae8979a30624c2e3594cdf689a22146caca1.tar.bz2
Fix [Bug 2481109]
-rw-r--r--ChangeLog5
-rw-r--r--generic/tclOO.c8
-rw-r--r--tests/oo.test11
3 files changed, 18 insertions, 6 deletions
diff --git a/ChangeLog b/ChangeLog
index 8825ec2..ec4026d 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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