* 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.

1 files changed, 29 insertions, 15 deletions

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