Attachment "2499641.patch" to
ticket [2499641fff]
added by
andreas_kupries
2009-02-06 06:18:23.
Index: ChangeLog
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/fileutil/ChangeLog,v
retrieving revision 1.118
diff -w -u -r1.118 ChangeLog
--- ChangeLog 15 Dec 2008 20:25:30 -0000 1.118
+++ ChangeLog 5 Feb 2009 23:17:00 -0000
@@ -1,3 +1,10 @@
+2009-02-05 Andreas Kupries <[email protected]>
+
+ * fileutil.tcl (::fileutil::stripPath): Fixed handling
+ * fileutil.man: of letter-case on windows, comparisons
+ * strip.test: have to be case-insensitive. Bumped version
+ * pkgIndex.tcl: to 1.13.6. See [SF Tcllib Bug 2499641].
+
2008-12-12 Andreas Kupries <[email protected]>
*
Index: fileutil.man
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/fileutil/fileutil.man,v
retrieving revision 1.43
diff -w -u -r1.43 fileutil.man
--- fileutil.man 29 Jan 2009 06:16:19 -0000 1.43
+++ fileutil.man 5 Feb 2009 23:17:00 -0000
@@ -1,10 +1,10 @@
[comment {-*- tcl -*- doctools manpage}]
-[manpage_begin fileutil n 1.13.5]
+[manpage_begin fileutil n 1.13.6]
[moddesc {file utilities}]
[titledesc {Procedures implementing some file utilities}]
[category {Programming tools}]
[require Tcl 8]
-[require fileutil [opt 1.13.5]]
+[require fileutil [opt 1.13.6]]
[description]
[keywords {file utilities} touch grep type {temp file} test cat]
[para]
Index: fileutil.tcl
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/fileutil/fileutil.tcl,v
retrieving revision 1.72
diff -w -u -r1.72 fileutil.tcl
--- fileutil.tcl 2 Dec 2008 17:29:09 -0000 1.72
+++ fileutil.tcl 5 Feb 2009 23:17:01 -0000
@@ -13,7 +13,7 @@
package require Tcl 8.2
package require cmdline
-package provide fileutil 1.13.5
+package provide fileutil 1.13.6
namespace eval ::fileutil {
namespace export \
@@ -512,6 +512,30 @@
# Results:
# path The (possibly) modified path.
+if {[string equal $tcl_platform(platform) windows]} {
+
+ # Windows. While paths are stored with letter-case preserved al
+ # comparisons have to be done case-insensitive. For reference see
+ # SF Tcllib Bug 2499641.
+
+ proc ::fileutil::stripPath {prefix path} {
+ # [file split] is used to generate a canonical form for both
+ # paths, for easy comparison, and also one which is easy to modify
+ # using list commands.
+
+ if {[string equal -nocase $prefix $path]} {
+ return "."
+ }
+
+ set prefix [file split $prefix]
+ set npath [file split $path]
+
+ if {[string match -nocase ${prefix}* $npath]} {
+ set path [eval [linsert [lrange $npath [llength $prefix] end] 0 file join ]]
+ }
+ return $path
+ }
+} else {
proc ::fileutil::stripPath {prefix path} {
# [file split] is used to generate a canonical form for both
# paths, for easy comparison, and also one which is easy to modify
@@ -529,6 +553,7 @@
}
return $path
}
+}
# ::fileutil::jail --
#
Index: pkgIndex.tcl
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/fileutil/pkgIndex.tcl,v
retrieving revision 1.33
diff -w -u -r1.33 pkgIndex.tcl
--- pkgIndex.tcl 2 Dec 2008 17:29:09 -0000 1.33
+++ pkgIndex.tcl 5 Feb 2009 23:17:01 -0000
@@ -1,5 +1,5 @@
if {![package vsatisfies [package provide Tcl] 8.2]} {return}
-package ifneeded fileutil 1.13.5 [list source [file join $dir fileutil.tcl]]
+package ifneeded fileutil 1.13.6 [list source [file join $dir fileutil.tcl]]
if {![package vsatisfies [package provide Tcl] 8.3]} {return}
package ifneeded fileutil::traverse 0.4 [list source [file join $dir traverse.tcl]]
Index: strip.test
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/fileutil/strip.test,v
retrieving revision 1.1
diff -w -u -r1.1 strip.test
--- strip.test 3 Aug 2007 23:07:25 -0000 1.1
+++ strip.test 5 Feb 2009 23:17:01 -0000
@@ -67,6 +67,12 @@
} .
+test stripPath-2.0 {SF Tcllib Bug 2499641, handle mixed case properly on windows} win {
+ fileutil::stripPath C:/temp C:/Temp/foo
+} foo
+
+
+
test stripN-1.0 {remove nothing} {
fileutil::stripN {find 1} 0
} {find 1}
