summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorandreas_kupries <akupries@shaw.ca>2009-11-05 20:51:25 (GMT)
committerandreas_kupries <akupries@shaw.ca>2009-11-05 20:51:25 (GMT)
commit0097085615a9826bb1914c1b4ed49ab588415ed9 (patch)
tree8cef5aa678e3e73bbe78a1ed2e89a0d4f28cf59b
parentaae466d267a22fa7ffe3a9d0695ad56fa6270dd4 (diff)
downloadtcl-0097085615a9826bb1914c1b4ed49ab588415ed9.zip
tcl-0097085615a9826bb1914c1b4ed49ab588415ed9.tar.gz
tcl-0097085615a9826bb1914c1b4ed49ab588415ed9.tar.bz2
* library/safe.tcl: A series of patches which bring the SafeBase
up to date with code guidelines, Tcl's features, also eliminating a number of inefficiencies along the way. (11) Fixed bug 2854929. Recurse into all subdirs under all TM root dirs and put them on the access path.
-rw-r--r--ChangeLog2
-rw-r--r--library/safe.tcl44
2 files changed, 31 insertions, 15 deletions
diff --git a/ChangeLog b/ChangeLog
index a781ba7..085c119 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -30,6 +30,8 @@
to use modern features (lassign, in/ni, dicts). The latter are
used to keep a reverse path -> token map and quicker check of
existence.
+ (11) Fixed bug 2854929. Recurse into all subdirs under all TM root
+ dirs and put them on the access path.
2009-11-02 Kevin B. Kenny <kennykb@acm.org>
diff --git a/library/safe.tcl b/library/safe.tcl
index 166ec7e..758e1db 100644
--- a/library/safe.tcl
+++ b/library/safe.tcl
@@ -12,7 +12,7 @@
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: safe.tcl,v 1.29 2009/11/05 20:41:46 andreas_kupries Exp $
+# RCS: @(#) $Id: safe.tcl,v 1.30 2009/11/05 20:51:25 andreas_kupries Exp $
#
# The implementation is based on namespaces. These naming conventions are
@@ -337,21 +337,35 @@ proc ::safe::InterpSetConfig {slave access_path staticsok nestedok deletehook} {
incr i
}
- foreach dir [::tcl::tm::list] {
- # Prevent the addition of dirs on the tm list to the result if
- # they are already known.
- if {[dict exists $remap_access_path $dir]} {
- continue
- }
+ set morepaths [::tcl::tm::list]
+ while {[llength $morepaths]} {
+ set addpaths $morepaths
+ set morepaths {}
- set token [PathToken $i]
- lappend access_path $dir
- lappend slave_access_path $token
- lappend map_access_path $token $dir
- lappend remap_access_path $dir $token
- lappend norm_access_path [file normalize $dir]
- lappend slave_tm_path $token
- incr i
+ foreach dir $addpaths {
+ # Prevent the addition of dirs on the tm list to the
+ # result if they are already known.
+ if {[dict exists $remap_access_path $dir]} {
+ continue
+ }
+
+ set token [PathToken $i]
+ lappend access_path $dir
+ lappend slave_access_path $token
+ lappend map_access_path $token $dir
+ lappend remap_access_path $dir $token
+ lappend norm_access_path [file normalize $dir]
+ lappend slave_tm_path $token
+ incr i
+
+ # [Bug 2854929]
+ # Recursively find deeper paths which may contain
+ # modules. Required to handle modules with names like
+ # 'platform::shell', which translate into
+ # 'platform/shell-X.tm', i.e arbitrarily deep
+ # subdirectories.
+ lappend morepaths {*}[glob -nocomplain -directory $dir -type d *]
+ }
}
set state(access_path) $access_path