Attachment "sf-2872536.patch" to
ticket [2872536fff]
added by
andreas_kupries
2009-10-07 02:24:40.
Index: modules/fileutil/strip.test
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/fileutil/strip.test,v
retrieving revision 1.2
diff -w -u -r1.2 strip.test
--- modules/fileutil/strip.test 5 Feb 2009 23:40:08 -0000 1.2
+++ modules/fileutil/strip.test 6 Oct 2009 19:23:13 -0000
@@ -6,7 +6,7 @@
#
# Copyright (c) 1998-2000 by Ajuba Solutions.
# Copyright (c) 2001 by ActiveState Tool Corp.
-# Copyright (c) 2005-2007 by Andreas Kupries <[email protected]>
+# Copyright (c) 2005-2009 by Andreas Kupries <[email protected]>
# All rights reserved.
#
# RCS: @(#) $Id: strip.test,v 1.2 2009/02/05 23:40:08 andreas_kupries Exp $
@@ -71,6 +71,17 @@
fileutil::stripPath C:/temp C:/Temp/foo
} foo
+test stripPath-2.1.0 {SF Tcllib Bug 2872536, partial paths} unix {
+ fileutil::stripPath /temp /tempx/foo
+} /tempx/foo
+
+test stripPath-2.1.1 {SF Tcllib Bug 2872536, partial paths} win {
+ fileutil::stripPath C:/temp C:/Tempx/foo
+} C:/Tempx/foo
+
+test stripPath-2.2 {SF Tcllib Bug 2872536, different separators} win {
+ fileutil::stripPath c:/temp/foo/bar c:/temp/foo\\bar
+} .
test stripN-1.0 {remove nothing} {
Index: modules/fileutil/fileutil.tcl
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/fileutil/fileutil.tcl,v
retrieving revision 1.74
diff -w -u -r1.74 fileutil.tcl
--- modules/fileutil/fileutil.tcl 14 Sep 2009 17:10:07 -0000 1.74
+++ modules/fileutil/fileutil.tcl 6 Oct 2009 19:23:13 -0000
@@ -530,7 +530,7 @@
set prefix [file split $prefix]
set npath [file split $path]
- if {[string match -nocase ${prefix}* $npath]} {
+ if {[string match -nocase "${prefix} *" $npath]} {
set path [eval [linsert [lrange $npath [llength $prefix] end] 0 file join ]]
}
return $path
@@ -548,7 +548,7 @@
set prefix [file split $prefix]
set npath [file split $path]
- if {[string match ${prefix}* $npath]} {
+ if {[string match "${prefix} *" $npath]} {
set path [eval [linsert [lrange $npath [llength $prefix] end] 0 file join ]]
}
return $path
