Tcl Source Code

Artifact [b0be6672fb]
Login

Artifact b0be6672fbf0d99918b3dcc5e3dff837f9529011:

Attachment "safe.patch" to ticket [2854929fff] added by andreas_kupries 2009-11-04 05:53:07.
Index: ChangeLog
===================================================================
RCS file: /cvsroot/tcl/tcl/ChangeLog,v
retrieving revision 1.3975.2.248
diff -w -u -r1.3975.2.248 ChangeLog
--- ChangeLog	31 Oct 2009 20:25:32 -0000	1.3975.2.248
+++ ChangeLog	3 Nov 2009 22:51:40 -0000
@@ -1,3 +1,11 @@
+2009-11-03  Andreas Kupries  <[email protected]>
+
+	* library/safe.tcl (::safe::InterpSetConfig): [Bug 2854929]. Added
+	code to 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.
+
 2009-10-31  Donal K. Fellows  <[email protected]>
 
 	* generic/tclBasic.c (ExprRoundFunc): [Bug 2889593]: Correctly report
Index: library/safe.tcl
===================================================================
RCS file: /cvsroot/tcl/tcl/library/safe.tcl,v
retrieving revision 1.16.4.1
diff -w -u -r1.16.4.1 safe.tcl
--- library/safe.tcl	25 Jun 2008 16:42:05 -0000	1.16.4.1
+++ library/safe.tcl	3 Nov 2009 22:51:40 -0000
@@ -373,13 +373,33 @@
 	# Modules. We safe the virtual form separately as well, as
 	# syncing it with the slave has to be defered until the
 	# necessary commands are present for setup.
-	foreach dir [::tcl::tm::list] {
+
+	set morepaths [::tcl::tm::list]
+	while {[llength $morepaths]} {
+	    set addpaths $morepaths
+	    set morepaths {}
+
+	    foreach dir $addpaths {
 	    lappend access_path $dir
 	    Set [PathToken $i $slave] $dir
 	    lappend slave_auto_path "\$[PathToken $i]"
 	    lappend slave_tm_path   "\$[PathToken $i]"
 	    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. The catch prevents complaints when
+		# no paths are added. Do nothing gracefully is 8.6+.
+
+		catch {
+		    lappend morepaths {*}[glob -nocomplain -directory $dir -type d *]
 	}
+	    }
+	}
+
 	Set [TmPathListName      $slave] $slave_tm_path
 	Set $nname $i
 	Set [PathListName        $slave] $access_path