summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorvincentdarley <vincentdarley>2004-03-30 09:56:13 (GMT)
committervincentdarley <vincentdarley>2004-03-30 09:56:13 (GMT)
commite7a7c5a2234e5cee662915660923c347b6a5d07d (patch)
tree0dda23cc3cf2cfac164b7213cc7917c68851bede
parent52e2042903c304b57c14e6b17029c7adc014a34e (diff)
downloadtcl-e7a7c5a2234e5cee662915660923c347b6a5d07d.zip
tcl-e7a7c5a2234e5cee662915660923c347b6a5d07d.tar.gz
tcl-e7a7c5a2234e5cee662915660923c347b6a5d07d.tar.bz2
fix to Tcl bug 918320
-rw-r--r--ChangeLog5
-rw-r--r--generic/tclPathObj.c44
-rw-r--r--tests/fileName.test16
3 files changed, 45 insertions, 20 deletions
diff --git a/ChangeLog b/ChangeLog
index 262a831..d6dc060 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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"