diff options
| -rw-r--r-- | ChangeLog | 5 | ||||
| -rw-r--r-- | generic/tclPathObj.c | 44 | ||||
| -rw-r--r-- | tests/fileName.test | 16 |
3 files changed, 45 insertions, 20 deletions
@@ -1,3 +1,8 @@ +2004-03-30 Vince Darley <vincentdarley@users.sourceforge.net> + + * generic/tclPathObj.c: Fix to filename bugs recently + * tests/fileName.test: introduced [Bug 918320]. + 2004-03-29 Don Porter <dgp@users.sourceforge.net> * generic/tclMain.c (Tcl_Main, StdinProc): Append newline only diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c index 6302660..a934f3d 100644 --- a/generic/tclPathObj.c +++ b/generic/tclPathObj.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclPathObj.c,v 1.27 2004/03/26 19:04:49 vincentdarley Exp $ + * RCS: @(#) $Id: tclPathObj.c,v 1.28 2004/03/30 09:56:13 vincentdarley Exp $ */ #include "tclInt.h" @@ -825,30 +825,36 @@ Tcl_FSJoinPath(listObj, elements) * It's the last path segment. Perform a quick check if * the path is already in a suitable form. */ - int equal = 1; if (tclPlatform == TCL_PLATFORM_WINDOWS) { if (strchr(strElt, '\\') != NULL) { - equal = 0; + goto noQuickReturn; } } - if (equal) { - ptr = strElt; - while (*ptr != '\0') { - if (*ptr == '/' && (ptr[1] == '/' || ptr[1] == '\0')) { - equal = 0; - break; - } - ptr++; - } - if (res != NULL) Tcl_DecrRefCount(res); - /* - * This element is just what we want to return already - - * no further manipulation is requred. - */ - return elt; - } + ptr = strElt; + while (*ptr != '\0') { + if (*ptr == '/' && (ptr[1] == '/' || ptr[1] == '\0')) { + /* + * We have a repeated file separator, which + * means the path is not in normalized form + */ + goto noQuickReturn; + } + ptr++; + } + if (res != NULL) Tcl_DecrRefCount(res); + /* + * This element is just what we want to return already - + * no further manipulation is requred. + */ + return elt; } + /* + * The path element was not of a suitable form to be + * returned as is. We need to perform a more complex + * operation here. + */ + noQuickReturn: if (res == NULL) { res = Tcl_NewObj(); diff --git a/tests/fileName.test b/tests/fileName.test index be6b6d7..6168f6f 100644 --- a/tests/fileName.test +++ b/tests/fileName.test @@ -10,7 +10,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: fileName.test,v 1.38 2004/03/17 18:14:17 das Exp $ +# RCS: @(#) $Id: fileName.test,v 1.39 2004/03/30 09:56:33 vincentdarley Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -1186,6 +1186,20 @@ test filename-12.9 {globbing at filesystem root} {winOnly} { set equal } {1} +test filename-12.10 {globbing with volume relative paths} {winOnly} { + set dir [lindex [glob -type d [lindex [file volumes] 0]*] 0] + set pwd [pwd] + cd [lindex [file volumes] 0] + set res1 [glob -nocomplain [string range $dir 2 end]] + cd $pwd + set res2 [list $dir] + set equal [string equal $res1 $res2] + if {!$equal} { + lappend equal "not equal" $res1 $res2 + } + set equal +} {1} + test filename-13.1 {globbing with brace substitution} { list [catch {glob globTest/\{\}} msg] $msg } "0 $globPreResult" |