From 11d70a65e6f7578f2d0e486b978142e3bcdcc304 Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 6 Feb 2007 21:08:05 +0000 Subject: * generic/tclNamesp.c: Corrected broken implementation of the * tests/namespace.test: TclMatchIsTrivial optimization on [namespace children $namespace $pattern]. --- ChangeLog | 6 ++++++ generic/tclNamesp.c | 8 ++++++-- tests/namespace.test | 7 ++++++- 3 files changed, 18 insertions(+), 3 deletions(-) diff --git a/ChangeLog b/ChangeLog index 56d18d9..9d7277d 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,9 @@ +2007-02-06 Don Porter + + * generic/tclNamesp.c: Corrected broken implementation of the + * tests/namespace.test: TclMatchIsTrivial optimization on + [namespace children $namespace $pattern]. + 2007-02-04 Daniel Steffen * unix/tcl.m4: use gcc4's __attribute__((__visibility__("hidden"))) if diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index d641eef..f5f3da1 100644 --- a/generic/tclNamesp.c +++ b/generic/tclNamesp.c @@ -22,7 +22,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclNamesp.c,v 1.121 2006/12/08 13:50:42 dkf Exp $ + * RCS: @(#) $Id: tclNamesp.c,v 1.122 2007/02/06 21:08:06 dgp Exp $ */ #include "tclInt.h" @@ -3113,7 +3113,11 @@ NamespaceChildrenCmd( listPtr = Tcl_NewListObj(0, NULL); if ((pattern != NULL) && TclMatchIsTrivial(pattern)) { - if (Tcl_FindHashEntry(&nsPtr->childTable, pattern) != NULL) { + int length = strlen(nsPtr->fullName); + if (strncmp(pattern, nsPtr->fullName, length) != 0) { + goto searchDone; + } + if (Tcl_FindHashEntry(&nsPtr->childTable, pattern+length) != NULL) { Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj(pattern, -1)); } diff --git a/tests/namespace.test b/tests/namespace.test index 3f1f5dc..b712f01 100644 --- a/tests/namespace.test +++ b/tests/namespace.test @@ -11,7 +11,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: namespace.test,v 1.63 2006/11/23 15:35:31 dkf Exp $ +# RCS: @(#) $Id: namespace.test,v 1.64 2007/02/06 21:08:07 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -914,6 +914,11 @@ test namespace-21.7 {NamespaceChildrenCmd, glob-style pattern given} { namespace eval test_ns_1::test_ns_foo {} lsort [namespace children test_ns_1 test*] } [lsort {::test_ns_1::test_ns_2 ::test_ns_1::test_ns_foo}] +test namespace-21.8 {NamespaceChildrenCmd, trivial pattern starting with ::} { + namespace eval test_ns_1 {} + namespace children [namespace current] \ + [string trimright [namespace current] :]::test_ns_1 +} [string trimright [namespace current] :]::test_ns_1 test namespace-22.1 {NamespaceCodeCmd, bad args} { catch {namespace delete {*}[namespace children :: test_ns_*]} -- cgit v0.12